X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=blobdiff_plain;f=Plugin.pm;h=eee5dadd5c24d679a3166432b47106450ce4015c;hp=d8fa3228907fb93a2913975be35c7a4769e8a26d;hb=HEAD;hpb=74d4856719cde7c6dc286b0c3e5dc78112d2fbff diff --git a/Plugin.pm b/Plugin.pm index d8fa322..eee5dad 100644 --- a/Plugin.pm +++ b/Plugin.pm @@ -1,88 +1,78 @@ -# See Plugin.pod for documentation -package re::engine::Plugin; -use 5.009005; -use strict; -use XSLoader (); - -our $VERSION = '0.04'; - -# All engines should subclass the core Regexp package -our @ISA = 'Regexp'; - -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 does -my $key = sub { __PACKAGE__ . "::" . $_[0] }; - -sub import -{ - my ($pkg, %sub) = @_; - - # Valid callbacks - my @callback = qw(comp exec); - - for (@callback) { - next unless exists $sub{$_}; - my $cb = delete $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; - - # 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{regcomp} = $RE_ENGINE_PLUGIN; -} - -sub unimport -{ - # Delete the regcomp hook - delete $^H{regcomp} - if $^H{regcomp} == $RE_ENGINE_PLUGIN; -} - -# 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 $h = (caller(0))[10]; - 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; +# See Plugin.pod for documentation +package re::engine::Plugin; +use 5.010; +use strict; + +our ($VERSION, @ISA); + +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(); + +sub import +{ + my ($pkg, %sub) = @_; + + # Valid callbacks + my @callback = qw; + + for (@callback) { + next unless exists $sub{$_}; + my $cb = $sub{$_}; + + unless (ref $cb eq 'CODE') { + require Carp; + Carp::croak("'$_' is not CODE"); + } + } + + $^H |= 0x020000; + + $^H{+(__PACKAGE__)} = _tag(@sub{@callback}); + $^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; +} + +sub callbacks +{ + my ($re, %callback) = @_; + + my %map = map { $_ => "_$_" } qw; + + for my $key (keys %callback) { + my $name = $map{$key}; + next unless defined $name; + $re->$name($callback{$key}); + } +} + +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;