File Coverage

blib/lib/Data/Object/Role/Regexp.pm
Criterion Covered Total %
statement 36 36 100.0
branch 2 4 50.0
condition 3 4 75.0
subroutine 6 6 100.0
pod 0 2 0.0
total 47 52 90.3


line stmt bran cond sub pod time code
1             # ABSTRACT: Regexp Object Role for Perl 5
2             package Data::Object::Role::Regexp;
3              
4 7     7   4802 use 5.010;
  7         22  
5 7     7   38 use Data::Object::Role;
  7         19  
  7         83  
6              
7 7     7   2110 use Data::Object 'throw';
  7         12  
  7         2394  
8              
9             map with($_), our @ROLES = qw(
10             Data::Object::Role::Defined
11             Data::Object::Role::Detract
12             Data::Object::Role::Output
13             Data::Object::Role::Ref
14             Data::Object::Role::Type
15             );
16              
17             our $VERSION = '0.42'; # VERSION
18              
19             sub search {
20 6     6 0 9 my($self, $string, $flags) = @_;
21              
22 6         9 my $captures;
23             my @matches;
24              
25 6         9 my $op = '$string =~ m/$$self/';
26 6   50     29 my $capt = '$captures = (' . $op . ($flags // '') . ')';
27 6         8 my $mtch = '@matches = ([@-], [@+], {%-})';
28 6         10 my $expr = join ';', $capt, $mtch;
29              
30 6         8 my $error = do { local $@; eval $expr; $@ };
  6         7  
  6         516  
  6         28  
31 6 50       17 throw $error if $error;
32              
33 6         52 return [$$self, $string, $captures, @matches, $string];
34             }
35              
36             sub replace {
37 4     4 0 8 my($self, $string, $replacement, $flags) = @_;
38              
39 4         5 my $captures;
40             my @matches;
41              
42 4         4 my $op = '$string =~ s/$$self/$replacement/';
43 4   100     19 my $capt = '$captures = (' . $op . ($flags // '') . ')';
44 4         6 my $mtch = '@matches = ([@-], [@+], {%-})';
45 4         7 my $expr = join ';', $capt, $mtch;
46              
47 4         6 my $initial = $string;
48              
49 4     2   5 my $error = do { local $@; eval $expr; $@ };
  4         4  
  4         332  
  4         15  
  2         1552  
  2         942  
  2         35  
50 4 50       13 throw $error if $error;
51              
52 4         34 return [$$self, $string, $captures, @matches, $initial];
53             }
54              
55             1;
56              
57             __END__