File Coverage

blib/lib/Rose/HTML/Object/MakeMethods/Localization.pm
Criterion Covered Total %
statement 170 261 65.1
branch 60 132 45.4
condition 31 99 31.3
subroutine 18 21 85.7
pod 0 4 0.0
total 279 517 53.9


line stmt bran cond sub pod time code
1              
2             use strict;
3 43     43   242  
  43         84  
  43         1129  
4             use Carp();
5 43     43   195  
  43         84  
  43         710  
6             use base 'Rose::Object::MakeMethods';
7 43     43   175  
  43         351  
  43         125543  
8             our $VERSION = '0.615';
9              
10             {
11             my($class, $name, $args, $opts) = @_;
12              
13 153     153 0 10738 my %methods;
14              
15 153         306 my $interface = $args->{'interface'} || 'get_set';
16             my $key = $args->{'hash_key'} || $name;
17 153   50     701 my $id_method = $args->{'msg_id_method'} || $key . '_message_id';
18 153   33     544  
19 153   33     1624 my $accept_msg_class = $args->{'accept_msg_class'} || 'Rose::HTML::Object::Message';
20              
21 153   50     546 require Rose::HTML::Object::Message::Localized;
22              
23 153         19258 if($interface eq 'get_set')
24             {
25 153 50       488 $methods{$name} = sub
26             {
27             my($self) = shift;
28              
29 2202     2202   8860 if(@_)
30             {
31 2202 100       4414 if(@_ > 1)
32             {
33 850 50       1798 my($id) = shift;
34              
35 0         0 my @args;
36              
37 0         0 if(@_ == 1 && ref($_[0]) =~ /^(?:HASH|ARRAY)$/)
38             {
39 0 0 0     0 @args = (args => $_[0]);
40             }
41 0         0 else
42             {
43             @args = (args => [ @_ ]);
44             }
45 0         0  
46             unless($id =~ /^\d+$/)
47             {
48 0 0       0 $id = $self->localizer->get_message_id($id) ||
49             Carp::croak "Unknown message id: '$id'";
50 0   0     0 }
51              
52             return $self->$name($self->localizer->message_class->new(id => $id, parent => $self, @args));
53             }
54 0         0  
55             my $msg = shift;
56              
57 850         1331 if(UNIVERSAL::isa($msg, $accept_msg_class))
58             {
59 850 100       2818 $msg->parent($self);
60             return $self->{$key} = $msg;
61 483         1338 }
62 483         1906 else
63             {
64             return $self->{$key} = $self->localizer->message_class->new(text => $msg, parent => $self);
65             }
66 367         1244 }
67              
68             return $self->{$key};
69             };
70 1352         4319  
71 153         2110 $methods{$id_method} = sub
72             {
73             my($self) = shift;
74              
75 363     363   1114 if(@_)
76             {
77 363 50       709 my($id, @args) = @_;
78             return $self->$name(undef) unless(defined $id);
79 363         621 return $self->$name($self->localizer->message_class->new(id => $id, args => \@args, parent => $self));
80 363 100       679 }
81 349         982  
82             my $error = $self->$name();
83             return $error->id if(UNIVERSAL::can($error, 'id'));
84 0         0 return undef;
85 0 0       0 };
86 0         0 }
87 153         779 else { Carp::croak "Unknown interface: $interface" }
88              
89 0         0 return \%methods;
90             }
91 153         515  
92             {
93             my($class, $name, $args) = @_;
94              
95             my %methods;
96 0     0 0 0  
97             my $interface = $args->{'interface'} || 'get_set';
98 0         0 my $key = $args->{'hash_key'} || $name;
99             my $id_method = $args->{'error_id_method'} || $key . '_id';
100 0   0     0  
101 0   0     0 my $accept_error_class = $args->{'accept_error_class'} || 'Rose::HTML::Object::Error';
102 0   0     0  
103             require Rose::HTML::Object::Error;
104 0   0     0  
105             if($interface eq 'get_set')
106 0         0 {
107             $methods{$name} = sub
108 0 0       0 {
109             my($self) = shift;
110              
111             if(@_)
112 0     0   0 {
113             return $self->{$key} = undef unless(defined $_[0]);
114 0 0       0  
115             my $localizer = $self->localizer;
116 0 0       0  
117             if(@_ > 1)
118 0         0 {
119             my($id) = shift;
120 0 0       0  
121             my @args;
122 0         0  
123             if(@_ == 1 && ref($_[0]) =~ /^(?:HASH|ARRAY)$/)
124 0         0 {
125             @args = (args => $_[0]);
126 0 0 0     0 }
127             else
128 0         0 {
129             @args = (args => [ @_ ]);
130             }
131              
132 0         0 unless($id =~ /^\d+$/)
133             {
134             $id = $self->localizer->get_error_id($id) ||
135 0 0       0 Carp::croak "Attempt to call $name() with more than one ",
136             "argument, and the first argument is not a numeric ",
137 0   0     0 "error id: '$id'";
138             }
139              
140             unshift(@args, error_id => $id);
141              
142             my $message;
143 0         0  
144             if($self->can('message_for_error_id'))
145 0         0 {
146             $message = $self->message_for_error_id(@args);
147 0 0       0  
148             unless(defined $message)
149 0         0 {
150             $message = $localizer->message_for_error_id(@args);
151 0 0       0 }
152             }
153 0         0 else
154             {
155             $message = $localizer->message_for_error_id(@args);
156             }
157              
158 0         0  
159             return $self->$name($localizer->error_class->new(id => $id,
160             parent => $self,
161             message => $message));
162 0         0 }
163              
164             my $error = shift;
165              
166             if(UNIVERSAL::isa($error, $accept_error_class))
167 0         0 {
168             $error->parent($self);
169 0 0       0 return $self->{$key} = $error;
    0          
170             }
171 0         0 elsif(defined $error)
172 0         0 {
173             return $self->{$key} =
174             $localizer->error_class->new(message => $localizer->messsage_class->new($error),
175             parent => $self);
176 0         0 }
177             }
178              
179             return $self->{$key};
180             };
181              
182 0         0 $methods{$id_method} = sub
183 0         0 {
184             my($self) = shift;
185              
186             if(@_)
187 0     0   0 {
188             my($id) = shift;
189 0 0       0  
190             my $localizer = $self->localizer;
191 0         0  
192             my @args;
193 0         0  
194             if(@_ == 1 && ref($_[0]) =~ /^(?:HASH|ARRAY)$/)
195 0         0 {
196             @args = (args => $_[0]);
197 0 0 0     0 }
198             else
199 0         0 {
200             @args = (args => [ @_ ]);
201             }
202              
203 0         0 unless($id =~ /^\d+$/)
204             {
205             $id = $localizer->get_error_id($id) ||
206 0 0       0 Carp::croak "Unknown error id: '$id'";
207             }
208 0   0     0  
209             unshift(@args, error_id => $id);
210              
211             my $message;
212 0         0  
213             if($self->can('message_for_error_id'))
214 0         0 {
215             $message = $self->message_for_error_id(@args);
216 0 0       0  
217             unless(defined $message)
218 0         0 {
219             $message = $localizer->message_for_error_id(@args);
220 0 0       0 }
221             }
222 0         0 else
223             {
224             $message = $localizer->message_for_error_id(@args);
225             }
226              
227 0         0  
228             return $self->$name($localizer->error_class->new(id => $id,
229             parent => $self,
230             message => $message));
231 0         0 }
232              
233             my $error = $self->$name();
234             return $error->id if(UNIVERSAL::can($error, 'id'));
235             return undef;
236 0         0 };
237 0 0       0  
238 0         0 }
239 0         0 else { Carp::croak "Unknown interface: $interface" }
240              
241             return \%methods;
242 0         0 }
243              
244 0         0 {
245             my($class, $name, $args) = @_;
246              
247             my %methods;
248              
249 43     43 0 5318 my $interface = $args->{'interface'} || 'get_set';
250             my $key = $args->{'hash_key'} || $name;
251 43         99 my $plural_name = $args->{'plural_name'} || $name;
252             my $singular_name = $args->{'singular_name'} || plural_to_singular($plural_name);
253 43   50     261 my $has_method = $args->{'has_error_method'} || 'has_' . $plural_name;
254 43   33     233 my $has_method2 = $args->{'has_errors_method'} || 'has_' . $singular_name;
255 43   33     188 my $add_method = $args->{'add_error_method'} || 'add_' . $singular_name;
256 43   33     184 my $adds_method = $args->{'add_errors_method'} || 'add_' . $plural_name;
257 43   33     243 my $id_method = $args->{'error_id_method'} || $singular_name . '_id';
258 43   33     221 my $ids_method = $args->{'error_ids_method'} || $singular_name . '_ids';
259 43   33     186 my $add_id_method = $args->{'add_error_id_method'} || 'add_' . $singular_name . '_id';
260 43   33     473 my $add_ids_method = $args->{'add_error_ids_method'} || 'add_' . $singular_name . '_ids';
261 43   33     195  
262 43   33     202 my $accept_error_class = $args->{'accept_error_class'} || 'Rose::HTML::Object::Error';
263 43   33     177  
264 43   33     183 require Rose::HTML::Object::Error;
265              
266 43   50     177 if($interface eq 'get_set')
267             {
268 43         15783 $methods{$plural_name} = sub
269             {
270 43 50       207 my($self) = shift;
271              
272             if(@_)
273             {
274 19     19   51 if(!defined $_[0] || (ref $_[0] eq 'ARRAY' && !@{$_[0]}))
275             {
276 19 100       43 return $self->{$key} = undef;
277             }
278 8 100 66     44  
  1   100     5  
279             $self->{$key} = undef;
280 2         9 $self->$adds_method(@_);
281             }
282              
283 6         24 return wantarray ? @{$self->{$key} || []} : $self->{$key};
284 6         21 };
285              
286             $methods{$singular_name} = sub
287 17 50       39 {
  11 100       54  
288 43         250 my($self) = shift;
289              
290             if(@_)
291             {
292 6416     6416   18180 return $self->{$key} = undef unless(defined $_[0]);
293              
294 6416 100       11102 my $localizer = $self->localizer;
295              
296 4442 100       10652 if(@_ > 1)
297             {
298 20         76 my($id) = shift;
299              
300 20 100       545 my @args;
301              
302 2         4 if(@_ == 1 && ref($_[0]) =~ /^(?:HASH|ARRAY)$/)
303             {
304 2         3 @args = (args => $_[0]);
305             }
306 2 50 33     17 else
307             {
308 2         6 @args = (args => [ @_ ]);
309             }
310              
311             unless($id =~ /^\d+$/)
312 0         0 {
313             $id = $localizer->get_error_id($id) ||
314             Carp::croak "Attempt to call $singular_name() with more than one ",
315 2 50       8 "argument, and the first argument is not a numeric ",
316             "error id: '$id'";
317 0   0     0 }
318              
319             unshift(@args, error_id => $id);
320              
321             my $message;
322              
323 2         7 if($self->can('message_for_error_id'))
324             {
325 2         2 $message = $self->message_for_error_id(@args);
326              
327 2 50       9 unless(defined $message)
328             {
329 2         8 $message = $localizer->message_for_error_id(@args);
330             }
331 2 50       6 }
332             else
333 2         7 {
334             $message = $localizer->message_for_error_id(@args);
335             }
336              
337             $self->{$key} =
338 0         0 [ $localizer->error_class->new(id => $id, parent => $self, message => $message) ];
339              
340             return $self->{$key}[-1];
341 2         14 }
342              
343             my $error = shift;
344 2         12  
345             if(UNIVERSAL::isa($error, $accept_error_class))
346             {
347 18         42 $error->parent($self);
348             $self->{$key} = [ $error ];
349 18 50       170 }
    50          
350             elsif(defined $error)
351 0         0 {
352 0         0 $self->{$key} =
353             [ $localizer->error_class->new(message => $localizer->message_class->new($error), parent => $self) ];
354             }
355             }
356 18         87  
357             return $self->{$key}[-1];
358             };
359              
360             $methods{$adds_method} = sub
361 1992         6841 {
362 43         1278 my($self) = shift;
363              
364             return unless(@_);
365              
366 7     7   13 my $localizer = $self->localizer;
367             my $errors = __errors_from_args($self, \@_, $localizer->error_class, $localizer->message_class, $accept_error_class, 0, 0);
368 7 50       19  
369             push(@{$self->{$key}}, @$errors);
370 7         20  
371 7         90 return wantarray ? @$errors : $errors;
372             };
373 7         12  
  7         17  
374             $methods{$add_method} = sub
375 7 50       24 {
376 43         169 my($self) = shift;
377              
378             return unless(@_);
379              
380 5     5   11 my $localizer = $self->localizer;
381             my $errors = __errors_from_args($self, \@_, $localizer->error_class, $localizer->message_class, $accept_error_class, 0, 1);
382 5 50       12  
383             push(@{$self->{$key}}, @$errors);
384 5         16  
385 5         92 return wantarray ? @$errors : $errors;
386             };
387 5         11  
  5         11  
388             $methods{$id_method} = sub
389 5 50       16 {
390 43         237 my($self) = shift;
391              
392             if(@_)
393             {
394 43     43   195 my $localizer = $self->localizer;
395             my $errors = __errors_from_args($self, \@_, $localizer->error_class, $localizer->message_class, $accept_error_class, 1, 1);
396 43 100       229 $self->{$key} = $errors;
397             return $errors->[-1]->id;
398 32         140 }
399 32         970  
400 32         99 return $self->{$key}[-1] ? $self->{$key}[-1]->id : undef;
401 32         154 };
402              
403             $methods{$ids_method} = sub
404 11 50       46 {
405 43         1264 my($self) = shift;
406              
407             if(@_)
408             {
409 1     1   3 my $localizer = $self->localizer;
410             my $errors = __errors_from_args($self, \@_, $localizer->error_class, $localizer->message_class, $accept_error_class, 1, 0);
411 1 50       5 $self->{$key} = $errors;
412             return wantarray ? @$errors : $errors;
413 0         0 }
414 0         0  
415 0         0 if(defined(my $want = wantarray))
416 0 0       0 {
417             my @ids = map { $_->id } @{$self->{$key} || []};
418             return $want ? @ids : \@ids;
419 1 50       3 }
420              
421 1 50       2 return;
  2         5  
  1         5  
422 1 50       7 };
423              
424             $methods{$add_ids_method} = sub
425 0         0 {
426 43         166 my($self) = shift;
427              
428             return unless(@_);
429              
430 1     1   3 my $localizer = $self->localizer;
431             my $errors = __errors_from_args($self, \@_, $localizer->error_class, $localizer->message_class, $accept_error_class, 1, 1);
432 1 50       4  
433             push(@{$self->{$key}}, @$errors);
434 1         3  
435 1         10 if(defined(my $want = wantarray))
436             {
437 1         3 my @ids = map { $_->id } @$errors;
  1         2  
438             return $want ? @ids : \@ids;
439 1 50       4 }
440              
441 0         0 return;
  0         0  
442 0 0       0 };
443              
444             $methods{$add_id_method} = sub
445 1         3 {
446 43         177 my($self) = shift;
447              
448             return unless(@_);
449              
450 68     68   166 my $localizer = $self->localizer;
451             my $errors = __errors_from_args($self, \@_, $localizer->error_class, $localizer->message_class, $accept_error_class, 1, 0);
452 68 50       178  
453             push(@{$self->{$key}}, @$errors);
454 68         230  
455 68         2174 if(defined(my $want = wantarray))
456             {
457 68         119 my @ids = map { $_->id } @$errors;
  68         194  
458             return $want ? @ids : \@ids;
459 68 50       192 }
460              
461 0         0 return;
  0         0  
462 0 0       0 };
463              
464             $methods{$has_method} = sub { scalar @{shift->{$key} || []} };
465 68         188 $methods{$has_method2} = $methods{$has_method};
466 43         2210 }
467             else { Carp::croak "Unknown interface: $interface" }
468 43 100   38   139  
  38         701  
  38         323  
469 43         121 return \%methods;
470             }
471 0         0  
472             {
473 43         169 my($word) = shift;
474             return $word if($word =~ /[aeiouy]ss$/i);
475             $word =~ s/s$//;
476             return $word;
477             }
478 43     43 0 89  
479 43 50       232 # Acceptable formats:
480 43         179 #
481 43         207 # <error object>, ...
482             # <numeric error id> (id method only)
483             # <list of numeric error ids> (non-singular id method only)
484             # <numeric error id> <list of args> (singular only)
485             # <numeric error id> <arrayref of args>, ...
486             # <numeric error id> <hashref of args>, ...
487             {
488             my($self, $args, $error_class, $msg_class, $accept_error_class, $id_method, $singular) = @_;
489              
490             local $Carp::CarpLevel = 1;
491              
492             $args = $args->[0] if(@$args == 1 && ref($args->[0]) eq 'ARRAY');
493              
494 113     113   1298 my @errors;
495              
496 113         259 my $localizer = $self->localizer;
497              
498 113 50 66     482 for(my $i = 0; $i <= $#$args; $i++)
499             {
500 113         208 my $arg = $args->[$i];
501              
502 113         279 if(UNIVERSAL::isa($arg, $accept_error_class))
503             {
504 113         2641 $arg->parent($self);
505             push(@errors, $arg);
506 119         244 next;
507             }
508 119 100       451  
509             my $id = $arg;
510 5         17  
511 5         10 if($id_method && $id !~ /^\d+$/)
512 5         11 {
513             $id = $localizer->get_error_id($id) ||
514             Carp::croak "Unknown error id: '$id'";
515 114         191 }
516              
517 114 100 100     1608 my @msg_args;
518              
519 3   33     16 if(ref($args->[$i + 1]) =~ /^(?:HASH|ARRAY)$/)
520             {
521             @msg_args = (args => $args->[++$i]);
522             }
523 114         207 elsif($singular && ($i + 1) < $#$args)
524             {
525 114 100 66     608 @msg_args = (args => [ @$args[$i + 1 .. $#$args] ]);
    50          
526             $i = $#$args;
527 57         175 }
528              
529             unshift(@msg_args, error_id => $id, msg_class => $msg_class);
530              
531 0         0 my $message;
532 0         0  
533             if($id =~ /^\d+$/)
534             {
535 114         373 if($self->can('message_for_error_id'))
536             {
537 114         195 $message = $self->message_for_error_id(@msg_args);
538              
539 114 100       404 unless(defined $message)
540             {
541 105 50       451 $message = $localizer->message_for_error_id(@msg_args);
542             }
543 105         367 }
544             else
545 105 100       321 {
546             $message = $localizer->message_for_error_id(@msg_args);
547 68         248 }
548              
549             push(@errors, $error_class->new(id => $id,
550             message => $message,
551             parent => $self));
552 0         0 }
553             else
554             {
555 105         716 push(@errors, $error_class->new(message => $msg_class->new($id),
556             parent => $self));
557             }
558             }
559              
560             return \@errors;
561 9         29 }
562              
563             1;