File Coverage

blib/lib/Regex/Object.pm
Criterion Covered Total %
statement 50 51 98.0
branch 2 2 100.0
condition n/a
subroutine 14 14 100.0
pod 3 3 100.0
total 69 70 98.5


line stmt bran cond sub pod time code
1             package Regex::Object;
2              
3 4     4   306662 use 5.20.0;
  4         42  
4              
5 4     4   25 use utf8;
  4         7  
  4         35  
6 4     4   2316 use English;
  4         18240  
  4         27  
7 4     4   1732 use feature qw(signatures);
  4         10  
  4         626  
8              
9 4     4   1917 use Regex::Object::Match;
  4         13  
  4         213  
10 4     4   2431 use Regex::Object::Matches;
  4         61  
  4         170  
11 4     4   32 use Moo;
  4         8  
  4         18  
12              
13 4     4   1649 no warnings qw(experimental::signatures);
  4         9  
  4         163  
14 4     4   23 use namespace::clean;
  4         25  
  4         43  
15              
16             our $VERSION = '1.24';
17              
18             tie my %nc, "Tie::Hash::NamedCapture";
19             tie my %nca, "Tie::Hash::NamedCapture", all => 1;
20              
21             has regex => (
22             is => 'ro',
23             );
24              
25 11     11 1 7529 sub match($self, $string) {
  11         25  
  11         22  
  11         19  
26 11         96 $string =~ $self->regex;
27 11         37 return $self->collect;
28             }
29              
30 5     5 1 1919 sub match_all($self, $string) {
  5         11  
  5         10  
  5         8  
31 5         14 my $regex = $self->regex;
32 5         7 my @matches;
33              
34 5         46 while($string =~ /$regex/g) {
35 11         27 push @matches, $self->collect;
36             }
37              
38 5         85 return Regex::Object::Matches->new(
39             collection => \@matches,
40             );
41             }
42              
43             sub collect {
44 25     25 1 379 return Regex::Object::Match->new(
45             prematch => $PREMATCH,
46             match => $MATCH,
47             postmatch => $POSTMATCH,
48             last_paren_match => $LAST_PAREN_MATCH,
49             captures => _collect_captures(),
50             named_captures => { %nc },
51             named_captures_all => { %nca },
52             );
53             }
54              
55             sub _collect_captures {
56 25     25   41 my @captures;
57              
58             # Trick to get @captures the most appropriate to language version way.
59             eval {
60 25         131 @captures = @{^CAPTURE}; # This was added in 5.25.7.
61             }
62 25 100       39 or do {
63 4     4   2834 no strict 'refs';
  4         9  
  4         607  
64 8         35 @captures = map { "$$_" } 1 .. $#-;
  0         0  
65             };
66              
67 25         679 return \@captures;
68             }
69              
70             1;
71              
72             __END__