File Coverage

blib/lib/Rose/HTML/Object/Error.pm
Criterion Covered Total %
statement 70 94 74.4
branch 18 40 45.0
condition 1 12 8.3
subroutine 20 23 86.9
pod 1 9 11.1
total 110 178 61.8


line stmt bran cond sub pod time code
1             package Rose::HTML::Object::Error;
2              
3 43     43   313 use strict;
  43         104  
  43         1391  
4              
5 43     43   252 use Carp;
  43         102  
  43         2487  
6 43     43   279 use Clone::PP();
  43         107  
  43         683  
7 43     43   208 use Scalar::Util();
  43         96  
  43         1145  
8              
9 43     43   271 use base 'Rose::Object';
  43         131  
  43         4968  
10              
11 43     43   330 use Rose::HTML::Object::Errors qw(CUSTOM_ERROR);
  43         153  
  43         444  
12              
13             our $VERSION = '0.606';
14              
15             #our $Debug = 0;
16              
17             use overload
18             (
19 43     43   345 '""' => sub { no warnings 'uninitialized'; shift->message . '' },
  43     186   133  
  43         4078  
  186         19886  
20 1082     1082   3009 'bool' => sub { 1 },
21 0     0   0 '0+' => sub { 1 },
22 43         598 fallback => 1,
23 43     43   40060 );
  43         32374  
24              
25             use Rose::Class::MakeMethods::Generic
26             (
27 43         1630 inheritable_scalar =>
28             [
29             '_default_localizer',
30             'default_locale',
31             ],
32 43     43   5142 );
  43         105  
33              
34             use Rose::HTML::Object::MakeMethods::Localization
35             (
36 43         362 localized_message =>
37             [
38             'message',
39             ],
40 43     43   11145 );
  43         116  
41              
42             __PACKAGE__->default_locale('en');
43              
44 0     0 0 0 sub generic_object_class { 'Rose::HTML::Object' }
45              
46 43     43 0 4359 sub as_string { no warnings 'uninitialized'; "$_[0]" }
  43     13   120  
  43         30311  
  13         43  
47              
48             sub parent
49             {
50 646     646 0 1651 my($self) = shift;
51 646 100       1591 return Scalar::Util::weaken($self->{'parent'} = shift) if(@_);
52 506         1259 return $self->{'parent'};
53             }
54              
55             sub localizer
56             {
57 187     187 0 337 my($invocant) = shift;
58              
59             # Called as object method
60 187 50       515 if(my $class = ref $invocant)
61             {
62 187 50       508 if(@_)
63             {
64 0         0 return $invocant->{'localizer'} = shift;
65             }
66              
67 187         370 my $localizer = $invocant->{'localizer'};
68              
69 187 50       420 unless($localizer)
70             {
71 187 50       422 if(my $parent = $invocant->parent)
72             {
73 187 50       580 if(my $localizer = $parent->localizer)
74             {
75 187         6098 return $localizer;
76             }
77             }
78 0         0 else { return $class->default_localizer }
79             }
80              
81 0   0     0 return $localizer || $class->default_localizer;
82             }
83             else # Called as class method
84             {
85 0 0       0 if(@_)
86             {
87 0         0 return $invocant->default_localizer(shift);
88             }
89              
90 0         0 return $invocant->default_localizer;
91             }
92             }
93              
94             sub default_localizer
95             {
96 0     0 0 0 my($class) = shift;
97              
98 0 0       0 if(@_)
99             {
100 0         0 return $class->_default_localizer(@_);
101             }
102              
103 0 0       0 if(my $localizer = $class->_default_localizer)
104             {
105 0         0 return $localizer;
106             }
107              
108 0         0 return $class->_default_localizer($class->generic_object_class->localizer);
109             }
110              
111             sub locale
112             {
113 187     187 0 369 my($invocant) = shift;
114              
115             # Called as object method
116 187 50       542 if(my $class = ref $invocant)
117             {
118 187 50       505 if(@_)
119             {
120 0         0 return $invocant->{'locale'} = shift;
121             }
122              
123 187         363 my $locale = $invocant->{'locale'};
124              
125 187 50       428 unless($locale)
126             {
127 187 50       418 if(my $parent = $invocant->parent)
128             {
129 187 50       612 if(my $locale = $parent->locale)
130             {
131 187         1792 return $locale;
132             }
133             }
134 0         0 else { return $class->default_locale }
135             }
136              
137 0   0     0 return $locale || $class->default_locale;
138             }
139             else # Called as class method
140             {
141 0 0       0 if(@_)
142             {
143 0         0 return $invocant->default_locale(shift);
144             }
145              
146 0         0 return $invocant->default_locale;
147             }
148             }
149              
150             sub clone
151             {
152 1     1 0 2 my($self) = shift;
153 1         6 my $clone = Clone::PP::clone($self);
154 1         11 $clone->parent(undef);
155 1         13 return $clone;
156             }
157              
158             sub id
159             {
160 177     177 1 1624 my($self) = shift;
161              
162 177 100       470 if(@_)
163             {
164 107         1053 return $self->{'id'} = shift;
165             }
166              
167 70         153 my $id = $self->{'id'};
168              
169 70 100       301 return $id if(defined $id);
170              
171 15         42 my $msg = $self->message;
172 15 50 33     44 return CUSTOM_ERROR if($msg && $msg->is_custom);
173 0         0 return undef;
174             }
175              
176             sub is_custom
177             {
178 3     3 0 6 my($self) = shift;
179              
180 3         7 my $id = $self->id;
181              
182 3 50       9 unless(defined $id)
183             {
184 0         0 my $msg = $self->message;
185              
186 0 0 0     0 return 1 if($msg && $msg->is_custom);
187 0         0 return undef;
188             }
189              
190 3         18 return $id == CUSTOM_ERROR;
191             }
192              
193             1;
194              
195             __END__
196              
197             =head1 NAME
198              
199             Rose::HTML::Object::Error - Error object.
200              
201             =head1 SYNOPSIS
202              
203             $error = Rose::HTML::Object::Error->new(id => MY_ERROR);
204              
205             =head1 DESCRIPTION
206              
207             L<Rose::HTML::Object::Error> objects encapsulate an error with integer L<id|/id> and an optional associated L<message|/message> object.
208              
209             This class inherits from, and follows the conventions of, L<Rose::Object>. See the L<Rose::Object> documentation for more information.
210              
211             =head1 OVERLOADING
212              
213             Stringification is overloaded to the stringification of the L<message|/message> object. In numeric and boolean contexts, L<Rose::HTML::Object::Error> objects always evaluate to true.
214              
215             =head1 CONSTRUCTOR
216              
217             =over 4
218              
219             =item B<new [PARAMS]>
220              
221             Constructs a new L<Rose::HTML::Object::Error> object based on PARAMS name/value pairs. Any object method is a valid parameter name.
222              
223             =back
224              
225             =head1 OBJECT METHODS
226              
227             =over 4
228              
229             =item B<id [INT]>
230              
231             Get or set the error's integer identifier.
232              
233             =item L<message [MESSAGE]>
234              
235             Get or set the L<Rose::HTML::Object::Message>-derived message object associated with this error.
236              
237             =back
238              
239             =head1 AUTHOR
240              
241             John C. Siracusa (siracusa@gmail.com)
242              
243             =head1 LICENSE
244              
245             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.