← 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:46 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Object/Enum.pm
StatementsExecuted 35 statements in 874µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11147µs54µsObject::Enum::::BEGIN@4Object::Enum::BEGIN@4
11125µs25µsObject::Enum::::BEGIN@5Object::Enum::BEGIN@5
11123µs1.90msObject::Enum::::BEGIN@10Object::Enum::BEGIN@10
11115µs385µsObject::Enum::::BEGIN@32Object::Enum::BEGIN@32
11112µs17µsObject::Enum::::BEGIN@3Object::Enum::BEGIN@3
11111µs24µsObject::Enum::::BEGIN@111Object::Enum::BEGIN@111
1119µs52µsObject::Enum::::BEGIN@27Object::Enum::BEGIN@27
1115µs5µsObject::Enum::::BEGIN@202Object::Enum::BEGIN@202
1113µs3µsObject::Enum::::BEGIN@7Object::Enum::BEGIN@7
1113µs3µsObject::Enum::::BEGIN@8Object::Enum::BEGIN@8
0000s0sObject::Enum::::__ANON__[:123]Object::Enum::__ANON__[:123]
0000s0sObject::Enum::::__ANON__[:128]Object::Enum::__ANON__[:128]
0000s0sObject::Enum::::__ANON__[:38]Object::Enum::__ANON__[:38]
0000s0sObject::Enum::::_build_enumObject::Enum::_build_enum
0000s0sObject::Enum::::_generate_classObject::Enum::_generate_class
0000s0sObject::Enum::::_mk_valuesObject::Enum::_mk_values
0000s0sObject::Enum::::_stringifyObject::Enum::_stringify
0000s0sObject::Enum::::cloneObject::Enum::clone
0000s0sObject::Enum::::newObject::Enum::new
0000s0sObject::Enum::::unsetObject::Enum::unset
0000s0sObject::Enum::::valueObject::Enum::value
0000s0sObject::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
1package Object::Enum;
2
3317µs223µ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
4319µs262µ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
5337µs125µ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
7315µs13µ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
8320µs13µ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
1016µs11.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
13245µs11.90ms );
# spent 1.90ms making 1 call to Object::Enum::BEGIN@10
14
15110µs331µ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',
191100ns);
20
2116µs165µs__PACKAGE__->mk_accessors(
# spent 65µs making 1 call to Class::Accessor::mk_accessors
22 'value',
23);
24
2512µs14µs__PACKAGE__->_unset(1);
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 (
2817µs143µs q{""} => '_stringify',
# spent 43µs making 1 call to overload::import
29 fallback => 1,
30225µs152µs);
# spent 52µs making 1 call to Object::Enum::BEGIN@27
31
32113µs1370µ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 ],
342112µs1385µs};
# spent 385µs making 1 call to Object::Enum::BEGIN@32
35
36sub _build_enum {
37 my ($class, undef, $arg) = @_;
38 return sub { $class->new({ %$arg, %{shift || {} } }) };
39}
40
41=head1 NAME
42
43Object::Enum - replacement for C<< if ($foo eq 'bar') >>
44
45=head1 VERSION
46
47Version 0.072
48
49=cut
50
511400nsour $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
64See L<Sub::Exporter> for ways to customize this module's
65exports.
66
67=head2 Enum
68
69An 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
79Return a new Object::Enum, with one or more sets of possible
80values.
81
82The simplest case is to pass an arrayref, which returns an
83object capable of having any one of the given values or of
84being unset.
85
86The more complex cases involve passing a hashref, which may
87have the following keys:
88
89=over
90
91=item * unset
92
93whether this object can be 'unset' (defaults to true)
94
95=item * default
96
97this object's default value is (defaults to undef)
98
99=item * values
100
101an arrayref, listing the object's possible values (at least
102one required)
103
104=back
105
106=cut
107
1081200nsmy $id = 0;
109sub _generate_class {
110 my $class = shift;
1113366µs238µ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
117sub _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
133sub 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
166sub _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
182Create a new Enum from an existing object, using the same arguments as were
183originally passed to C<< new >> when that object was created.
184
185An optional value may be passed in; this is identical to (but more convenient
186than) calling C<value> with the same argument on the newly cloned object.
187
188This method was formerly named C<spawn>. That name will still work but is
189deprecated.
190
191=cut
192
193sub 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
2021167µs15µ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
206The current value as a string (or undef)
207
208Note: don't pass in undef; use the L<unset|/unset> method instead.
209
210=cut
211
212sub 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
227The possible values for this object
228
229=cut
230
231sub values {
232 my $self = shift;
233 return keys %{ $self->_values };
234}
235
236=head2 unset
237
238Unset the object's value (set to undef)
239
240=cut
241
242sub 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
254Automatically generated from the values passed into C<< new
255>>.
256
257None of these methods take any arguments.
258
259The C<< set_* >> methods are chainable; that is, they return
260the 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
270Hans Dieter Pearcey, C<< <hdp at cpan.org> >>
271
272=head1 BUGS
273
274Please report any bugs or feature requests to
275C<bug-object-enum at rt.cpan.org>, or through the web interface at
276L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Object-Enum>.
277I will be notified, and then you'll automatically be notified of progress on
278your bug as I make changes.
279
280=head1 SUPPORT
281
282You can find documentation for this module with the perldoc command.
283
284 perldoc Object::Enum
285
286You can also look for information at:
287
288=over 4
289
290=item * AnnoCPAN: Annotated CPAN documentation
291
292L<http://annocpan.org/dist/Object-Enum>
293
294=item * CPAN Ratings
295
296L<http://cpanratings.perl.org/d/Object-Enum>
297
298=item * RT: CPAN's request tracker
299
300L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Object-Enum>
301
302=item * Search CPAN
303
304L<http://search.cpan.org/dist/Object-Enum>
305
306=back
307
308=head1 ACKNOWLEDGEMENTS
309
310=head1 COPYRIGHT & LICENSE
311
312Copyright 2006 Hans Dieter Pearcey, all rights reserved.
313
314This program is free software; you can redistribute it and/or modify it
315under the same terms as Perl itself.
316
317=cut
318
31916µs1; # End of Object::Enum