File Coverage

blib/lib/re/engine/Plugin.pm
Criterion Covered Total %
statement 35 37 94.5
branch 5 8 62.5
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 49 54 90.7


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