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   326 use strict;
  43         98  
  43         1367  
4              
5 43     43   243 use Carp;
  43         108  
  43         2473  
6 43     43   273 use Clone::PP();
  43         119  
  43         575  
7 43     43   220 use Scalar::Util();
  43         96  
  43         1059  
8              
9 43     43   278 use base 'Rose::Object';
  43         120  
  43         4945  
10              
11 43     43   342 use Rose::HTML::Object::Errors qw(CUSTOM_ERROR);
  43         129  
  43         502  
12              
13             our $VERSION = '0.606';
14              
15             #our $Debug = 0;
16              
17             use overload
18             (
19 43     43   337 '""' => sub { no warnings 'uninitialized'; shift->message . '' },
  43     186   108  
  43         4012  
  186         19182  
20 1082     1082   3026 'bool' => sub { 1 },
21 0     0   0 '0+' => sub { 1 },
22 43         596 fallback => 1,
23 43     43   37872 );
  43         32220  
24              
25             use Rose::Class::MakeMethods::Generic
26             (
27 43         446 inheritable_scalar =>
28             [
29             '_default_localizer',
30             'default_locale',
31             ],
32 43     43   6260 );
  43         98  
33              
34             use Rose::HTML::Object::MakeMethods::Localization
35             (
36 43         335 localized_message =>
37             [
38             'message',
39             ],
40 43     43   11200 );
  43         122  
41              
42             __PACKAGE__->default_locale('en');
43              
44 0     0 0 0 sub generic_object_class { 'Rose::HTML::Object' }
45              
46 43     43 0 4191 sub as_string { no warnings 'uninitialized'; "$_[0]" }
  43     13   127  
  43         29377  
  13         41  
47              
48             sub parent
49             {
50 646     646 0 1652 my($self) = shift;
51 646 100       1635 return Scalar::Util::weaken($self->{'parent'} = shift) if(@_);
52 506         1356 return $self->{'parent'};
53             }
54              
55             sub localizer
56             {
57 187     187 0 370 my($invocant) = shift;
58              
59             # Called as object method
60 187 50       481 if(my $class = ref $invocant)
61             {
62 187 50       479 if(@_)
63             {
64 0         0 return $invocant->{'localizer'} = shift;
65             }
66              
67 187         340 my $localizer = $invocant->{'localizer'};
68              
69 187 50       418 unless($localizer)
70             {
71 187 50       395 if(my $parent = $invocant->parent)
72             {
73 187 50       588 if(my $localizer = $parent->localizer)
74             {
75 187         5991 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 364 my($invocant) = shift;
114              
115             # Called as object method
116 187 50       467 if(my $class = ref $invocant)
117             {
118 187 50       452 if(@_)
119             {
120 0         0 return $invocant->{'locale'} = shift;
121             }
122              
123 187         356 my $locale = $invocant->{'locale'};
124              
125 187 50       426 unless($locale)
126             {
127 187 50       382 if(my $parent = $invocant->parent)
128             {
129 187 50       601 if(my $locale = $parent->locale)
130             {
131 187         1509 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 3 my($self) = shift;
153 1         5 my $clone = Clone::PP::clone($self);
154 1         10 $clone->parent(undef);
155 1         14 return $clone;
156             }
157              
158             sub id
159             {
160 177     177 1 1589 my($self) = shift;
161              
162 177 100       432 if(@_)
163             {
164 107         953 return $self->{'id'} = shift;
165             }
166              
167 70         142 my $id = $self->{'id'};
168              
169 70 100       271 return $id if(defined $id);
170              
171 15         42 my $msg = $self->message;
172 15 50 33     45 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       11 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         14 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.