Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Object/Enum.pm |
Statements | Executed 35 statements in 874µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 47µs | 54µs | BEGIN@4 | Object::Enum::
1 | 1 | 1 | 25µs | 25µs | BEGIN@5 | Object::Enum::
1 | 1 | 1 | 23µs | 1.90ms | BEGIN@10 | Object::Enum::
1 | 1 | 1 | 15µs | 385µs | BEGIN@32 | Object::Enum::
1 | 1 | 1 | 12µs | 17µs | BEGIN@3 | Object::Enum::
1 | 1 | 1 | 11µs | 24µs | BEGIN@111 | Object::Enum::
1 | 1 | 1 | 9µs | 52µs | BEGIN@27 | Object::Enum::
1 | 1 | 1 | 5µs | 5µs | BEGIN@202 | Object::Enum::
1 | 1 | 1 | 3µs | 3µs | BEGIN@7 | Object::Enum::
1 | 1 | 1 | 3µs | 3µs | BEGIN@8 | Object::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:123] | Object::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:128] | Object::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:38] | Object::Enum::
0 | 0 | 0 | 0s | 0s | _build_enum | Object::Enum::
0 | 0 | 0 | 0s | 0s | _generate_class | Object::Enum::
0 | 0 | 0 | 0s | 0s | _mk_values | Object::Enum::
0 | 0 | 0 | 0s | 0s | _stringify | Object::Enum::
0 | 0 | 0 | 0s | 0s | clone | Object::Enum::
0 | 0 | 0 | 0s | 0s | new | Object::Enum::
0 | 0 | 0 | 0s | 0s | unset | Object::Enum::
0 | 0 | 0 | 0s | 0s | value | Object::Enum::
0 | 0 | 0 | 0s | 0s | values | Object::Enum::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Object::Enum; | ||||
2 | |||||
3 | 3 | 17µs | 2 | 23µs | # spent 17µs (12+5) within Object::Enum::BEGIN@3 which was called:
# once (12µs+5µs) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 3 # spent 17µs making 1 call to Object::Enum::BEGIN@3
# spent 6µs making 1 call to strict::import |
4 | 3 | 19µs | 2 | 62µs | # spent 54µs (47+8) within Object::Enum::BEGIN@4 which was called:
# once (47µs+8µs) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 4 # spent 54µs making 1 call to Object::Enum::BEGIN@4
# spent 8µs making 1 call to warnings::import |
5 | 3 | 37µs | 1 | 25µs | # spent 25µs within Object::Enum::BEGIN@5 which was called:
# once (25µs+0s) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 5 # spent 25µs making 1 call to Object::Enum::BEGIN@5 |
6 | |||||
7 | 3 | 15µs | 1 | 3µs | # spent 3µs within Object::Enum::BEGIN@7 which was called:
# once (3µs+0s) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 7 # spent 3µs making 1 call to Object::Enum::BEGIN@7 |
8 | 3 | 20µs | 1 | 3µs | # spent 3µs within Object::Enum::BEGIN@8 which was called:
# once (3µs+0s) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 8 # spent 3µs making 1 call to Object::Enum::BEGIN@8 |
9 | |||||
10 | 1 | 6µs | 1 | 1.88ms | # spent 1.90ms (23µs+1.88) within Object::Enum::BEGIN@10 which was called:
# once (23µs+1.88ms) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 13 # spent 1.88ms making 1 call to base::import |
11 | Class::Data::Inheritable | ||||
12 | Class::Accessor::Fast | ||||
13 | 2 | 45µs | 1 | 1.90ms | ); # spent 1.90ms making 1 call to Object::Enum::BEGIN@10 |
14 | |||||
15 | 1 | 10µs | 3 | 31µs | __PACKAGE__->mk_classdata($_) for ( # spent 31µs making 3 calls to Class::Data::Inheritable::mk_classdata, avg 10µs/call |
16 | '_values', | ||||
17 | '_unset', | ||||
18 | '_default', | ||||
19 | 1 | 100ns | ); | ||
20 | |||||
21 | 1 | 6µs | 1 | 65µs | __PACKAGE__->mk_accessors( # spent 65µs making 1 call to Class::Accessor::mk_accessors |
22 | 'value', | ||||
23 | ); | ||||
24 | |||||
25 | 1 | 2µs | 1 | 4µs | __PACKAGE__->_unset(1); # spent 4µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23] |
26 | |||||
27 | # spent 52µs (9+43) within Object::Enum::BEGIN@27 which was called:
# once (9µs+43µs) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 30 | ||||
28 | 1 | 7µs | 1 | 43µs | q{""} => '_stringify', # spent 43µs making 1 call to overload::import |
29 | fallback => 1, | ||||
30 | 2 | 25µs | 1 | 52µs | ); # spent 52µs making 1 call to Object::Enum::BEGIN@27 |
31 | |||||
32 | 1 | 13µs | 1 | 370µs | # spent 385µs (15+370) within Object::Enum::BEGIN@32 which was called:
# once (15µs+370µs) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 34 # spent 370µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756] |
33 | exports => [ Enum => \&_build_enum ], | ||||
34 | 2 | 112µs | 1 | 385µs | }; # spent 385µs making 1 call to Object::Enum::BEGIN@32 |
35 | |||||
36 | sub _build_enum { | ||||
37 | my ($class, undef, $arg) = @_; | ||||
38 | return sub { $class->new({ %$arg, %{shift || {} } }) }; | ||||
39 | } | ||||
40 | |||||
41 | =head1 NAME | ||||
42 | |||||
43 | Object::Enum - replacement for C<< if ($foo eq 'bar') >> | ||||
44 | |||||
45 | =head1 VERSION | ||||
46 | |||||
47 | Version 0.072 | ||||
48 | |||||
49 | =cut | ||||
50 | |||||
51 | 1 | 400ns | our $VERSION = '0.072'; | ||
52 | |||||
53 | =head1 SYNOPSIS | ||||
54 | |||||
55 | use Object::Enum qw(Enum); | ||||
56 | |||||
57 | my $color = Enum([ qw(red yellow green) ]); | ||||
58 | # ... later | ||||
59 | if ($color->is_red) { | ||||
60 | # it can't be yellow or green | ||||
61 | |||||
62 | =head1 EXPORTS | ||||
63 | |||||
64 | See L<Sub::Exporter> for ways to customize this module's | ||||
65 | exports. | ||||
66 | |||||
67 | =head2 Enum | ||||
68 | |||||
69 | An optional shortcut for C<< Object::Enum->new >>. | ||||
70 | |||||
71 | =head1 CLASS METHODS | ||||
72 | |||||
73 | =head2 new | ||||
74 | |||||
75 | my $obj = Object::Enum->new(\@values); | ||||
76 | # or | ||||
77 | $obj = Object::Enum->new(\%arg); | ||||
78 | |||||
79 | Return a new Object::Enum, with one or more sets of possible | ||||
80 | values. | ||||
81 | |||||
82 | The simplest case is to pass an arrayref, which returns an | ||||
83 | object capable of having any one of the given values or of | ||||
84 | being unset. | ||||
85 | |||||
86 | The more complex cases involve passing a hashref, which may | ||||
87 | have the following keys: | ||||
88 | |||||
89 | =over | ||||
90 | |||||
91 | =item * unset | ||||
92 | |||||
93 | whether this object can be 'unset' (defaults to true) | ||||
94 | |||||
95 | =item * default | ||||
96 | |||||
97 | this object's default value is (defaults to undef) | ||||
98 | |||||
99 | =item * values | ||||
100 | |||||
101 | an arrayref, listing the object's possible values (at least | ||||
102 | one required) | ||||
103 | |||||
104 | =back | ||||
105 | |||||
106 | =cut | ||||
107 | |||||
108 | 1 | 200ns | my $id = 0; | ||
109 | sub _generate_class { | ||||
110 | my $class = shift; | ||||
111 | 3 | 366µs | 2 | 38µs | # spent 24µs (11+13) within Object::Enum::BEGIN@111 which was called:
# once (11µs+13µs) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 111 # spent 24µs making 1 call to Object::Enum::BEGIN@111
# spent 13µs making 1 call to strict::unimport |
112 | my $gen = sprintf "%s::obj_%08d", $class, ++$id; | ||||
113 | push @{$gen."::ISA"}, $class; | ||||
114 | return $gen; | ||||
115 | } | ||||
116 | |||||
117 | sub _mk_values { | ||||
118 | my $class = shift; | ||||
119 | for my $value (keys %{ $class->_values }) { | ||||
120 | Sub::Install::install_sub({ | ||||
121 | into => $class, | ||||
122 | as => "set_$value", | ||||
123 | code => sub { $_[0]->value($value); return $_[0] }, | ||||
124 | }); | ||||
125 | Sub::Install::install_sub({ | ||||
126 | into => $class, | ||||
127 | as => "is_$value", | ||||
128 | code => sub { (shift->value || '') eq $value }, | ||||
129 | }); | ||||
130 | } | ||||
131 | } | ||||
132 | |||||
133 | sub new { | ||||
134 | my ($class, $arg) = @_; | ||||
135 | $arg ||= []; | ||||
136 | if (ref $arg eq 'ARRAY') { | ||||
137 | $arg = { values => $arg }; | ||||
138 | } | ||||
139 | |||||
140 | unless (@{$arg->{values} || []}) { | ||||
141 | Carp::croak("at least one possible value must be provided"); | ||||
142 | } | ||||
143 | |||||
144 | exists $arg->{unset} or $arg->{unset} = 1; | ||||
145 | exists $arg->{default} or $arg->{default} = undef; | ||||
146 | |||||
147 | if (!$arg->{unset} && !defined $arg->{default}) { | ||||
148 | Carp::croak("must supply a defined default for 'unset' to be false"); | ||||
149 | } | ||||
150 | |||||
151 | if (defined($arg->{default}) && ! grep { | ||||
152 | $_ eq $arg->{default} | ||||
153 | } @{$arg->{values}}) { | ||||
154 | Carp::croak("default value must be listed in 'values' or undef"); | ||||
155 | } | ||||
156 | |||||
157 | my $gen = $class->_generate_class; | ||||
158 | $gen->_unset($arg->{unset}); | ||||
159 | $gen->_default($arg->{default}); | ||||
160 | $gen->_values({ map { $_ => 1 } @{$arg->{values}} }); | ||||
161 | $gen->_mk_values; | ||||
162 | |||||
163 | return $gen->spawn; | ||||
164 | } | ||||
165 | |||||
166 | sub _stringify { | ||||
167 | my $self = shift; | ||||
168 | return '(undef)' unless defined $self->value; | ||||
169 | return $self->value; | ||||
170 | } | ||||
171 | |||||
172 | =head1 OBJECT METHODS | ||||
173 | |||||
174 | =head2 spawn | ||||
175 | |||||
176 | =head2 clone | ||||
177 | |||||
178 | my $new = $obj->clone; | ||||
179 | |||||
180 | my $new = $obj->clone($value); | ||||
181 | |||||
182 | Create a new Enum from an existing object, using the same arguments as were | ||||
183 | originally passed to C<< new >> when that object was created. | ||||
184 | |||||
185 | An optional value may be passed in; this is identical to (but more convenient | ||||
186 | than) calling C<value> with the same argument on the newly cloned object. | ||||
187 | |||||
188 | This method was formerly named C<spawn>. That name will still work but is | ||||
189 | deprecated. | ||||
190 | |||||
191 | =cut | ||||
192 | |||||
193 | sub clone { | ||||
194 | my $class = shift; | ||||
195 | my $self = bless { | ||||
196 | value => $class->_default, | ||||
197 | } => ref($class) || $class; | ||||
198 | $self->value(@_) if @_; | ||||
199 | return $self; | ||||
200 | } | ||||
201 | |||||
202 | 1 | 167µs | 1 | 5µs | # spent 5µs within Object::Enum::BEGIN@202 which was called:
# once (5µs+0s) by DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 at line 202 # spent 5µs making 1 call to Object::Enum::BEGIN@202 |
203 | |||||
204 | =head2 value | ||||
205 | |||||
206 | The current value as a string (or undef) | ||||
207 | |||||
208 | Note: don't pass in undef; use the L<unset|/unset> method instead. | ||||
209 | |||||
210 | =cut | ||||
211 | |||||
212 | sub value { | ||||
213 | my $self = shift; | ||||
214 | if (@_) { | ||||
215 | my $val = shift; | ||||
216 | Carp::croak("object $self cannot be set to undef") unless defined $val; | ||||
217 | unless ($self->_values->{$val}) { | ||||
218 | Carp::croak("object $self cannot be set to '$val'"); | ||||
219 | } | ||||
220 | return $self->_value_accessor($val); | ||||
221 | } | ||||
222 | return $self->_value_accessor; | ||||
223 | } | ||||
224 | |||||
225 | =head2 values | ||||
226 | |||||
227 | The possible values for this object | ||||
228 | |||||
229 | =cut | ||||
230 | |||||
231 | sub values { | ||||
232 | my $self = shift; | ||||
233 | return keys %{ $self->_values }; | ||||
234 | } | ||||
235 | |||||
236 | =head2 unset | ||||
237 | |||||
238 | Unset the object's value (set to undef) | ||||
239 | |||||
240 | =cut | ||||
241 | |||||
242 | sub unset { | ||||
243 | my $self = shift; | ||||
244 | unless ($self->_unset) { | ||||
245 | Carp::croak("object $self cannot be unset"); | ||||
246 | } | ||||
247 | $self->_value_accessor(undef); | ||||
248 | } | ||||
249 | |||||
250 | =head2 is_* | ||||
251 | |||||
252 | =head2 set_* | ||||
253 | |||||
254 | Automatically generated from the values passed into C<< new | ||||
255 | >>. | ||||
256 | |||||
257 | None of these methods take any arguments. | ||||
258 | |||||
259 | The C<< set_* >> methods are chainable; that is, they return | ||||
260 | the object on which they were called. This lets you do useful things like: | ||||
261 | |||||
262 | use Object::Enum Enum => { -as => 'color', values => [qw(red blue)] }; | ||||
263 | |||||
264 | print color->set_red->value; # prints 'red' | ||||
265 | |||||
266 | =cut | ||||
267 | |||||
268 | =head1 AUTHOR | ||||
269 | |||||
270 | Hans Dieter Pearcey, C<< <hdp at cpan.org> >> | ||||
271 | |||||
272 | =head1 BUGS | ||||
273 | |||||
274 | Please report any bugs or feature requests to | ||||
275 | C<bug-object-enum at rt.cpan.org>, or through the web interface at | ||||
276 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Object-Enum>. | ||||
277 | I will be notified, and then you'll automatically be notified of progress on | ||||
278 | your bug as I make changes. | ||||
279 | |||||
280 | =head1 SUPPORT | ||||
281 | |||||
282 | You can find documentation for this module with the perldoc command. | ||||
283 | |||||
284 | perldoc Object::Enum | ||||
285 | |||||
286 | You can also look for information at: | ||||
287 | |||||
288 | =over 4 | ||||
289 | |||||
290 | =item * AnnoCPAN: Annotated CPAN documentation | ||||
291 | |||||
292 | L<http://annocpan.org/dist/Object-Enum> | ||||
293 | |||||
294 | =item * CPAN Ratings | ||||
295 | |||||
296 | L<http://cpanratings.perl.org/d/Object-Enum> | ||||
297 | |||||
298 | =item * RT: CPAN's request tracker | ||||
299 | |||||
300 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Object-Enum> | ||||
301 | |||||
302 | =item * Search CPAN | ||||
303 | |||||
304 | L<http://search.cpan.org/dist/Object-Enum> | ||||
305 | |||||
306 | =back | ||||
307 | |||||
308 | =head1 ACKNOWLEDGEMENTS | ||||
309 | |||||
310 | =head1 COPYRIGHT & LICENSE | ||||
311 | |||||
312 | Copyright 2006 Hans Dieter Pearcey, all rights reserved. | ||||
313 | |||||
314 | This program is free software; you can redistribute it and/or modify it | ||||
315 | under the same terms as Perl itself. | ||||
316 | |||||
317 | =cut | ||||
318 | |||||
319 | 1 | 6µs | 1; # End of Object::Enum |