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