File Coverage

blib/lib/re/engine/Plugin.pm
Criterion Covered Total %
statement 34 36 94.4
branch 5 8 62.5
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 48 53 90.5


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