| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/InflateColumn/Object/Enum.pm |
| Statements | Executed 100 statements in 568µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 883µs | 3.58ms | DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 |
| 20 | 2 | 2 | 173µs | 3.02ms | DBIx::Class::InflateColumn::Object::Enum::register_column |
| 1 | 1 | 1 | 15µs | 33µs | DBIx::Class::InflateColumn::Object::Enum::BEGIN@3 |
| 1 | 1 | 1 | 10µs | 13µs | DBIx::Class::InflateColumn::Object::Enum::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 39µs | DBIx::Class::InflateColumn::Object::Enum::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::InflateColumn::Object::Enum::__ANON__[:109] |
| 0 | 0 | 0 | 0s | 0s | DBIx::Class::InflateColumn::Object::Enum::__ANON__[:112] |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package DBIx::Class::InflateColumn::Object::Enum; | ||||
| 2 | |||||
| 3 | 3 | 21µs | 2 | 50µs | # spent 33µs (15+18) within DBIx::Class::InflateColumn::Object::Enum::BEGIN@3 which was called:
# once (15µs+18µs) by Class::C3::Componentised::ensure_class_loaded at line 3 # spent 33µs making 1 call to DBIx::Class::InflateColumn::Object::Enum::BEGIN@3
# spent 18µs making 1 call to warnings::import |
| 4 | 3 | 22µs | 2 | 17µs | # spent 13µs (10+3) within DBIx::Class::InflateColumn::Object::Enum::BEGIN@4 which was called:
# once (10µs+3µs) by Class::C3::Componentised::ensure_class_loaded at line 4 # spent 13µs making 1 call to DBIx::Class::InflateColumn::Object::Enum::BEGIN@4
# spent 3µs making 1 call to strict::import |
| 5 | 3 | 20µs | 2 | 70µs | # spent 39µs (8+31) within DBIx::Class::InflateColumn::Object::Enum::BEGIN@5 which was called:
# once (8µs+31µs) by Class::C3::Componentised::ensure_class_loaded at line 5 # spent 39µs making 1 call to DBIx::Class::InflateColumn::Object::Enum::BEGIN@5
# spent 31µs making 1 call to Exporter::import |
| 6 | 3 | 369µs | 2 | 3.71ms | # spent 3.58ms (883µs+2.70) within DBIx::Class::InflateColumn::Object::Enum::BEGIN@6 which was called:
# once (883µs+2.70ms) by Class::C3::Componentised::ensure_class_loaded at line 6 # spent 3.58ms making 1 call to DBIx::Class::InflateColumn::Object::Enum::BEGIN@6
# spent 126µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756] |
| 7 | |||||
| 8 | =head1 NAME | ||||
| 9 | |||||
| 10 | DBIx::Class::InflateColumn::Object::Enum - Allows a DBIx::Class user to define a Object::Enum column | ||||
| 11 | |||||
| 12 | =head1 VERSION | ||||
| 13 | |||||
| 14 | Version 0.03 | ||||
| 15 | |||||
| 16 | =cut | ||||
| 17 | |||||
| 18 | 1 | 600ns | our $VERSION = '0.04'; | ||
| 19 | |||||
| 20 | |||||
| 21 | =head1 SYNOPSIS | ||||
| 22 | |||||
| 23 | Load this module via load_components and utilize is_enum and values property | ||||
| 24 | to define Enumuration columns via Object::Enum | ||||
| 25 | |||||
| 26 | package TableClass; | ||||
| 27 | |||||
| 28 | use strict; | ||||
| 29 | use warnings; | ||||
| 30 | use base 'DBIx::Class'; | ||||
| 31 | |||||
| 32 | __PACKAGE__->load_components(qw/InflateColumn::Object::Enum Core/); | ||||
| 33 | __PACKAGE__->table('testtable'); | ||||
| 34 | __PACKAGE__->add_columns( | ||||
| 35 | color => { | ||||
| 36 | data_type => 'varchar', | ||||
| 37 | is_enum => 1, | ||||
| 38 | extra => { | ||||
| 39 | list => [qw/red green blue/] | ||||
| 40 | } | ||||
| 41 | } | ||||
| 42 | color_native => { # works inline with native enum type | ||||
| 43 | data_type => 'enum', | ||||
| 44 | is_enum => 1, | ||||
| 45 | extra => { | ||||
| 46 | list => [qw/red green blue/] | ||||
| 47 | } | ||||
| 48 | } | ||||
| 49 | ); | ||||
| 50 | |||||
| 51 | 1; | ||||
| 52 | |||||
| 53 | Now you may treat the column as an L<Object::Enum> object. | ||||
| 54 | |||||
| 55 | my $table_rs = $db->resultset('TableClass')->create({ | ||||
| 56 | color => undef | ||||
| 57 | }); | ||||
| 58 | |||||
| 59 | $table_rs->color->set_red; # sets color to red | ||||
| 60 | $table_rs->color->is_red; # would return true | ||||
| 61 | $table_rs->color->is_green; # would return false | ||||
| 62 | print $table_rs->color->value; # would print 'red' | ||||
| 63 | $table_rs->color->unset; # set the value to 'undef' or 'null' | ||||
| 64 | $table_rs->color->is_red; # returns false now | ||||
| 65 | |||||
| 66 | |||||
| 67 | =head1 METHODS | ||||
| 68 | |||||
| 69 | =head2 register_column | ||||
| 70 | |||||
| 71 | Internal chained method with L<DBIx::Class::Row/register_column>. | ||||
| 72 | Users do not call this directly! | ||||
| 73 | |||||
| 74 | =cut | ||||
| 75 | |||||
| 76 | # spent 3.02ms (173µs+2.85) within DBIx::Class::InflateColumn::Object::Enum::register_column which was called 20 times, avg 151µs/call:
# 15 times (141µs+2.37ms) by DBIx::Class::ResultSourceProxy::add_columns at line 34 of DBIx/Class/ResultSourceProxy.pm, avg 167µs/call
# 5 times (32µs+480µs) by DBIx::Class::InflateColumn::DateTime::register_column at line 28 of mro.pm, avg 102µs/call | ||||
| 77 | 20 | 10µs | my $self = shift; | ||
| 78 | 20 | 12µs | my ($column, $info) = @_; | ||
| 79 | |||||
| 80 | 20 | 32µs | 20 | 180µs | $self->next::method(@_); # spent 180µs making 20 calls to next::method, avg 9µs/call |
| 81 | |||||
| 82 | 20 | 44µs | return unless defined $info->{is_enum} and $info->{is_enum}; | ||
| 83 | |||||
| 84 | 1 | 2µs | croak("Object::Enum '$column' missing 'extra => { list => [] }' column configuration") | ||
| 85 | unless ( | ||||
| 86 | defined $info->{extra} | ||||
| 87 | and ref $info->{extra} eq 'HASH' | ||||
| 88 | and defined $info->{extra}->{list} | ||||
| 89 | ); | ||||
| 90 | |||||
| 91 | 1 | 1µs | croak("Object::Enum '$column' value list (extra => { list => [] }) must be an ARRAY reference") | ||
| 92 | unless ref $info->{extra}->{list} eq 'ARRAY'; | ||||
| 93 | |||||
| 94 | 1 | 800ns | my $values = $info->{extra}->{list}; | ||
| 95 | 1 | 7µs | my %values = map {$_=>1} @{$values}; | ||
| 96 | |||||
| 97 | 1 | 1µs | if ( defined($info->{default_value}) && !exists $values{$info->{default_value}}) { | ||
| 98 | push(@{$values},$info->{default_value}); | ||||
| 99 | $values->{$info->{default_value}} = 1; | ||||
| 100 | } | ||||
| 101 | |||||
| 102 | $self->inflate_column( | ||||
| 103 | $column => { | ||||
| 104 | inflate => sub { | ||||
| 105 | my $val = shift; | ||||
| 106 | my $e = Object::Enum->new({values=>$values}); | ||||
| 107 | $e->value($val) if $val and exists $values{$val}; | ||||
| 108 | return $e; | ||||
| 109 | }, | ||||
| 110 | deflate => sub { | ||||
| 111 | return shift->value | ||||
| 112 | } | ||||
| 113 | } | ||||
| 114 | 1 | 23µs | 1 | 279µs | ); # spent 279µs making 1 call to DBIx::Class::InflateColumn::inflate_column |
| 115 | |||||
| 116 | } | ||||
| 117 | |||||
| 118 | =head1 AUTHOR | ||||
| 119 | |||||
| 120 | Jason M. Mills, C<< <jmmills at cpan.org> >> | ||||
| 121 | |||||
| 122 | =head1 BUGS | ||||
| 123 | |||||
| 124 | Please report any bugs or feature requests to C<bug-dbix-class-inflatecolumn-object-enum at rt.cpan.org>, or through | ||||
| 125 | the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-InflateColumn-Object-Enum>. I will be notified, and then you'll | ||||
| 126 | automatically be notified of progress on your bug as I make changes. | ||||
| 127 | |||||
| - - | |||||
| 131 | =head1 SUPPORT | ||||
| 132 | |||||
| 133 | You can find documentation for this module with the perldoc command. | ||||
| 134 | |||||
| 135 | perldoc DBIx::Class::InflateColumn::Object::Enum | ||||
| 136 | |||||
| 137 | |||||
| 138 | You can also look for information at: | ||||
| 139 | |||||
| 140 | =over 4 | ||||
| 141 | |||||
| 142 | =item * RT: CPAN's request tracker | ||||
| 143 | |||||
| 144 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-InflateColumn-Object-Enum> | ||||
| 145 | |||||
| 146 | =item * AnnoCPAN: Annotated CPAN documentation | ||||
| 147 | |||||
| 148 | L<http://annocpan.org/dist/DBIx-Class-InflateColumn-Object-Enum> | ||||
| 149 | |||||
| 150 | =item * CPAN Ratings | ||||
| 151 | |||||
| 152 | L<http://cpanratings.perl.org/d/DBIx-Class-InflateColumn-Object-Enum> | ||||
| 153 | |||||
| 154 | =item * Search CPAN | ||||
| 155 | |||||
| 156 | L<http://search.cpan.org/dist/DBIx-Class-InflateColumn-Object-Enum> | ||||
| 157 | |||||
| 158 | =back | ||||
| 159 | |||||
| 160 | |||||
| 161 | =head1 SEE ALSO | ||||
| 162 | |||||
| 163 | L<Object::Enum>, L<DBIx::Class>, L<DBIx::Class::InflateColumn::URI> | ||||
| 164 | |||||
| 165 | |||||
| 166 | =head1 COPYRIGHT & LICENSE | ||||
| 167 | |||||
| 168 | Copyright 2008 Jason M. Mills, all rights reserved. | ||||
| 169 | |||||
| 170 | This program is free software; you can redistribute it and/or modify it | ||||
| 171 | under the same terms as Perl itself. | ||||
| 172 | |||||
| 173 | |||||
| 174 | =cut | ||||
| 175 | |||||
| 176 | 1 | 2µs | 1; # End of DBIx::Class::InflateColumn::Object::Enum |