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              
2             use strict;
3 43     43   267  
  43         82  
  43         1187  
4             use Carp;
5 43     43   183 use Clone::PP();
  43         79  
  43         2215  
6 43     43   245 use Scalar::Util();
  43         80  
  43         552  
7 43     43   188  
  43         80  
  43         872  
8             use base 'Rose::Object';
9 43     43   212  
  43         76  
  43         4116  
10             use Rose::HTML::Object::Errors qw(CUSTOM_ERROR);
11 43     43   271  
  43         81  
  43         489  
12             our $VERSION = '0.606';
13              
14             #our $Debug = 0;
15              
16             use overload
17             (
18             '""' => sub { no warnings 'uninitialized'; shift->message . '' },
19 43     43   274 'bool' => sub { 1 },
  43     186   99  
  43         3718  
  186         16364  
20 1082     1082   2466 '0+' => sub { 1 },
21 0     0   0 fallback => 1,
22 43         486 );
23 43     43   30639  
  43         25921  
24             use Rose::Class::MakeMethods::Generic
25             (
26             inheritable_scalar =>
27 43         356 [
28             '_default_localizer',
29             'default_locale',
30             ],
31             );
32 43     43   4197  
  43         1140  
33             use Rose::HTML::Object::MakeMethods::Localization
34             (
35             localized_message =>
36 43         273 [
37             'message',
38             ],
39             );
40 43     43   9308  
  43         95  
41             __PACKAGE__->default_locale('en');
42              
43              
44 0     0 0 0  
45             {
46 43     43 0 3635 my($self) = shift;
  43     13   102  
  43         24817  
  13         36  
47             return Scalar::Util::weaken($self->{'parent'} = shift) if(@_);
48             return $self->{'parent'};
49             }
50 646     646 0 1311  
51 646 100       1450 {
52 506         1084 my($invocant) = shift;
53              
54             # Called as object method
55             if(my $class = ref $invocant)
56             {
57 187     187 0 287 if(@_)
58             {
59             return $invocant->{'localizer'} = shift;
60 187 50       399 }
61              
62 187 50       367 my $localizer = $invocant->{'localizer'};
63              
64 0         0 unless($localizer)
65             {
66             if(my $parent = $invocant->parent)
67 187         294 {
68             if(my $localizer = $parent->localizer)
69 187 50       357 {
70             return $localizer;
71 187 50       354 }
72             }
73 187 50       468 else { return $class->default_localizer }
74             }
75 187         8341  
76             return $localizer || $class->default_localizer;
77             }
78 0         0 else # Called as class method
79             {
80             if(@_)
81 0   0     0 {
82             return $invocant->default_localizer(shift);
83             }
84              
85 0 0       0 return $invocant->default_localizer;
86             }
87 0         0 }
88              
89             {
90 0         0 my($class) = shift;
91              
92             if(@_)
93             {
94             return $class->_default_localizer(@_);
95             }
96 0     0 0 0  
97             if(my $localizer = $class->_default_localizer)
98 0 0       0 {
99             return $localizer;
100 0         0 }
101              
102             return $class->_default_localizer($class->generic_object_class->localizer);
103 0 0       0 }
104              
105 0         0 {
106             my($invocant) = shift;
107              
108 0         0 # Called as object method
109             if(my $class = ref $invocant)
110             {
111             if(@_)
112             {
113 187     187 0 295 return $invocant->{'locale'} = shift;
114             }
115              
116 187 50       384 my $locale = $invocant->{'locale'};
117              
118 187 50       395 unless($locale)
119             {
120 0         0 if(my $parent = $invocant->parent)
121             {
122             if(my $locale = $parent->locale)
123 187         302 {
124             return $locale;
125 187 50       341 }
126             }
127 187 50       328 else { return $class->default_locale }
128             }
129 187 50       508  
130             return $locale || $class->default_locale;
131 187         1238 }
132             else # Called as class method
133             {
134 0         0 if(@_)
135             {
136             return $invocant->default_locale(shift);
137 0   0     0 }
138              
139             return $invocant->default_locale;
140             }
141 0 0       0 }
142              
143 0         0 {
144             my($self) = shift;
145             my $clone = Clone::PP::clone($self);
146 0         0 $clone->parent(undef);
147             return $clone;
148             }
149              
150             {
151             my($self) = shift;
152 1     1 0 3  
153 1         5 if(@_)
154 1         8 {
155 1         12 return $self->{'id'} = shift;
156             }
157              
158             my $id = $self->{'id'};
159              
160 177     177 1 1296 return $id if(defined $id);
161              
162 177 100       404 my $msg = $self->message;
163             return CUSTOM_ERROR if($msg && $msg->is_custom);
164 107         799 return undef;
165             }
166              
167 70         135 {
168             my($self) = shift;
169 70 100       240  
170             my $id = $self->id;
171 15         38  
172 15 50 33     39 unless(defined $id)
173 0         0 {
174             my $msg = $self->message;
175              
176             return 1 if($msg && $msg->is_custom);
177             return undef;
178 3     3 0 6 }
179              
180 3         7 return $id == CUSTOM_ERROR;
181             }
182 3 50       8  
183             1;
184 0         0  
185              
186 0 0 0     0 =head1 NAME
187 0         0  
188             Rose::HTML::Object::Error - Error object.
189              
190 3         14 =head1 SYNOPSIS
191              
192             $error = Rose::HTML::Object::Error->new(id => MY_ERROR);
193              
194             =head1 DESCRIPTION
195              
196             L<Rose::HTML::Object::Error> objects encapsulate an error with integer L<id|/id> and an optional associated L<message|/message> object.
197              
198             This class inherits from, and follows the conventions of, L<Rose::Object>. See the L<Rose::Object> documentation for more information.
199              
200             =head1 OVERLOADING
201              
202             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.
203              
204             =head1 CONSTRUCTOR
205              
206             =over 4
207              
208             =item B<new [PARAMS]>
209              
210             Constructs a new L<Rose::HTML::Object::Error> object based on PARAMS name/value pairs. Any object method is a valid parameter name.
211              
212             =back
213              
214             =head1 OBJECT METHODS
215              
216             =over 4
217              
218             =item B<id [INT]>
219              
220             Get or set the error's integer identifier.
221              
222             =item L<message [MESSAGE]>
223              
224             Get or set the L<Rose::HTML::Object::Message>-derived message object associated with this error.
225              
226             =back
227              
228             =head1 AUTHOR
229              
230             John C. Siracusa (siracusa@gmail.com)
231              
232             =head1 LICENSE
233              
234             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.