File Coverage

blib/lib/Data/Object/Role/Regexp.pm
Criterion Covered Total %
statement 37 37 100.0
branch 2 4 50.0
condition 3 4 75.0
subroutine 6 6 100.0
pod 0 2 0.0
total 48 53 90.5


line stmt bran cond sub pod time code
1             # ABSTRACT: A Regexp Object Role for Perl 5
2             package Data::Object::Role::Regexp;
3              
4 7     7   4125 use 5.010;
  7         18  
  7         227  
5 7     7   29 use Data::Object::Role;
  7         12  
  7         98  
6              
7 7     7   2050 use Carp 'confess';
  7         12  
  7         1984  
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.20'; # VERSION
18              
19             sub search {
20 6     6 0 14 my($self, $string, $flags) = @_;
21              
22 6         46 my $captures;
23             my @matches;
24              
25 6         12 my $op = '$string =~ m/$$self/';
26 6   50     41 my $capt = '$captures = (' . $op . ($flags // '') . ')';
27 6         12 my $mtch = '@matches = ([@-], [@+], {%-})';
28 6         15 my $expr = join ';', $capt, $mtch;
29              
30 6         8 my $error = do { local $@; eval $expr; $@ };
  6         9  
  6         682  
  6         35  
31 6 50       19 confess $error if $error;
32              
33 6         80 return [$$self, $string, $captures, @matches, $string];
34             }
35              
36             sub replace {
37 4     4 0 5 my($self, $string, $replacement, $flags) = @_;
38              
39 4         5 my $captures;
40             my @matches;
41              
42 4         5 my $op = '$string =~ s/$$self/$replacement/';
43 4   100     18 my $capt = '$captures = (' . $op . ($flags // '') . ')';
44 4         4 my $mtch = '@matches = ([@-], [@+], {%-})';
45 4         5 my $expr = join ';', $capt, $mtch;
46              
47 4         4 my $initial = $string;
48              
49 4     2   6 my $error = do { local $@; eval $expr; $@ };
  4         1  
  4         327  
  4         13  
  2         1053  
  2         898  
  2         36  
50 4 50       10 confess $error if $error;
51              
52 4         36 return [$$self, $string, $captures, @matches, $initial];
53             }
54              
55             1;
56              
57             __END__