File Coverage

blib/lib/Data/Object/Code.pm
Criterion Covered Total %
statement 19 19 100.0
branch 1 4 25.0
condition 2 6 33.3
subroutine 7 7 100.0
pod 0 3 0.0
total 29 39 74.3


line stmt bran cond sub pod time code
1             # ABSTRACT: Code Object for Perl 5
2             package Data::Object::Code;
3              
4 19     19   11579 use 5.010;
  19         62  
5              
6 19     19   98 use Scalar::Util 'blessed';
  19         29  
  19         1527  
7 19     19   5074 use Data::Object 'deduce_deep', 'detract_deep', 'throw';
  19         37  
  19         1431  
8 19     19   4803 use Data::Object::Class 'with';
  19         46  
  19         202  
9              
10             with 'Data::Object::Role::Code';
11              
12             our $VERSION = '0.41'; # VERSION
13              
14             sub new {
15 24     24 0 19392 my $class = shift;
16 24         45 my $args = shift;
17 24         46 my $role = 'Data::Object::Role::Type';
18              
19 24 0 33     190 $args = $args->data if blessed($args)
      33        
20             and $args->can('does')
21             and $args->does($role);
22              
23 24 50       128 throw 'Type Instantiation Error: Not a CodeRef'
24             unless 'CODE' eq ref $args;
25              
26 24         89 return bless $args, $class;
27             }
28              
29             around 'call' => sub {
30             my ($orig, $self, @args) = @_;
31             my $result = $self->$orig(@args);
32             return scalar deduce_deep $result;
33             };
34              
35             around 'compose' => sub {
36             my ($orig, $self, @args) = @_;
37             my $next = deduce_deep shift @args;
38             my $result = $self->$orig($next, @args);
39             return scalar deduce_deep $result;
40             };
41              
42             around 'conjoin' => sub {
43             my ($orig, $self, @args) = @_;
44             my $next = deduce_deep shift @args;
45             my $result = $self->$orig($next, @args);
46             return scalar deduce_deep $result;
47             };
48              
49             around 'curry' => sub {
50             my ($orig, $self, @args) = @_;
51             my $result = $self->$orig(@args);
52             return scalar deduce_deep $result;
53             };
54              
55             sub data {
56 2     2 0 11 goto &detract;
57             }
58              
59             sub detract {
60 4     4 0 19 return detract_deep shift;
61             }
62              
63             around 'disjoin' => sub {
64             my ($orig, $self, @args) = @_;
65             my $next = deduce_deep shift @args;
66             my $result = $self->$orig($next, @args);
67             return scalar deduce_deep $result;
68             };
69              
70             around 'next' => sub {
71             my ($orig, $self, @args) = @_;
72             my $result = $self->$orig(@args);
73             return scalar deduce_deep $result;
74             };
75              
76             around 'rcurry' => sub {
77             my ($orig, $self, @args) = @_;
78             my $result = $self->$orig(@args);
79             return scalar deduce_deep $result;
80             };
81              
82             1;
83              
84             __END__