Move NEXT from lib to ext.
[p5sagit/p5-mst-13.2.git] / ext / re / re.pm
index ce01214..d9b854d 100644 (file)
@@ -4,30 +4,18 @@ package re;
 use strict;
 use warnings;
 
-our $VERSION     = "0.07";
+our $VERSION     = "0.10";
 our @ISA         = qw(Exporter);
-our @EXPORT_OK   = qw(is_regexp regexp_pattern regmust);
+our @EXPORT_OK   = ('regmust',
+                    qw(is_regexp regexp_pattern
+                       regname regnames regnames_count));
 our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
 
-# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
-#
-# If you modify these values see comment below!
-
 my %bitmask = (
     taint   => 0x00100000, # HINT_RE_TAINT
     eval    => 0x00200000, # HINT_RE_EVAL
 );
 
-# - File::Basename contains a literal for 'taint' as a fallback.  If
-# taint is changed here, File::Basename must be updated as well.
-#
-# - ExtUtils::ParseXS uses a hardcoded 
-# BEGIN { $^H |= 0x00200000 } 
-# in it to allow re.xs to be built. So if 'eval' is changed here then
-# ExtUtils::ParseXS must be changed as well.
-#
-# *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
-
 sub setcolor {
  eval {                                # Ignore errors
   require Term::Cap;
@@ -52,6 +40,7 @@ my %flags = (
     OPTIMISE        => 0x000002,
     TRIEC           => 0x000004,
     DUMP            => 0x000008,
+    FLAGS           => 0x000010,
 
     EXECUTE         => 0x00FF00,
     INTUIT          => 0x000100,
@@ -65,42 +54,36 @@ my %flags = (
     STATE           => 0x080000,
     OPTIMISEM       => 0x100000,
     STACK           => 0x280000,
+    BUFFERS         => 0x400000,
+    GPOS            => 0x800000,
 );
-$flags{ALL} = -1;
+$flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
 $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
-$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE};
+$flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
 $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
 $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
 $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
 
-my $installed;
-my $installed_error;
-
-sub _do_install {
-    if ( ! defined($installed) ) {
-        require XSLoader;
-        $installed = eval { XSLoader::load('re', $VERSION) } || 0;
-        $installed_error = $@;
-    }
+if (defined &DynaLoader::boot_DynaLoader) {
+    require XSLoader;
+    XSLoader::load( __PACKAGE__, $VERSION);
 }
+# else we're miniperl
+# We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
+# uses re 'taint'.
 
 sub _load_unload {
     my ($on)= @_;
     if ($on) {
-        _do_install();        
-        if ( ! $installed ) {
-            die "'re' not installed!? ($installed_error)";
-       } else {
-           # We call install() every time, as if we didn't, we wouldn't
-           # "see" any changes to the color environment var since
-           # the last time it was called.
-
-           # install() returns an integer, which if casted properly
-           # in C resolves to a structure containing the regex
-           # hooks. Setting it to a random integer will guarantee
-           # segfaults.
-           $^H{regcomp} = install();
-        }
+       # We call install() every time, as if we didn't, we wouldn't
+       # "see" any changes to the color environment var since
+       # the last time it was called.
+
+       # install() returns an integer, which if casted properly
+       # in C resolves to a structure containing the regex
+       # hooks. Setting it to a random integer will guarantee
+       # segfaults.
+       $^H{regcomp} = install();
     } else {
         delete $^H{regcomp};
     }
@@ -136,10 +119,10 @@ sub bits {
         } elsif ($s eq 'debug' or $s eq 'debugcolor') {
            setcolor() if $s =~/color/i;
            _load_unload($on);
+           last;
         } elsif (exists $bitmask{$s}) {
            $bits |= $bitmask{$s};
        } elsif ($EXPORT_OK{$s}) {
-           _do_install();
            require Exporter;
            re->export_to_level(2, 're', $s);
        } else {
@@ -320,6 +303,11 @@ Enable debugging of start point optimisations.
 
 Turns on all "extra" debugging options.
 
+=item BUFFERS
+
+Enable debugging the capture buffer storage during match. Warning,
+this can potentially produce extremely large output.
+
 =item TRIEM
 
 Enable enhanced TRIE debugging. Enhances both TRIEE
@@ -370,7 +358,7 @@ These are useful shortcuts to save on the typing.
 
 =item ALL
 
-Enable all compile and execute options at once.
+Enable all options at once except OFFSETS, OFFSETSDBG and BUFFERS
 
 =item All
 
@@ -464,6 +452,28 @@ floating string. This will be what the optimiser of the Perl that you
 are using thinks is the longest. If you believe that the result is wrong
 please report it via the L<perlbug> utility.
 
+=item regname($name,$all)
+
+Returns the contents of a named buffer of the last successful match. If
+$all is true, then returns an array ref containing one entry per buffer,
+otherwise returns the first defined buffer.
+
+=item regnames($all)
+
+Returns a list of all of the named buffers defined in the last successful
+match. If $all is true, then it returns all names defined, if not it returns
+only names which were involved in the match.
+
+=item regnames_count()
+
+Returns the number of distinct names defined in the pattern used
+for the last successful match.
+
+B<Note:> this result is always the actual number of distinct
+named buffers defined, it may not actually match that which is
+returned by C<regnames()> and related routines when those routines
+have not been called with the $all parameter set.
+
 =back
 
 =head1 SEE ALSO