| 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 | Object::Enum::BEGIN@4 |
| 1 | 1 | 1 | 25µs | 25µs | Object::Enum::BEGIN@5 |
| 1 | 1 | 1 | 23µs | 1.90ms | Object::Enum::BEGIN@10 |
| 1 | 1 | 1 | 15µs | 385µs | Object::Enum::BEGIN@32 |
| 1 | 1 | 1 | 12µs | 17µs | Object::Enum::BEGIN@3 |
| 1 | 1 | 1 | 11µs | 24µs | Object::Enum::BEGIN@111 |
| 1 | 1 | 1 | 9µs | 52µs | Object::Enum::BEGIN@27 |
| 1 | 1 | 1 | 5µs | 5µs | Object::Enum::BEGIN@202 |
| 1 | 1 | 1 | 3µs | 3µs | Object::Enum::BEGIN@7 |
| 1 | 1 | 1 | 3µs | 3µs | Object::Enum::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::__ANON__[:123] |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::__ANON__[:128] |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::__ANON__[:38] |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::_build_enum |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::_generate_class |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::_mk_values |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::_stringify |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::clone |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::new |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::unset |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::value |
| 0 | 0 | 0 | 0s | 0s | Object::Enum::values |
| 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 |