X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=blobdiff_plain;f=Plugin.pm;h=c693c44f2077612cb72cb0669208f521b0a3292c;hp=ec4ea06dc6f39d0b1be3dba2b2f2e68fa6e3be6f;hb=2dd7bc5f80da4fe2220e28de1102641c239d084c;hpb=def98fc0d7f5e9527b28af6b90d4ddb07fbc845c

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