File Coverage

blib/lib/Data/Object/Role/Code.pm
Criterion Covered Total %
statement 29 29 100.0
branch 7 10 70.0
condition n/a
subroutine 15 15 100.0
pod 0 7 0.0
total 51 61 83.6


line stmt bran cond sub pod time code
1             # ABSTRACT: Code Object Role for Perl 5
2             package Data::Object::Role::Code;
3              
4 19     19   115554 use 5.010;
  19         66  
5 19     19   5733 use Data::Object::Role;
  19         48  
  19         166  
6              
7 19     19   5708 use Data::Object 'codify';
  19         36  
  19         8272  
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.42'; # VERSION
18              
19             sub call {
20 27     27 0 48 my ($code, @arguments) = @_;
21 27         95 return $code->(@arguments);
22             }
23              
24             sub curry {
25 2     2 0 5 my ($code, @arguments) = @_;
26 2     2   11 return sub { $code->(@arguments, @_) };
  2         6  
27             }
28              
29             sub rcurry {
30 1     1 0 2 my ($code, @arguments) = @_;
31 1     1   5 return sub { $code->(@_, @arguments) };
  1         3  
32             }
33              
34             sub compose {
35 1     1 0 3 my ($code, $next, @arguments) = @_;
36 1 50       3 $next = codify $next if !ref $next;
37 1     1   7 return curry(sub { $next->($code->(@_)) }, @arguments);
  1         4  
38             }
39              
40             sub disjoin {
41 1     1 0 41 my ($code, $next) = @_;
42 1 50       4 $next = codify $next if !ref $next;
43 1 100   5   5 return sub { $code->(@_) || $next->(@_) };
  5         32  
44             }
45              
46             sub conjoin {
47 1     1 0 37 my ($code, $next) = @_;
48 1 50       5 $next = codify $next if !ref $next;
49 1 100   10   4 return sub { $code->(@_) && $next->(@_) };
  10         2751  
50             }
51              
52             sub next {
53 10     10 0 22 goto &call;
54             }
55              
56             1;
57              
58             __END__