File Coverage

blib/lib/Data/Object/Regexp.pm
Criterion Covered Total %
statement 22 22 100.0
branch 2 4 50.0
condition 3 9 33.3
subroutine 8 8 100.0
pod 0 3 0.0
total 35 46 76.0


line stmt bran cond sub pod time code
1             # ABSTRACT: Regexp Object for Perl 5
2             package Data::Object::Regexp;
3              
4 7     7   4617 use 5.010;
  7         18  
5              
6 7     7   35 use Scalar::Util 'blessed';
  7         11  
  7         552  
7 7     7   2036 use Data::Object 'deduce_deep', 'detract_deep', 'throw';
  7         14  
  7         461  
8 7     7   1795 use Data::Object::Class 'with';
  7         19  
  7         58  
9              
10 7     7   10581 use Data::Object::Regexp::Result;
  7         19  
  7         2045  
11              
12             with 'Data::Object::Role::Regexp';
13              
14             our $VERSION = '0.42'; # VERSION
15              
16             sub new {
17 10     10 0 6866 my $class = shift;
18 10         42 my $args = shift;
19 10         20 my $role = 'Data::Object::Role::Type';
20              
21 10 50 33     175 $args = $args->data if blessed($args)
      33        
22             and $args->can('does')
23             and $args->does($role);
24              
25 10 50 33     81 throw 'Type Instantiation Error: Not a RegexpRef'
26             unless defined($args) && !! re::is_regexp($args);
27              
28 10         38 return bless \$args, $class;
29             }
30              
31             sub data {
32 4     4 0 19 goto &detract;
33             }
34              
35             sub detract {
36 4     4 0 16 return detract_deep shift;
37             }
38              
39             around 'search' => sub {
40             my ($orig, $self, @args) = @_;
41             return Data::Object::Regexp::Result->new(
42             $self->$orig(@args)
43             );
44             };
45              
46             around 'replace' => sub {
47             my ($orig, $self, @args) = @_;
48             return Data::Object::Regexp::Result->new(
49             $self->$orig(@args)
50             );
51             };
52              
53             1;
54              
55             __END__