Profile of Object/Enum.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:00 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 47µs | 54µs | Object::Enum::::BEGIN@4Object::Enum::BEGIN@4
1 | 1 | 1 | 25µs | 25µs | Object::Enum::::BEGIN@5Object::Enum::BEGIN@5
1 | 1 | 1 | 23µs | 1.90ms | Object::Enum::::BEGIN@10Object::Enum::BEGIN@10
1 | 1 | 1 | 15µs | 385µs | Object::Enum::::BEGIN@32Object::Enum::BEGIN@32
1 | 1 | 1 | 12µs | 17µs | Object::Enum::::BEGIN@3Object::Enum::BEGIN@3
1 | 1 | 1 | 11µs | 24µs | Object::Enum::::BEGIN@111Object::Enum::BEGIN@111
1 | 1 | 1 | 9µs | 52µs | Object::Enum::::BEGIN@27Object::Enum::BEGIN@27
1 | 1 | 1 | 5µs | 5µs | Object::Enum::::BEGIN@202Object::Enum::BEGIN@202
1 | 1 | 1 | 3µs | 3µs | Object::Enum::::BEGIN@7Object::Enum::BEGIN@7
1 | 1 | 1 | 3µs | 3µs | Object::Enum::::BEGIN@8Object::Enum::BEGIN@8
0 | 0 | 0 | 0s | 0s | Object::Enum::::__ANON__[:123]Object::Enum::__ANON__[:123]
0 | 0 | 0 | 0s | 0s | Object::Enum::::__ANON__[:128]Object::Enum::__ANON__[:128]
0 | 0 | 0 | 0s | 0s | Object::Enum::::__ANON__[:38]Object::Enum::__ANON__[:38]
0 | 0 | 0 | 0s | 0s | Object::Enum::::_build_enumObject::Enum::_build_enum
0 | 0 | 0 | 0s | 0s | Object::Enum::::_generate_classObject::Enum::_generate_class
0 | 0 | 0 | 0s | 0s | Object::Enum::::_mk_valuesObject::Enum::_mk_values
0 | 0 | 0 | 0s | 0s | Object::Enum::::_stringifyObject::Enum::_stringify
0 | 0 | 0 | 0s | 0s | Object::Enum::::cloneObject::Enum::clone
0 | 0 | 0 | 0s | 0s | Object::Enum::::newObject::Enum::new
0 | 0 | 0 | 0s | 0s | Object::Enum::::unsetObject::Enum::unset
0 | 0 | 0 | 0s | 0s | Object::Enum::::valueObject::Enum::value
0 | 0 | 0 | 0s | 0s | Object::Enum::::valuesObject::Enum::values

Call graph for these subroutines as a Graphviz dot language file.

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 use strict; # 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 use warnings; # 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 use 5.006001; # 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 use Carp (); # 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 use Sub::Install (); # spent 3µs making 1 call to Object::Enum::BEGIN@8
9 |  |  |  |  |
10 |  |  | 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 use base qw( # spent 1.88ms making 1 call to base::import
11 |  |  |  |  | Class::Data::Inheritable
12 |  |  |  |  | Class::Accessor::Fast
13 | 3 | 51µ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 use overload (
28 |  |  | 1 | 43µs | q{""} => '_stringify', # spent 43µs making 1 call to overload::import
29 |  |  |  |  | fallback => 1,
30 | 3 | 32µs | 1 | 52µs | ); # spent 52µs making 1 call to Object::Enum::BEGIN@27
31 |  |  |  |  |
32 |  |  | 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 use Sub::Exporter -setup => { # spent 370µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
33 |  |  |  |  | exports => [ Enum => \&_build_enum ],
34 | 3 | 126µ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 no strict 'refs'; # 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 BEGIN { *spawn = \&clone } # 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