File Coverage

lib/Die/Hard.pm
Criterion Covered Total %
statement 45 61 73.7
branch 13 26 50.0
condition 2 6 33.3
subroutine 12 14 85.7
pod 4 4 100.0
total 76 111 68.4


line stmt bran cond sub pod time code
1             package Die::Hard;
2              
3 1     1   30515 use 5.008;
  1         4  
  1         38  
4 1     1   950 use Moo;
  1         18749  
  1         6  
5 1     1   1777 use Scalar::Util ();
  1         2  
  1         18  
6 1     1   5 use Carp ();
  1         1  
  1         28  
7 1     1   947 use if $] < 5.010, 'UNIVERSAL::DOES';
  1         9  
  1         8  
8              
9             BEGIN {
10 1     1   45 no warnings;
  1         2  
  1         46  
11 1     1   2 $Die::Hard::AUTHORITY = 'cpan:TOBYINK';
12 1         591 $Die::Hard::VERSION = '0.003';
13             }
14              
15             has proxy_for => (
16             is => 'ro',
17             isa => sub {
18             Scalar::Util::blessed($_[0])
19             or Carp::confess("proxy_for must be a blessed object")
20             },
21             required => 1,
22             );
23              
24             has last_error => (
25             is => 'ro',
26             required => 0,
27             writer => '_set_last_error',
28             clearer => '_clear_last_error',
29             );
30              
31             sub BUILDARGS
32             {
33 1     1 1 960 my $class = shift;
34 1 50 33     34 return +{ proxy_for => $_[0] } if @_ == 1 && Scalar::Util::blessed($_[0]);
35 0         0 return $class->SUPER::BUILDARGS(@_);
36             }
37              
38             sub AUTOLOAD
39             {
40 2     2   41 my ($meth) = (our $AUTOLOAD =~ /::([^:]+)$/);
41            
42 2         5 local $@ = undef;
43 2         4 my $self = shift;
44            
45 2         35 $self->_clear_last_error;
46            
47 2   33     399 my $coderef = $self->proxy_for->can($meth) || $meth;
48            
49 2 50       8 if (wantarray)
    50          
50             {
51 0         0 my @r;
52             $self->_set_last_error($@)
53 0 0       0 unless eval { @r = $self->proxy_for->$coderef(@_); 1 };
  0         0  
  0         0  
54 0         0 return @r;
55             }
56             elsif (defined wantarray)
57             {
58 2         3 my $r;
59             $self->_set_last_error($@)
60 2 100       4 unless eval { $r = $self->proxy_for->$coderef(@_); 1 };
  2         9  
  1         6  
61 2         19 return $r;
62             }
63             else
64             {
65             $self->_set_last_error($@)
66 0 0       0 unless eval { $self->proxy_for->$coderef(@_); 1 };
  0         0  
  0         0  
67 0         0 return;
68             }
69             }
70              
71             sub can
72             {
73 21     21 1 29720 my ($self, $method) = @_;
74 21 100       140 return $self->SUPER::can($method) unless Scalar::Util::blessed($self);
75            
76 7         36 my $i_can = $self->SUPER::can($method);
77 7         29 my $he_can = $self->proxy_for->can($method);
78            
79 7 100       26 return $i_can if $i_can;
80 2 50   0   12 return sub { our $AUTOLOAD = $method; goto \&AUTOLOAD } if $he_can;
  0         0  
  0         0  
81 0         0 return;
82             }
83              
84             sub DOES
85             {
86 0     0 1 0 my ($self, $role) = @_;
87 0 0       0 return $self->SUPER::DOES($role) unless Scalar::Util::blessed($self);
88 0 0       0 $self->SUPER::DOES($role) or $self->proxy_for->DOES($role);
89             }
90              
91             sub isa
92             {
93 3     3 1 680 my ($self, $role) = @_;
94 3 50       14 return $self->SUPER::isa($role) unless Scalar::Util::blessed($self);
95 3 100       41 $self->SUPER::isa($role) or $self->proxy_for->isa($role);
96             }
97              
98 1     1   5 no Moo;
  1         1  
  1         27  
99              
100             1;
101             __END__