Plugin.pm

   1 # See Plugin.pod for documentation
   2 package re::engine::Plugin;
   3 use 5.010;
   4 use strict;
   5
   6 our ($VERSION, @ISA);
   7
   8 BEGIN {
   9  $VERSION = '0.11';
  10  # All engines should subclass the core Regexp package
  11  @ISA = 'Regexp';
  12  require XSLoader;
  13  XSLoader::load(__PACKAGE__, $VERSION);
  14 }
  15
  16 my $RE_ENGINE_PLUGIN = ENGINE();
  17
  18 sub import
  19 {
  20     my ($pkg, %sub) = @_;
  21
  22     # Valid callbacks
  23     my @callback = qw<comp exec free>;
  24
  25     for (@callback) {
  26         next unless exists $sub{$_};
  27         my $cb = $sub{$_};
  28
  29         unless (ref $cb eq 'CODE') {
  30             require Carp;
  31             Carp::croak("'$_' is not CODE");
  32         }
  33     }
  34
  35     $^H |= 0x020000;
  36
  37     $^H{+(__PACKAGE__)} = _tag(@sub{@callback});
  38     $^H{regcomp}        = $RE_ENGINE_PLUGIN;
  39
  40     return;
  41 }
  42
  43 sub unimport
  44 {
  45     # Delete the regcomp hook
  46     delete $^H{regcomp}
  47         if $^H{regcomp} == $RE_ENGINE_PLUGIN;
  48
  49     delete $^H{+(__PACKAGE__)};
  50
  51     return;
  52 }
  53
  54 sub callbacks
  55 {
  56     my ($re, %callback) = @_;
  57
  58     my %map = map { $_ => "_$_" } qw<exec free>;
  59
  60     for my $key (keys %callback) {
  61         my $name = $map{$key};
  62         next unless defined $name;
  63         $re->$name($callback{$key});
  64     }
  65 }
  66
  67 sub num_captures
  68 {
  69     my ($re, %callback) = @_;
  70
  71     for my $key (keys %callback) {
  72         $key =~ y/a-z/A-Z/; # ASCII uc
  73         my $name = '_num_capture_buff_' . $key;
  74         $re->$name( $callback{$key} );
  75     }
  76 }
  77
  78 1;