Importing re-engine-Plugin-0.02.tar.gz

[perl/modules/re-engine-Plugin.git] / Plugin.pm

diff --git a/Plugin.pm b/Plugin.pm
index ec4ea06dc6f39d0b1be3dba2b2f2e68fa6e3be6f..c693c44f2077612cb72cb0669208f521b0a3292c 100644 (file)
--- a/Plugin.pm
+++ b/Plugin.pm
@@ -1,59 +1,51 @@
 # See Plugin.pod for documentation\r
 package re::engine::Plugin;\r
 use 5.009005;\r
+use base 'Regexp';\r
 use strict;\r
-use Carp 'croak';\r
-use Scalar::Util 'weaken';\r
 use XSLoader ();\r
 \r
-our $VERSION = '0.01';\r
+our $VERSION = '0.02';\r
 \r
 XSLoader::load __PACKAGE__, $VERSION;\r
 \r
-my $RE_ENGINE_PLUGIN = get_engine_plugin();\r
-my $NULL = 0;\r
+my $RE_ENGINE_PLUGIN = ENGINE();\r
 \r
 # How many? Used to cheat %^H\r
-my $callback = 0;\r
-# Valid callbacks\r
-my @callback = qw(comp exec intuit checkstr free dupe);\r
+my $callback = 1;\r
+\r
 # Where we store our CODE refs\r
 my %callback;\r
 \r
+# Generate a key to use in the %^H hash from a string, prefix the\r
+# package name like L<pragma> does\r
+my $key = sub { __PACKAGE__ . "::" . $_[0] };\r
+\r
 sub import\r
 {\r
     my ($pkg, %sub) = @_;\r
 \r
-    #$sub{$_} = sub {}\r
+    # Valid callbacks\r
+    my @callback = qw(comp exec intuit checkstr free dupe);\r
 \r
     for (@callback) {\r
         next unless exists $sub{$_};\r
         my $cb = delete $sub{$_};\r
 \r
-        # Convert "package::sub" to CODE if it isn't CODE already\r
         unless (ref $cb eq 'CODE') {\r
-            no strict 'refs';\r
-            $cb = *{$cb}{CODE};\r
+            require Carp;\r
+            Carp::croak("'$_' is not CODE");\r
         }\r
 \r
-        # Whine if we don't get a CODE ref or a valid package::sub name\r
-        croak "'$_' is not CODE and neither is the *{$cb}{CODE} fallback"\r
-            unless ref $cb eq 'CODE';\r
-\r
         # Get an ID to use\r
         my $id = $callback ++;\r
 \r
         # Insert into our callback storage,\r
         $callback{$_}->{$id} = $cb;\r
 \r
-        # Weaken it so we don't end up hanging on to something the\r
-        # caller doesn't care about anymore\r
-        #weaken($callback{$_}->{$id}); # EEK, too weak!\r
-\r
         # Instert into our cache with a key we can retrive later\r
         # knowing the ID in %^H and what callback we're getting\r
-        my $key = callback_key($_);\r
-        $^H{$key} = $id;\r
+        $^H{ $key->($_) } = $id;\r
     }\r
 \r
     $^H{regcomp} = $RE_ENGINE_PLUGIN;\r
@@ -61,31 +53,34 @@ sub import
 \r
 sub unimport\r
 {\r
-    my ($pkg) = @_;\r
-\r
     # Delete the regcomp hook\r
-    delete $^H{regcomp} if $^H{regcomp} == $RE_ENGINE_PLUGIN;\r
-}\r
-\r
-sub callback_key\r
-{\r
-    my ($name) = @_;\r
-\r
-    sprintf "rep_%s", $name;\r
+    delete $^H{regcomp}\r
+        if $^H{regcomp} == $RE_ENGINE_PLUGIN;\r
 }\r
 \r
-# Minimal function to be called from the XS\r
-sub get_callback\r
+# Minimal function to get CODE for a given key to be called by the\r
+# get_H_callback C function.\r
+sub _get_callback\r
 {\r
     my ($name) = @_; # 'comp', 'exec', ...\r
 \r
-    my $key = callback_key($name);\r
     my $h = (caller(0))[10];\r
-    my $id = $h->{$key};\r
+    my $id = $h->{ $key->($name) };\r
 \r
     my $cb = defined $id ? $callback{$name}->{$id} : 0;\r
 \r
     return $cb;\r
 }\r
 \r
+sub num_captures\r
+{\r
+    my ($re, %callback) = @_;\r
+\r
+    for my $key (keys %callback) {\r
+        $key =~ y/a-z/A-Z/; # ASCII uc\r
+        my $name = '_num_capture_buff_' . $key;\r
+        $re->$name( $callback{$key} );\r
+    }\r
+}\r
+\r
 1;\r