File Coverage

blib/lib/Fukurama/Class/Attributes/OOStandard/Decorator.pm
Criterion Covered Total %
statement 41 47 87.2
branch 4 4 100.0
condition n/a
subroutine 9 10 90.0
pod 2 2 100.0
total 56 63 88.8


line stmt bran cond sub pod time code
1             package Fukurama::Class::Attributes::OOStandard::Decorator;
2 4     4   27 use Fukurama::Class::Version(0.02);
  4         6  
  4         36  
3 4     4   58 use Fukurama::Class::Rigid;
  4         8  
  4         29  
4              
5 4     4   2283 use Fukurama::Class::HideCaller;
  4         11  
  4         29  
6             Fukurama::Class::HideCaller->register_class(__PACKAGE__);
7              
8             =head1 NAME
9              
10             Fukurama::Class::Attributes::OOStandard::Decorator - Helper-class to decorate subroutines
11              
12             =head1 VERSION
13              
14             Version 0.02 (beta)
15              
16             =head1 SYNOPSIS
17              
18             package MyClass;
19             use Fukurama::Class::Attributes::OOStandard::Decorator();
20             my $helper = 'Fukurama::Class::Attributes::OOStandard::DefinitionCheck';
21            
22             Fukurama::Class::Attributes::OOStandard::Decorator->decorate('CGI::param', \&CGI::param, $helper);
23              
24             =head1 DESCRIPTION
25              
26             A Helper class for Fukurama::Class::Attributes::OOStandard::DefinitionCheck to decorate subroutines
27             with a subroutine to check parameters and return values and remove the decoration.
28              
29             =head1 EXPORT
30              
31             -
32              
33             =head1 METHODS
34              
35             =over 4
36              
37             =item decorate( method_identifier:STRING, actual_code_reference:\CODE, definition_checker:CLASS) return:VOID
38              
39             Decorates the given method with some parameter and return value checks.
40              
41             =item remove_decoration( method_identifier:STRING, actual_code_reference:\CODE ) return:VOID
42              
43             Remove existing decorations for parameter and return value checks.
44              
45             =back
46              
47             =head1 AUTHOR, BUGS, SUPPORT, ACKNOWLEDGEMENTS, COPYRIGHT & LICENSE
48              
49             see perldoc of L
50              
51             =cut
52              
53             # STATIC void
54             sub decorate {
55 27     27 1 36 my $class = $_[0];
56 27         49 my $identifier = $_[1];
57 27         32 my $old = $_[2];
58 27         35 my $helper = $_[3];
59            
60 4     4   23 no strict 'refs';
  4         7  
  4         124  
61 4     4   19 no warnings 'redefine';
  4         7  
  4         926  
62            
63 27         106 *{$identifier} = sub {
64 19     19   5021 $helper->try_check_call($identifier, $_[0]);
65 14         85 $helper->try_check_access($identifier);
66 13         49 $helper->try_check_abstract($identifier);
67 13         75 $helper->try_check_parameter($identifier, [@_[1..$#_]]);
68            
69 12         25 my $context = wantarray();
70 12 100       37 if($context) {
    100          
71 2         6 my @result = &$old;
72 2         20 $helper->try_check_result($identifier, \@result, $context);
73 2         12 return @result;
74             } elsif(defined($context)) {
75 8         22 my $result = &$old;
76 8         62 $helper->try_check_result($identifier, [$result], $context);
77 7         32 return $result;
78             } else {
79 2         10 goto &$old;
80             }
81 27         176 };
82 27         79 return;
83             }
84             # STATIC void
85             sub remove_decoration {
86 0     0 1   my $class = $_[0];
87 0           my $identifier = $_[1];
88 0           my $old = $_[2];
89            
90 4     4   21 no strict 'refs';
  4         7  
  4         114  
91 4     4   18 no warnings 'redefine';
  4         8  
  4         223  
92            
93 0           *{$identifier} = $old;
  0            
94 0           return;
95             }
96             1;