# See Plugin.pod for documentation
package re::engine::Plugin;
-use 5.009005;
+use 5.010;
use strict;
-use XSLoader ();
-our $VERSION = '0.05';
+our ($VERSION, @ISA);
-# All engines should subclass the core Regexp package
-our @ISA = 'Regexp';
-
-XSLoader::load __PACKAGE__, $VERSION;
+BEGIN {
+ $VERSION = '0.12';
+ # All engines should subclass the core Regexp package
+ @ISA = 'Regexp';
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
+}
my $RE_ENGINE_PLUGIN = ENGINE();
-# How many? Used to cheat %^H
-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) = @_;
# Valid callbacks
- my @callback = qw(comp exec);
+ my @callback = qw<comp exec free>;
for (@callback) {
next unless exists $sub{$_};
- my $cb = delete $sub{$_};
+ my $cb = $sub{$_};
unless (ref $cb eq 'CODE') {
require Carp;
Carp::croak("'$_' is not CODE");
}
+ }
- # Get an ID to use
- my $id = $callback ++;
-
- # Insert into our callback storage,
- $callback{$_}->{$id} = $cb;
+ $^H |= 0x020000;
- # Instert into our cache with a key we can retrive later
- # knowing the ID in %^H and what callback we're getting
- $^H{ $key->($_) } = $id;
- }
+ $^H{+(__PACKAGE__)} = _tag(@sub{@callback});
+ $^H{regcomp} = $RE_ENGINE_PLUGIN;
- $^H{regcomp} = $RE_ENGINE_PLUGIN;
+ return;
}
sub unimport
# Delete the regcomp hook
delete $^H{regcomp}
if $^H{regcomp} == $RE_ENGINE_PLUGIN;
+
+ delete $^H{+(__PACKAGE__)};
+
+ return;
}
-# Minimal function to get CODE for a given key to be called by the
-# get_H_callback C function.
-sub _get_callback
+sub callbacks
{
- my ($name) = @_; # 'comp', 'exec', ...
-
- my $h = (caller(0))[10];
- my $id = $h->{ $key->($name) };
+ my ($re, %callback) = @_;
- my $cb = defined $id ? $callback{$name}->{$id} : 0;
+ my %map = map { $_ => "_$_" } qw<exec free>;
- return $cb;
+ for my $key (keys %callback) {
+ my $name = $map{$key};
+ next unless defined $name;
+ $re->$name($callback{$key});
+ }
}
sub num_captures