File Coverage

blib/lib/Data/Object/Regexp.pm
Criterion Covered Total %
statement 26 26 100.0
branch 2 4 50.0
condition 3 9 33.3
subroutine 9 9 100.0
pod 0 3 0.0
total 40 51 78.4


line stmt bran cond sub pod time code
1             # ABSTRACT: A Regexp Object for Perl 5
2             package Data::Object::Regexp;
3              
4 7     7   4209 use 5.010;
  7         26  
  7         271  
5              
6 7     7   33 use Carp 'confess';
  7         8  
  7         543  
7 7     7   33 use Scalar::Util 'blessed';
  7         8  
  7         466  
8 7     7   1438 use Data::Object 'deduce_deep', 'detract_deep';
  7         10  
  7         398  
9 7     7   1315 use Data::Object::Class 'with';
  7         96  
  7         67  
10              
11 7     7   9214 use Data::Object::Regexp::Result;
  7         19  
  7         1786  
12              
13             with 'Data::Object::Role::Regexp';
14              
15             our $VERSION = '0.20'; # VERSION
16              
17             sub new {
18 10     10 0 9745 my $class = shift;
19 10         47 my $data = shift;
20              
21 10   33     57 $class = ref($class) || $class;
22 10 50 33     140 unless (blessed($data) && $data->isa($class)) {
23 10 50 33     82 confess 'Type Instantiation Error: Not a RegexpRef'
24             unless defined($data) && !! re::is_regexp($data);
25             }
26              
27 10         51 return bless \$data, $class;
28             }
29              
30             sub data {
31 4     4 0 16 goto &detract;
32             }
33              
34             sub detract {
35 4     4 0 16 return detract_deep shift;
36             }
37              
38             around 'search' => sub {
39             my ($orig, $self, @args) = @_;
40             return Data::Object::Regexp::Result->new(
41             $self->$orig(@args)
42             );
43             };
44              
45             around 'replace' => sub {
46             my ($orig, $self, @args) = @_;
47             return Data::Object::Regexp::Result->new(
48             $self->$orig(@args)
49             );
50             };
51              
52             1;
53              
54             __END__