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 | BEGIN@6 | DBIx::Class::InflateColumn::Object::Enum::
20 | 2 | 2 | 173µs | 3.02ms | register_column | DBIx::Class::InflateColumn::Object::Enum::
1 | 1 | 1 | 15µs | 33µs | BEGIN@3 | DBIx::Class::InflateColumn::Object::Enum::
1 | 1 | 1 | 10µs | 13µs | BEGIN@4 | DBIx::Class::InflateColumn::Object::Enum::
1 | 1 | 1 | 8µs | 39µs | BEGIN@5 | DBIx::Class::InflateColumn::Object::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:109] | DBIx::Class::InflateColumn::Object::Enum::
0 | 0 | 0 | 0s | 0s | __ANON__[:112] | DBIx::Class::InflateColumn::Object::Enum::
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 |