ext/re/re.pm

   1 package re;
   2
   3 # pragma for controlling the regexp engine
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION     = "0.38";
   8 our @ISA         = qw(Exporter);
   9 our @EXPORT_OK   = ('regmust',
  10                     qw(is_regexp regexp_pattern
  11                        regname regnames regnames_count));
  12 our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
  13
  14 my %bitmask = (
  15     taint   => 0x00100000, # HINT_RE_TAINT
  16     eval    => 0x00200000, # HINT_RE_EVAL
  17 );
  18
  19 my $flags_hint = 0x02000000; # HINT_RE_FLAGS
  20 my $PMMOD_SHIFT = 0;
  21 my %reflags = (
  22     m => 1 << ($PMMOD_SHIFT + 0),
  23     s => 1 << ($PMMOD_SHIFT + 1),
  24     i => 1 << ($PMMOD_SHIFT + 2),
  25     x => 1 << ($PMMOD_SHIFT + 3),
  26    xx => 1 << ($PMMOD_SHIFT + 4),
  27     n => 1 << ($PMMOD_SHIFT + 5),
  28     p => 1 << ($PMMOD_SHIFT + 6),
  29     strict => 1 << ($PMMOD_SHIFT + 10),
  30 # special cases:
  31     d => 0,
  32     l => 1,
  33     u => 2,
  34     a => 3,
  35     aa => 4,
  36 );
  37
  38 sub setcolor {
  39  eval {                         # Ignore errors
  40   require Term::Cap;
  41
  42   my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
  43   my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
  44   my @props = split /,/, $props;
  45   my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
  46
  47   $colors =~ s/\0//g;
  48   $ENV{PERL_RE_COLORS} = $colors;
  49  };
  50  if ($@) {
  51     $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
  52  }
  53
  54 }
  55
  56 my %flags = (
  57     COMPILE           => 0x0000FF,
  58     PARSE             => 0x000001,
  59     OPTIMISE          => 0x000002,
  60     TRIEC             => 0x000004,
  61     DUMP              => 0x000008,
  62     FLAGS             => 0x000010,
  63     TEST              => 0x000020,
  64
  65     EXECUTE           => 0x00FF00,
  66     INTUIT            => 0x000100,
  67     MATCH             => 0x000200,
  68     TRIEE             => 0x000400,
  69
  70     EXTRA             => 0xFF0000,
  71     TRIEM             => 0x010000,
  72     OFFSETS           => 0x020000,
  73     OFFSETSDBG        => 0x040000,
  74     STATE             => 0x080000,
  75     OPTIMISEM         => 0x100000,
  76     STACK             => 0x280000,
  77     BUFFERS           => 0x400000,
  78     GPOS              => 0x800000,
  79 );
  80 $flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
  81 $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
  82 $flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
  83 $flags{More} = $flags{MORE} =
  84                     $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
  85 $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
  86 $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
  87
  88 if (defined &DynaLoader::boot_DynaLoader) {
  89     require XSLoader;
  90     XSLoader::load();
  91 }
  92 # else we're miniperl
  93 # We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
  94 # uses re 'taint'.
  95
  96 sub _load_unload {
  97     my ($on)= @_;
  98     if ($on) {
  99         # We call install() every time, as if we didn't, we wouldn't
 100         # "see" any changes to the color environment var since
 101         # the last time it was called.
 102
 103         # install() returns an integer, which if casted properly
 104         # in C resolves to a structure containing the regexp
 105         # hooks. Setting it to a random integer will guarantee
 106         # segfaults.
 107         $^H{regcomp} = install();
 108     } else {
 109         delete $^H{regcomp};
 110     }
 111 }
 112
 113 sub bits {
 114     my $on = shift;
 115     my $bits = 0;
 116     my $turning_all_off = ! @_ && ! $on;
 117     if ($turning_all_off) {
 118
 119         # Pretend were called with certain parameters, which are best dealt
 120         # with that way.
 121         push @_, keys %bitmask; # taint and eval
 122         push @_, 'strict';
 123     }
 124
 125     # Process each subpragma parameter
 126    ARG:
 127     foreach my $idx (0..$#_){
 128         my $s=$_[$idx];
 129         if ($s eq 'Debug' or $s eq 'Debugcolor') {
 130             setcolor() if $s =~/color/i;
 131             ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
 132             for my $idx ($idx+1..$#_) {
 133                 if ($flags{$_[$idx]}) {
 134                     if ($on) {
 135                         ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
 136                     } else {
 137                         ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
 138                     }
 139                 } else {
 140                     require Carp;
 141                     Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
 142                                join(", ",sort keys %flags ) );
 143                 }
 144             }
 145             _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
 146             last;
 147         } elsif ($s eq 'debug' or $s eq 'debugcolor') {
 148             setcolor() if $s =~/color/i;
 149             _load_unload($on);
 150             last;
 151         } elsif (exists $bitmask{$s}) {
 152             $bits |= $bitmask{$s};
 153         } elsif ($EXPORT_OK{$s}) {
 154             require Exporter;
 155             re->export_to_level(2, 're', $s);
 156         } elsif ($s eq 'strict') {
 157             if ($on) {
 158                 $^H{reflags} |= $reflags{$s};
 159                 warnings::warnif('experimental::re_strict',
 160                                  "\"use re 'strict'\" is experimental");
 161
 162                 # Turn on warnings if not already done.
 163                 if (! warnings::enabled('regexp')) {
 164                     require warnings;
 165                     warnings->import('regexp');
 166                     $^H{re_strict} = 1;
 167                 }
 168             }
 169             else {
 170                 $^H{reflags} &= ~$reflags{$s} if $^H{reflags};
 171
 172                 # Turn off warnings if we turned them on.
 173                 warnings->unimport('regexp') if $^H{re_strict};
 174             }
 175             if ($^H{reflags}) {
 176                 $^H |= $flags_hint;
 177             }
 178             else {
 179                 $^H &= ~$flags_hint;
 180             }
 181         } elsif ($s =~ s/^\///) {
 182             my $reflags = $^H{reflags} || 0;
 183             my $seen_charset;
 184             my $x_count = 0;
 185             while ($s =~ m/( . )/gx) {
 186                 local $_ = $1;
 187                 if (/[adul]/) {
 188                     # The 'a' may be repeated; hide this from the rest of the
 189                     # code by counting and getting rid of all of them, then
 190                     # changing to 'aa' if there is a repeat.
 191                     if ($_ eq 'a') {
 192                         my $sav_pos = pos $s;
 193                         my $a_count = $s =~ s/a//g;
 194                         pos $s = $sav_pos - 1;  # -1 because got rid of the 'a'
 195                         if ($a_count > 2) {
 196                             require Carp;
 197                             Carp::carp(
 198                             qq 'The "a" flag may only appear a maximum of twice'
 199                             );
 200                         }
 201                         elsif ($a_count == 2) {
 202                             $_ = 'aa';
 203                         }
 204                     }
 205                     if ($on) {
 206                         if ($seen_charset) {
 207                             require Carp;
 208                             if ($seen_charset ne $_) {
 209                                 Carp::carp(
 210                                 qq 'The "$seen_charset" and "$_" flags '
 211                                 .qq 'are exclusive'
 212                                 );
 213                             }
 214                             else {
 215                                 Carp::carp(
 216                                 qq 'The "$seen_charset" flag may not appear '
 217                                 .qq 'twice'
 218                                 );
 219                             }
 220                         }
 221                         $^H{reflags_charset} = $reflags{$_};
 222                         $seen_charset = $_;
 223                     }
 224                     else {
 225                         delete $^H{reflags_charset}
 226                                      if defined $^H{reflags_charset}
 227                                         && $^H{reflags_charset} == $reflags{$_};
 228                     }
 229                 } elsif (exists $reflags{$_}) {
 230                     if ($_ eq 'x') {
 231                         $x_count++;
 232                         if ($x_count > 2) {
 233                             require Carp;
 234                             Carp::carp(
 235                             qq 'The "x" flag may only appear a maximum of twice'
 236                             );
 237                         }
 238                         elsif ($x_count == 2) {
 239                             $_ = 'xx';  # First time through got the /x
 240                         }
 241                     }
 242
 243                     $on
 244                       ? $reflags |= $reflags{$_}
 245                       : ($reflags &= ~$reflags{$_});
 246                 } else {
 247                     require Carp;
 248                     Carp::carp(
 249                      qq'Unknown regular expression flag "$_"'
 250                     );
 251                     next ARG;
 252                 }
 253             }
 254             ($^H{reflags} = $reflags or defined $^H{reflags_charset})
 255                             ? $^H |= $flags_hint
 256                             : ($^H &= ~$flags_hint);
 257         } else {
 258             require Carp;
 259             Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
 260                        join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
 261                        ")");
 262         }
 263     }
 264
 265     if ($turning_all_off) {
 266         _load_unload(0);
 267         $^H{reflags} = 0;
 268         $^H{reflags_charset} = 0;
 269         $^H &= ~$flags_hint;
 270     }
 271
 272     $bits;
 273 }
 274
 275 sub import {
 276     shift;
 277     $^H |= bits(1, @_);
 278 }
 279
 280 sub unimport {
 281     shift;
 282     $^H &= ~ bits(0, @_);
 283 }
 284
 285 1;
 286
 287 __END__
 288
 289 =head1 NAME
 290
 291 re - Perl pragma to alter regular expression behaviour
 292
 293 =head1 SYNOPSIS
 294
 295     use re 'taint';
 296     ($x) = ($^X =~ /^(.*)$/s);     # $x is tainted here
 297
 298     $pat = '(?{ $foo = 1 })';
 299     use re 'eval';
 300     /foo${pat}bar/;                # won't fail (when not under -T
 301                                    # switch)
 302
 303     {
 304         no re 'taint';             # the default
 305         ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
 306
 307         no re 'eval';              # the default
 308         /foo${pat}bar/;            # disallowed (with or without -T
 309                                    # switch)
 310     }
 311
 312     use re 'strict';               # Raise warnings for more conditions
 313
 314     use re '/ix';
 315     "FOO" =~ / foo /; # /ix implied
 316     no re '/x';
 317     "FOO" =~ /foo/; # just /i implied
 318
 319     use re 'debug';                # output debugging info during
 320     /^(.*)$/s;                     # compile and run time
 321
 322
 323     use re 'debugcolor';           # same as 'debug', but with colored
 324                                    # output
 325     ...
 326
 327     use re qw(Debug All);          # Same as "use re 'debug'", but you
 328                                    # can use "Debug" with things other
 329                                    # than 'All'
 330     use re qw(Debug More);         # 'All' plus output more details
 331     no re qw(Debug ALL);           # Turn on (almost) all re debugging
 332                                    # in this scope
 333
 334     use re qw(is_regexp regexp_pattern); # import utility functions
 335     my ($pat,$mods)=regexp_pattern(qr/foo/i);
 336     if (is_regexp($obj)) {
 337         print "Got regexp: ",
 338             scalar regexp_pattern($obj); # just as perl would stringify
 339     }                                    # it but no hassle with blessed
 340                                          # re's.
 341
 342 (We use $^X in these examples because it's tainted by default.)
 343
 344 =head1 DESCRIPTION
 345
 346 =head2 'taint' mode
 347
 348 When C<use re 'taint'> is in effect, and a tainted string is the target
 349 of a regexp, the regexp memories (or values returned by the m// operator
 350 in list context) are tainted.  This feature is useful when regexp operations
 351 on tainted data aren't meant to extract safe substrings, but to perform
 352 other transformations.
 353
 354 =head2 'eval' mode
 355
 356 When C<use re 'eval'> is in effect, a regexp is allowed to contain
 357 C<(?{ ... })> zero-width assertions and C<(??{ ... })> postponed
 358 subexpressions that are derived from variable interpolation, rather than
 359 appearing literally within the regexp.  That is normally disallowed, since
 360 it is a
 361 potential security risk.  Note that this pragma is ignored when the regular
 362 expression is obtained from tainted data, i.e.  evaluation is always
 363 disallowed with tainted regular expressions.  See L<perlre/(?{ code })>
 364 and L<perlre/(??{ code })>.
 365
 366 For the purpose of this pragma, interpolation of precompiled regular
 367 expressions (i.e., the result of C<qr//>) is I<not> considered variable
 368 interpolation.  Thus:
 369
 370     /foo${pat}bar/
 371
 372 I<is> allowed if $pat is a precompiled regular expression, even
 373 if $pat contains C<(?{ ... })> assertions or C<(??{ ... })> subexpressions.
 374
 375 =head2 'strict' mode
 376
 377 Note that this is an experimental feature which may be changed or removed in a
 378 future Perl release.
 379
 380 When C<use re 'strict'> is in effect, stricter checks are applied than
 381 otherwise when compiling regular expressions patterns.  These may cause more
 382 warnings to be raised than otherwise, and more things to be fatal instead of
 383 just warnings.  The purpose of this is to find and report at compile time some
 384 things, which may be legal, but have a reasonable possibility of not being the
 385 programmer's actual intent.  This automatically turns on the C<"regexp">
 386 warnings category (if not already on) within its scope.
 387
 388 As an example of something that is caught under C<"strict'>, but not
 389 otherwise, is the pattern
 390
 391  qr/\xABC/
 392
 393 The C<"\x"> construct without curly braces should be followed by exactly two
 394 hex digits; this one is followed by three.  This currently evaluates as
 395 equivalent to
 396
 397  qr/\x{AB}C/
 398
 399 that is, the character whose code point value is C<0xAB>, followed by the
 400 letter C<C>.  But since C<C> is a a hex digit, there is a reasonable chance
 401 that the intent was
 402
 403  qr/\x{ABC}/
 404
 405 that is the single character at C<0xABC>.  Under C<'strict'> it is an error to
 406 not follow C<\x> with exactly two hex digits.  When not under C<'strict'> a
 407 warning is generated if there is only one hex digit, and no warning is raised
 408 if there are more than two.
 409
 410 It is expected that what exactly C<'strict'> does will evolve over time as we
 411 gain experience with it.  This means that programs that compile under it in
 412 today's Perl may not compile, or may have more or fewer warnings, in future
 413 Perls.  There is no backwards compatibility promises with regards to it.  Also
 414 there are already proposals for an alternate syntax for enabling it.  For
 415 these reasons, using it will raise a C<experimental::re_strict> class warning,
 416 unless that category is turned off.
 417
 418 Note that if a pattern compiled within C<'strict'> is recompiled, say by
 419 interpolating into another pattern, outside of C<'strict'>, it is not checked
 420 again for strictness.  This is because if it works under strict it must work
 421 under non-strict.
 422
 423 =head2 '/flags' mode
 424
 425 When C<use re '/I<flags>'> is specified, the given I<flags> are automatically
 426 added to every regular expression till the end of the lexical scope.
 427 I<flags> can be any combination of
 428 C<'a'>,
 429 C<'aa'>,
 430 C<'d'>,
 431 C<'i'>,
 432 C<'l'>,
 433 C<'m'>,
 434 C<'n'>,
 435 C<'p'>,
 436 C<'s'>,
 437 C<'u'>,
 438 C<'x'>,
 439 and/or
 440 C<'xx'>.
 441
 442 C<no re '/I<flags>'> will turn off the effect of C<use re '/I<flags>'> for the
 443 given flags.
 444
 445 For example, if you want all your regular expressions to have /msxx on by
 446 default, simply put
 447
 448     use re '/msxx';
 449
 450 at the top of your code.
 451
 452 The character set C</adul> flags cancel each other out. So, in this example,
 453
 454     use re "/u";
 455     "ss" =~ /\xdf/;
 456     use re "/d";
 457     "ss" =~ /\xdf/;
 458
 459 the second C<use re> does an implicit C<no re '/u'>.
 460
 461 Similarly,
 462
 463     use re "/xx";   # Doubled-x
 464     ...
 465     use re "/x";    # Single x from here on
 466     ...
 467
 468 Turning on one of the character set flags with C<use re> takes precedence over the
 469 C<locale> pragma and the 'unicode_strings' C<feature>, for regular
 470 expressions. Turning off one of these flags when it is active reverts to
 471 the behaviour specified by whatever other pragmata are in scope. For
 472 example:
 473
 474     use feature "unicode_strings";
 475     no re "/u"; # does nothing
 476     use re "/l";
 477     no re "/l"; # reverts to unicode_strings behaviour
 478
 479 =head2 'debug' mode
 480
 481 When C<use re 'debug'> is in effect, perl emits debugging messages when
 482 compiling and using regular expressions.  The output is the same as that
 483 obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
 484 B<-Dr> switch. It may be quite voluminous depending on the complexity
 485 of the match.  Using C<debugcolor> instead of C<debug> enables a
 486 form of output that can be used to get a colorful display on terminals
 487 that understand termcap color sequences.  Set C<$ENV{PERL_RE_TC}> to a
 488 comma-separated list of C<termcap> properties to use for highlighting
 489 strings on/off, pre-point part on/off.
 490 See L<perldebug/"Debugging Regular Expressions"> for additional info.
 491
 492 As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
 493 lexically scoped, as the other directives are.  However they have both
 494 compile-time and run-time effects.
 495
 496 See L<perlmodlib/Pragmatic Modules>.
 497
 498 =head2 'Debug' mode
 499
 500 Similarly C<use re 'Debug'> produces debugging output, the difference
 501 being that it allows the fine tuning of what debugging output will be
 502 emitted. Options are divided into three groups, those related to
 503 compilation, those related to execution and those related to special
 504 purposes. The options are as follows:
 505
 506 =over 4
 507
 508 =item Compile related options
 509
 510 =over 4
 511
 512 =item COMPILE
 513
 514 Turns on all non-extra compile related debug options.
 515
 516 =item PARSE
 517
 518 Turns on debug output related to the process of parsing the pattern.
 519
 520 =item OPTIMISE
 521
 522 Enables output related to the optimisation phase of compilation.
 523
 524 =item TRIEC
 525
 526 Detailed info about trie compilation.
 527
 528 =item DUMP
 529
 530 Dump the final program out after it is compiled and optimised.
 531
 532 =item FLAGS
 533
 534 Dump the flags associated with the program
 535
 536 =item TEST
 537
 538 Print output intended for testing the internals of the compile process
 539
 540 =back
 541
 542 =item Execute related options
 543
 544 =over 4
 545
 546 =item EXECUTE
 547
 548 Turns on all non-extra execute related debug options.
 549
 550 =item MATCH
 551
 552 Turns on debugging of the main matching loop.
 553
 554 =item TRIEE
 555
 556 Extra debugging of how tries execute.
 557
 558 =item INTUIT
 559
 560 Enable debugging of start-point optimisations.
 561
 562 =back
 563
 564 =item Extra debugging options
 565
 566 =over 4
 567
 568 =item EXTRA
 569
 570 Turns on all "extra" debugging options.
 571
 572 =item BUFFERS
 573
 574 Enable debugging the capture group storage during match. Warning,
 575 this can potentially produce extremely large output.
 576
 577 =item TRIEM
 578
 579 Enable enhanced TRIE debugging. Enhances both TRIEE
 580 and TRIEC.
 581
 582 =item STATE
 583
 584 Enable debugging of states in the engine.
 585
 586 =item STACK
 587
 588 Enable debugging of the recursion stack in the engine. Enabling
 589 or disabling this option automatically does the same for debugging
 590 states as well. This output from this can be quite large.
 591
 592 =item GPOS
 593
 594 Enable debugging of the \G modifier.
 595
 596 =item OPTIMISEM
 597
 598 Enable enhanced optimisation debugging and start-point optimisations.
 599 Probably not useful except when debugging the regexp engine itself.
 600
 601 =item OFFSETS
 602
 603 Dump offset information. This can be used to see how regops correlate
 604 to the pattern. Output format is
 605
 606    NODENUM:POSITION[LENGTH]
 607
 608 Where 1 is the position of the first char in the string. Note that position
 609 can be 0, or larger than the actual length of the pattern, likewise length
 610 can be zero.
 611
 612 =item OFFSETSDBG
 613
 614 Enable debugging of offsets information. This emits copious
 615 amounts of trace information and doesn't mesh well with other
 616 debug options.
 617
 618 Almost definitely only useful to people hacking
 619 on the offsets part of the debug engine.
 620
 621
 622 =back
 623
 624 =item Other useful flags
 625
 626 These are useful shortcuts to save on the typing.
 627
 628 =over 4
 629
 630 =item ALL
 631
 632 Enable all options at once except OFFSETS, OFFSETSDBG and BUFFERS.
 633 (To get every single option without exception, use both ALL and EXTRA, or
 634 starting in 5.30 on a C<-DDEBUGGING>-enabled perl interpreter, use
 635 the B<-Drv> command-line switches.)
 636
 637 =item All
 638
 639 Enable DUMP and all execute options. Equivalent to:
 640
 641   use re 'debug';
 642
 643 =item MORE
 644
 645 =item More
 646
 647 Enable the options enabled by "All", plus STATE, TRIEC, and TRIEM.
 648
 649 =back
 650
 651 =back
 652
 653 As of 5.9.5 the directive C<use re 'debug'> and its equivalents are
 654 lexically scoped, as are the other directives.  However they have both
 655 compile-time and run-time effects.
 656
 657 =head2 Exportable Functions
 658
 659 As of perl 5.9.5 're' debug contains a number of utility functions that
 660 may be optionally exported into the caller's namespace. They are listed
 661 below.
 662
 663 =over 4
 664
 665 =item is_regexp($ref)
 666
 667 Returns true if the argument is a compiled regular expression as returned
 668 by C<qr//>, false if it is not.
 669
 670 This function will not be confused by overloading or blessing. In
 671 internals terms, this extracts the regexp pointer out of the
 672 PERL_MAGIC_qr structure so it cannot be fooled.
 673
 674 =item regexp_pattern($ref)
 675
 676 If the argument is a compiled regular expression as returned by C<qr//>,
 677 then this function returns the pattern.
 678
 679 In list context it returns a two element list, the first element
 680 containing the pattern and the second containing the modifiers used when
 681 the pattern was compiled.
 682
 683   my ($pat, $mods) = regexp_pattern($ref);
 684
 685 In scalar context it returns the same as perl would when stringifying a raw
 686 C<qr//> with the same pattern inside.  If the argument is not a compiled
 687 reference then this routine returns false but defined in scalar context,
 688 and the empty list in list context. Thus the following
 689
 690     if (regexp_pattern($ref) eq '(?^i:foo)')
 691
 692 will be warning free regardless of what $ref actually is.
 693
 694 Like C<is_regexp> this function will not be confused by overloading
 695 or blessing of the object.
 696
 697 =item regmust($ref)
 698
 699 If the argument is a compiled regular expression as returned by C<qr//>,
 700 then this function returns what the optimiser considers to be the longest
 701 anchored fixed string and longest floating fixed string in the pattern.
 702
 703 A I<fixed string> is defined as being a substring that must appear for the
 704 pattern to match. An I<anchored fixed string> is a fixed string that must
 705 appear at a particular offset from the beginning of the match. A I<floating
 706 fixed string> is defined as a fixed string that can appear at any point in
 707 a range of positions relative to the start of the match. For example,
 708
 709     my $qr = qr/here .* there/x;
 710     my ($anchored, $floating) = regmust($qr);
 711     print "anchored:'$anchored'\nfloating:'$floating'\n";
 712
 713 results in
 714
 715     anchored:'here'
 716     floating:'there'
 717
 718 Because the C<here> is before the C<.*> in the pattern, its position
 719 can be determined exactly. That's not true, however, for the C<there>;
 720 it could appear at any point after where the anchored string appeared.
 721 Perl uses both for its optimisations, preferring the longer, or, if they are
 722 equal, the floating.
 723
 724 B<NOTE:> This may not necessarily be the definitive longest anchored and
 725 floating string. This will be what the optimiser of the Perl that you
 726 are using thinks is the longest. If you believe that the result is wrong
 727 please report it via the L<perlbug> utility.
 728
 729 =item regname($name,$all)
 730
 731 Returns the contents of a named buffer of the last successful match. If
 732 $all is true, then returns an array ref containing one entry per buffer,
 733 otherwise returns the first defined buffer.
 734
 735 =item regnames($all)
 736
 737 Returns a list of all of the named buffers defined in the last successful
 738 match. If $all is true, then it returns all names defined, if not it returns
 739 only names which were involved in the match.
 740
 741 =item regnames_count()
 742
 743 Returns the number of distinct names defined in the pattern used
 744 for the last successful match.
 745
 746 B<Note:> this result is always the actual number of distinct
 747 named buffers defined, it may not actually match that which is
 748 returned by C<regnames()> and related routines when those routines
 749 have not been called with the $all parameter set.
 750
 751 =back
 752
 753 =head1 SEE ALSO
 754
 755 L<perlmodlib/Pragmatic Modules>.
 756
 757 =cut