File Coverage

blib/lib/Fukurama/Class/Attributes/OOStandard/InheritationCheck.pm
Criterion Covered Total %
statement 130 161 80.7
branch 42 74 56.7
condition 29 48 60.4
subroutine 13 14 92.8
pod 1 1 100.0
total 215 298 72.1


line stmt bran cond sub pod time code
1             package Fukurama::Class::Attributes::OOStandard::InheritationCheck;
2 4     4   25 use Fukurama::Class::Version(0.02);
  4         9  
  4         38  
3 4     4   26 use Fukurama::Class::Rigid;
  4         9  
  4         36  
4 4     4   29 use Fukurama::Class::Carp;
  4         9  
  4         36  
5 4     4   23 use Fukurama::Class::Tree();
  4         9  
  4         325  
6              
7             my $AVOID_DOUBLE_INHERIT_ERRORS = {};
8             my $IGNORE_UNOVERWRITABLE_TYPE = {
9             'implements' => 1,
10             };
11              
12             =head1 NAME
13              
14             Fukurama::Class::Attributes::OOStandard::InheritationCheck - Helper-class to check the inheritation of code attributes
15              
16             =head1 VERSION
17              
18             Version 0.02 (beta)
19              
20             =head1 SYNOPSIS
21              
22             - (its only a collection of methods, it's unusable outside of it's own context :)
23              
24             =head1 DESCRIPTION
25              
26             A helper class for Fukurama::Class::Attributes::OOStandard to check code attribute syntax.
27              
28             =head1 EXPORT
29              
30             -
31              
32             =head1 METHODS
33              
34             =over 4
35              
36             =item check_inheritation( method_name:STRING, parent_class:CLASS, child_class:CLASS, inheritation_type:STRING, definition_data:\HASH ) return:VOID
37              
38             Check the inheritations of all defined declarations to avoid differend method signatures for parent and child.
39              
40             =back
41              
42             =head1 AUTHOR, BUGS, SUPPORT, ACKNOWLEDGEMENTS, COPYRIGHT & LICENSE
43              
44             see perldoc of L
45              
46             =cut
47              
48             # STATIC void
49             sub _check_level_contains {
50 334     334   2441 my $class = $_[0];
51 334         708 my $level = $_[1];
52            
53             {
54            
55 4     4   26 no strict 'refs';
  4         8  
  4         1298  
  334         1972  
56              
57 334 50       336 _croak("Internal error: check-level '$level' is not defined in attribute-class") if(!defined(${"Fukurama\::Class\::Attributes\::OOStandard\::$level"}));
  334         1763  
58 334 50       364 return 1 if($Fukurama::Class::Attributes::OOStandard::CHECK_LEVEL >= ${"Fukurama\::Class\::Attributes\::OOStandard\::$level"});
  334         2451  
59             }
60 0         0 return 0;
61             }
62             # STATIC void
63             sub check_inheritation {
64 198     198 1 232 my $class = $_[0];
65 198         217 my $method_name = $_[1];
66 198         230 my $parent_class = $_[2];
67 198         196 my $child_class = $_[3];
68 198         226 my $inheritation_type = $_[4];
69 198         211 my $definition_data = $_[5];
70            
71 198 50       482 return if(!$class->_check_level_contains('LEVEL_CHECK_SYNTAX'));
72            
73 198         351 my $parent_id = "$parent_class\::$method_name";
74 198         305 my $child_id = "$child_class\::$method_name";
75            
76 198 100       928 if(Fukurama::Class::Tree->is_special_sub($method_name)) {
77 62 50       247 if($definition_data->{'register'}->{$parent_id}) {
78 0         0 $class->_throw_inherit_error("You can't defined any attribute for perl-intern subroutine", $parent_class, $method_name);
79             }
80 62 50       166 if($definition_data->{'register'}->{$child_id}) {
81 0         0 $class->_throw_inherit_error("You can't defined any attribute for perl-intern subroutine", $child_class, $method_name);
82             }
83 62         176 return;
84             }
85            
86 136         178 my $parent_exist = 0;
87 136         317 my $child_exist = 0;
88             {
89            
90 4     4   24 no strict 'refs';
  4         10  
  4         7395  
  136         129  
91            
92 136 100       146 $parent_exist = 1 if(*{$parent_id}{'CODE'});
  136         482  
93 136 100       353 $child_exist = 1 if(*{$child_id}{'CODE'});
  136         461  
94             }
95            
96 136         646 my $parent = $definition_data->{'register'}->{$parent_id};
97 136         222 my $child = $definition_data->{'register'}->{$child_id};
98 136 50       318 if($class->_check_level_contains('LEVEL_CHECK_FORCE_ATTRIBUTES')) {
99 136 50 66     442 if(!$definition_data->{'register'}->{$parent_id} && $parent_exist) {
100 0         0 $class->_throw_inherit_error("You don't have defined any attribute for", $parent_class, $method_name);
101             }
102 136 50 66     415 if(!$definition_data->{'register'}->{$child_id} && $child_exist) {
103 0         0 $class->_throw_inherit_error("You don't have defined any attribute for", $child_class, $method_name);
104             }
105 136         509 $class->_check_attribute_inheritation($parent, $parent_exist, $parent_class, $child, $child_exist, $child_class, $method_name);
106             }
107 136         401 $class->_check_inheritation_type($parent, $parent_exist, $parent_class, $child, $child_exist, $child_class, $method_name, $inheritation_type, $definition_data);
108            
109 136 100 66     1124 if($parent_exist && $parent && $child_exist && $child) {
      100        
      66        
110 87         1379 $class->_compare_definitions($parent, $child, $definition_data);
111             }
112 134         636 return;
113             }
114             # STATIC void
115             sub _check_attribute_inheritation {
116 136     136   422 my $class = $_[0];
117 136         168 my $parent = $_[1];
118 136         140 my $parent_exist = $_[2];
119 136         142 my $parent_class = $_[3];
120 136         307 my $child = $_[4];
121 136         140 my $child_exist = $_[5];
122 136         330 my $child_class = $_[6];
123 136         166 my $method_name = $_[7];
124            
125 136 50 66     1108 if($parent_exist && $parent && $child_exist && !$child) {
      100        
      66        
126 0         0 $class->_throw_inherit_error("You don't have defined any attribute for child of " .
127             "'$parent_class->$method_name', which has an attribute ", $child_class, $method_name);
128             }
129 136         465 return;
130             }
131             # STATIC void
132             sub _check_inheritation_type {
133 136     136   174 my $class = $_[0];
134 136         503 my $parent = $_[1];
135 136         152 my $parent_exist = $_[2];
136 136         159 my $parent_class = $_[3];
137 136         148 my $child = $_[4];
138 136         142 my $child_exist = $_[5];
139 136         150 my $child_class = $_[6];
140 136         151 my $method_name = $_[7];
141 136         148 my $inheritation_type = $_[8];
142 136         327 my $definition_data = $_[9];
143              
144 136 100 66     616 return if(!$parent_exist || !$parent);
145            
146 119 100       521 if($definition_data->{'type'}->{$parent->{'type'}} eq 'unoverwritable') {
    50          
147 4 50 33     23 if($child_exist && !$IGNORE_UNOVERWRITABLE_TYPE->{$inheritation_type}) {
148 0         0 $class->_throw_inherit_error("You've overwritten the method '$parent_class->$method_name', " .
149             "which is defined as '$parent->{'type'}'", $child_class, $method_name, $inheritation_type);
150             }
151             } elsif($definition_data->{'type'}->{$parent->{'type'}} eq 'overwrite') {
152 0 0       0 if(!$child_exist) {
153 0         0 $class->_throw_inherit_error("You don't have overwritten the method '$parent_class->$method_name', " .
154             "which is defined as '$parent->{'type'}'", $child_class, $method_name);
155             }
156             }
157 119 50       535 if($definition_data->{'access_level_type'}->{$parent->{'access_level'}} eq 'unoverwritable') {
158 0 0 0     0 if($child_exist && !$IGNORE_UNOVERWRITABLE_TYPE->{$inheritation_type}) {
159 0         0 $class->_throw_inherit_error("You've overwritten the method '$parent_class->$method_name', " .
160             "which is defined as '$parent->{'access_level'}'", $child_class, $method_name);
161             }
162             }
163 119         274 return;
164             }
165             # STATIC void
166             sub _compare_definitions {
167 87     87   112 my $class = $_[0];
168 87         89 my $parent = $_[1];
169 87         96 my $child = $_[2];
170 87         92 my $definition_data = $_[3];
171            
172 87 50       302 if($parent->{'sub_data'}->{'attribute'} ne $child->{'sub_data'}->{'attribute'}) {
173 0         0 $class->_throw_compare_error("Child and parent have to be the same subroutine type ($parent->{'sub_data'}->{'attribute'})", $parent, $child);
174             }
175 87 50       236 if($parent->{'sub_data'}->{'sub_name'} ne $child->{'sub_data'}->{'sub_name'}) {
176 0         0 $class->_throw_compare_error("INTERNAL ERROR: compare different subroutine-names", $parent, $child);
177             }
178            
179 87 50       207 if($parent->{'static'} ne $child->{'static'}) {
180 0 0       0 $class->_throw_compare_error("Child and parent have to be the same access type (" . ($parent->{'static'} ? 'static' : 'non static') . ")", $parent, $child);
181             }
182 87 100       260 if($definition_data->{'access_level'}->{$child->{'access_level'}} != $definition_data->{'access_level'}->{$parent->{'access_level'}}) {
183 2         12 $class->_throw_compare_error("The child-access-level ($child->{'access_level'}) can't be another as the parent-access-level ($parent->{'access_level'})", $parent, $child);
184             }
185            
186 85         226 my $io_errors = $class->_compare_list($parent, $child, 'para', 'parameter', 0);
187 85         107 push(@$io_errors, @{$class->_compare_list($parent, $child, 'opt_para', 'optional parameter', 1)});
  85         213  
188 85         117 push(@$io_errors, @{$class->_compare_list($parent, $child, 'result', '$return value', 0)});
  85         241  
189 85         124 push(@$io_errors, @{$class->_compare_list($parent, $child, 'array_result', '@return value', 1)});
  85         211  
190 85 50       172 if(scalar(@$io_errors)) {
191 0         0 $class->_throw_compare_error(join("\n", @$io_errors), $parent, $child);
192             }
193 85         167 return;
194             }
195             # STATIC srting[]
196             sub _compare_list {
197 340     340   395 my $class = $_[0];
198 340         359 my $parent = $_[1];
199 340         339 my $child = $_[2];
200 340         358 my $io_key = $_[3];
201 340         327 my $io_type = $_[4];
202 340         358 my $child_can_extend = $_[5];
203            
204 340         445 my $errors = [];
205 340         370 my $i = 0;
206 340         321 while(1) {
207 597         954 my $parent_io = $parent->{$io_key}->[$i];
208 597         800 my $child_io = $child->{$io_key}->[$i];
209 597 100 66     1569 last if(!$parent_io && !$child_io);
210            
211 257         547 my $error_prefix = "> - $io_type " . ($i + 1) . ': ';
212 257 100 66     2327 if(!$parent_io && $child_io) {
    50 33        
    100 66        
213 18 50       60 if(!$child_can_extend) {
214 0         0 push(@$errors, "$error_prefix no further $io_type is/are allowed in child " .
215             "(- <> $child_io->{'type'}$child_io->{'ref'}).");
216             }
217             } elsif($parent_io && !$child_io) {
218 0         0 push(@$errors, "$error_prefix child has less ${io_type}s than parent " .
219             "($parent_io->{'type'}$parent_io->{'ref'} <> -).");
220             } elsif($parent_io->{'ref'} ne $child_io->{'ref'} || $parent_io->{'type'} ne $child_io->{'type'}) {
221            
222 42 50 33     191 if($parent_io->{'check'}->{'is_class'} && $parent_io->{'ref'} eq $child_io->{'ref'}) {
223 42 50       142 if(!UNIVERSAL::isa($child_io->{'type'}, $parent_io->{'type'})) {
224 0         0 push(@$errors, "$error_prefix childs ${io_type}-class doesnt inherit from parents ${io_type}-class " .
225             "($parent_io->{'type'}$parent_io->{'ref'} <> $child_io->{'type'}$child_io->{'ref'}).");
226             }
227             } else {
228 0         0 push(@$errors, "$error_prefix child has different ${io_type}-definition than parent " .
229             "($parent_io->{'type'}$parent_io->{'ref'} <> $child_io->{'type'}$child_io->{'ref'}).");
230             }
231             }
232 257         402 ++$i;
233             }
234 340 50       635 unshift(@$errors, "Error(s) in $io_type:") if(scalar(@$errors));
235 340         733 return $errors;
236             }
237             # STATIC void
238             sub _throw_compare_error {
239 2     2   6 my $class = $_[0];
240 2         3 my $msg = $_[1];
241 2         3 my $parent = $_[2];
242 2         5 my $child = $_[3];
243            
244 2         5 my $parent_d = $parent->{'sub_data'};
245 2         13 my $child_d = $child->{'sub_data'};
246 2         11 my $parent_subdef = "$parent_d->{'class'}->$parent_d->{'sub_name'} : $parent_d->{'attribute'}($parent_d->{'data'})";
247 2         9 my $child_subdef = "$child_d->{'class'}->$child_d->{'sub_name'} : $child_d->{'attribute'}($child_d->{'data'})";
248            
249 2         8 my $error = "Error in $parent->{'sub_data'}->{'attribute'} definition:\n> $msg\n> parent: $parent_subdef\n> child: $child_subdef\n";
250 2 50       10 if(!$AVOID_DOUBLE_INHERIT_ERRORS->{$error}) {
251 2         9 $AVOID_DOUBLE_INHERIT_ERRORS->{$error} = 1;
252 2         42 _croak($error);
253             }
254 0           return;
255             }
256             # STATIC void
257             sub _throw_inherit_error {
258 0     0     my $class = $_[0];
259 0           my $msg = $_[1];
260 0           my $classname = $_[2];
261 0           my $subname = $_[3];
262 0           my $inheritation_type = $_[4];
263            
264 0 0         my $type = ($inheritation_type ? " with '$inheritation_type'" : '');
265 0           my $error = "Error in subroutine definition$type:\n> $msg\n> class: '$classname', subroutine '$subname'\n";
266 0 0         if(!$AVOID_DOUBLE_INHERIT_ERRORS->{$error}) {
267 0           $AVOID_DOUBLE_INHERIT_ERRORS->{$error} = 1;
268 0           _croak($error);
269             }
270 0           return;
271             }
272             1;