Profile of DBIx/Class/FilterColumn.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:24:00 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/FilterColumn.pm
Statements | Executed 20 statements in 700µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 28µs | 274µs | DBIx::Class::FilterColumn::::filter_columnDBIx::Class::FilterColumn::filter_column
1 | 1 | 1 | 17µs | 22µs | DBIx::Class::FilterColumn::::BEGIN@2DBIx::Class::FilterColumn::BEGIN@2
1 | 1 | 1 | 10µs | 95µs | DBIx::Class::FilterColumn::::BEGIN@5DBIx::Class::FilterColumn::BEGIN@5
1 | 1 | 1 | 9µs | 27µs | DBIx::Class::FilterColumn::::BEGIN@3DBIx::Class::FilterColumn::BEGIN@3
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::_column_from_storageDBIx::Class::FilterColumn::_column_from_storage
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::_column_to_storageDBIx::Class::FilterColumn::_column_to_storage
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::get_columnDBIx::Class::FilterColumn::get_column
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::get_columnsDBIx::Class::FilterColumn::get_columns
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::get_filtered_columnDBIx::Class::FilterColumn::get_filtered_column
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::newDBIx::Class::FilterColumn::new
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::set_filtered_columnDBIx::Class::FilterColumn::set_filtered_column
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::store_columnDBIx::Class::FilterColumn::store_column
0 | 0 | 0 | 0s | 0s | DBIx::Class::FilterColumn::::updateDBIx::Class::FilterColumn::update

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package DBIx::Class::FilterColumn;
2 | 3 | 22µs | 2 | 27µs | # spent 22µs (17+5) within DBIx::Class::FilterColumn::BEGIN@2 which was called: # once (17µs+5µs) by Class::C3::Componentised::ensure_class_loaded at line 2 use strict; # spent 22µs making 1 call to DBIx::Class::FilterColumn::BEGIN@2 # spent 5µs making 1 call to strict::import
3 | 3 | 22µs | 2 | 44µs | # spent 27µs (9+18) within DBIx::Class::FilterColumn::BEGIN@3 which was called: # once (9µs+18µs) by Class::C3::Componentised::ensure_class_loaded at line 3 use warnings; # spent 27µs making 1 call to DBIx::Class::FilterColumn::BEGIN@3 # spent 18µs making 1 call to warnings::import
4 |  |  |  |  |
5 | 3 | 628µs | 2 | 181µs | # spent 95µs (10+85) within DBIx::Class::FilterColumn::BEGIN@5 which was called: # once (10µs+85µs) by Class::C3::Componentised::ensure_class_loaded at line 5 use base qw/DBIx::Class::Row/; # spent 95µs making 1 call to DBIx::Class::FilterColumn::BEGIN@5 # spent 85µs making 1 call to base::import
6 |  |  |  |  |
7 |  |  |  |  | # spent 274µs (28+246) within DBIx::Class::FilterColumn::filter_column which was called: # once (28µs+246µs) by Class::C3::Componentised::ensure_class_loaded at line 34 of Tapper/Schema/ReportsDB/Result/ReportFile.pm sub filter_column {
8 | 1 | 1µs |  |  | my ($self, $col, $attrs) = @_;
9 |  |  |  |  |
10 | 1 | 1µs | 1 | 17µs | my $colinfo = $self->column_info($col); # spent 17µs making 1 call to DBIx::Class::ResultSourceProxy::column_info
11 |  |  |  |  |
12 | 1 | 13µs | 1 | 2µs | $self->throw_exception('FilterColumn does not work with InflateColumn') # spent 2µs making 1 call to UNIVERSAL::isa
13 |  |  |  |  | if $self->isa('DBIx::Class::InflateColumn') &&
14 |  |  |  |  | defined $colinfo->{_inflate_info};
15 |  |  |  |  |
16 | 1 | 2µs | 1 | 16µs | $self->throw_exception("No such column $col to filter") # spent 16µs making 1 call to DBIx::Class::ResultSourceProxy::has_column
17 |  |  |  |  | unless $self->has_column($col);
18 |  |  |  |  |
19 | 1 | 1µs |  |  | $self->throw_exception('filter_column expects a hashref of filter specifications')
20 |  |  |  |  | unless ref $attrs eq 'HASH';
21 |  |  |  |  |
22 | 1 | 500ns |  |  | $self->throw_exception('An invocation of filter_column() must specify either a filter_from_storage or filter_to_storage')
23 |  |  |  |  | unless $attrs->{filter_from_storage} || $attrs->{filter_to_storage};
24 |  |  |  |  |
25 | 1 | 800ns |  |  | $colinfo->{_filter_info} = $attrs;
26 | 1 | 500ns |  |  | my $acc = $colinfo->{accessor};
27 | 1 | 2µs | 1 | 211µs | $self->mk_group_accessors(filtered_column => [ (defined $acc ? $acc : $col), $col]); # spent 211µs making 1 call to Class::Accessor::Grouped::mk_group_accessors
28 | 1 | 4µs |  |  | return 1;
29 |  |  |  |  | }
30 |  |  |  |  |
31 |  |  |  |  | sub _column_from_storage {
32 |  |  |  |  | my ($self, $col, $value) = @_;
33 |  |  |  |  |
34 |  |  |  |  | return $value unless defined $value;
35 |  |  |  |  |
36 |  |  |  |  | my $info = $self->column_info($col)
37 |  |  |  |  | or $self->throw_exception("No column info for $col");
38 |  |  |  |  |
39 |  |  |  |  | return $value unless exists $info->{_filter_info};
40 |  |  |  |  |
41 |  |  |  |  | my $filter = $info->{_filter_info}{filter_from_storage};
42 |  |  |  |  |
43 |  |  |  |  | return defined $filter ? $self->$filter($value) : $value;
44 |  |  |  |  | }
45 |  |  |  |  |
46 |  |  |  |  | sub _column_to_storage {
47 |  |  |  |  | my ($self, $col, $value) = @_;
48 |  |  |  |  |
49 |  |  |  |  | my $info = $self->column_info($col) or
50 |  |  |  |  | $self->throw_exception("No column info for $col");
51 |  |  |  |  |
52 |  |  |  |  | return $value unless exists $info->{_filter_info};
53 |  |  |  |  |
54 |  |  |  |  | my $unfilter = $info->{_filter_info}{filter_to_storage};
55 |  |  |  |  |
56 |  |  |  |  | return defined $unfilter ? $self->$unfilter($value) : $value;
57 |  |  |  |  | }
58 |  |  |  |  |
59 |  |  |  |  | sub get_filtered_column {
60 |  |  |  |  | my ($self, $col) = @_;
61 |  |  |  |  |
62 |  |  |  |  | $self->throw_exception("$col is not a filtered column")
63 |  |  |  |  | unless exists $self->column_info($col)->{_filter_info};
64 |  |  |  |  |
65 |  |  |  |  | return $self->{_filtered_column}{$col}
66 |  |  |  |  | if exists $self->{_filtered_column}{$col};
67 |  |  |  |  |
68 |  |  |  |  | my $val = $self->get_column($col);
69 |  |  |  |  |
70 |  |  |  |  | return $self->{_filtered_column}{$col} = $self->_column_from_storage($col, $val);
71 |  |  |  |  | }
72 |  |  |  |  |
73 |  |  |  |  | sub get_column {
74 |  |  |  |  | my ($self, $col) = @_;
75 |  |  |  |  | if (exists $self->{_filtered_column}{$col}) {
76 |  |  |  |  | return $self->{_column_data}{$col} ||= $self->_column_to_storage ($col, $self->{_filtered_column}{$col});
77 |  |  |  |  | }
78 |  |  |  |  |
79 |  |  |  |  | return $self->next::method ($col);
80 |  |  |  |  | }
81 |  |  |  |  |
82 |  |  |  |  | # sadly a separate codepath in Row.pm ( used by insert() )
83 |  |  |  |  | sub get_columns {
84 |  |  |  |  | my $self = shift;
85 |  |  |  |  |
86 |  |  |  |  | foreach my $col (keys %{$self->{_filtered_column}||{}}) {
87 |  |  |  |  | $self->{_column_data}{$col} ||= $self->_column_to_storage ($col, $self->{_filtered_column}{$col})
88 |  |  |  |  | if exists $self->{_filtered_column}{$col};
89 |  |  |  |  | }
90 |  |  |  |  |
91 |  |  |  |  | $self->next::method (@_);
92 |  |  |  |  | }
93 |  |  |  |  |
94 |  |  |  |  | sub store_column {
95 |  |  |  |  | my ($self, $col) = (shift, @_);
96 |  |  |  |  |
97 |  |  |  |  | # blow cache
98 |  |  |  |  | delete $self->{_filtered_column}{$col};
99 |  |  |  |  |
100 |  |  |  |  | $self->next::method(@_);
101 |  |  |  |  | }
102 |  |  |  |  |
103 |  |  |  |  | sub set_filtered_column {
104 |  |  |  |  | my ($self, $col, $filtered) = @_;
105 |  |  |  |  |
106 |  |  |  |  | # do not blow up the cache via set_column unless necessary
107 |  |  |  |  | # (filtering may be expensive!)
108 |  |  |  |  | if (exists $self->{_filtered_column}{$col}) {
109 |  |  |  |  | return $filtered
110 |  |  |  |  | if ($self->_eq_column_values ($col, $filtered, $self->{_filtered_column}{$col} ) );
111 |  |  |  |  |
112 |  |  |  |  | $self->make_column_dirty ($col); # so the comparison won't run again
113 |  |  |  |  | }
114 |  |  |  |  |
115 |  |  |  |  | $self->set_column($col, $self->_column_to_storage($col, $filtered));
116 |  |  |  |  |
117 |  |  |  |  | return $self->{_filtered_column}{$col} = $filtered;
118 |  |  |  |  | }
119 |  |  |  |  |
120 |  |  |  |  | sub update {
121 |  |  |  |  | my ($self, $attrs, @rest) = @_;
122 |  |  |  |  |
123 |  |  |  |  | foreach my $key (keys %{$attrs||{}}) {
124 |  |  |  |  | if (
125 |  |  |  |  | $self->has_column($key)
126 |  |  |  |  | &&
127 |  |  |  |  | exists $self->column_info($key)->{_filter_info}
128 |  |  |  |  | ) {
129 |  |  |  |  | $self->set_filtered_column($key, delete $attrs->{$key});
130 |  |  |  |  |
131 |  |  |  |  | # FIXME update() reaches directly into the object-hash
132 |  |  |  |  | # and we may *not* have a filtered value there - thus
133 |  |  |  |  | # the void-ctx filter-trigger
134 |  |  |  |  | $self->get_column($key) unless exists $self->{_column_data}{$key};
135 |  |  |  |  | }
136 |  |  |  |  | }
137 |  |  |  |  |
138 |  |  |  |  | return $self->next::method($attrs, @rest);
139 |  |  |  |  | }
140 |  |  |  |  |
141 |  |  |  |  | sub new {
142 |  |  |  |  | my ($class, $attrs, @rest) = @_;
143 |  |  |  |  | my $source = $attrs->{-result_source}
144 |  |  |  |  | or $class->throw_exception('Sourceless rows are not supported with DBIx::Class::FilterColumn');
145 |  |  |  |  |
146 |  |  |  |  | my $obj = $class->next::method($attrs, @rest);
147 |  |  |  |  | foreach my $key (keys %{$attrs||{}}) {
148 |  |  |  |  | if ($obj->has_column($key) &&
149 |  |  |  |  | exists $obj->column_info($key)->{_filter_info} ) {
150 |  |  |  |  | $obj->set_filtered_column($key, $attrs->{$key});
151 |  |  |  |  | }
152 |  |  |  |  | }
153 |  |  |  |  |
154 |  |  |  |  | return $obj;
155 |  |  |  |  | }
156 |  |  |  |  |
157 | 1 | 2µs |  |  | 1;
158 |  |  |  |  |
159 |  |  |  |  | =head1 NAME
160 |  |  |  |  |
161 |  |  |  |  | DBIx::Class::FilterColumn - Automatically convert column data
162 |  |  |  |  |
163 |  |  |  |  | =head1 SYNOPSIS
164 |  |  |  |  |
165 |  |  |  |  | In your Schema or DB class add "FilterColumn" to the top of the component list.
166 |  |  |  |  |
167 |  |  |  |  | __PACKAGE__->load_components(qw( FilterColumn ... ));
168 |  |  |  |  |
169 |  |  |  |  | Set up filters for the columns you want to convert.
170 |  |  |  |  |
171 |  |  |  |  | __PACKAGE__->filter_column( money => {
172 |  |  |  |  | filter_to_storage => 'to_pennies',
173 |  |  |  |  | filter_from_storage => 'from_pennies',
174 |  |  |  |  | });
175 |  |  |  |  |
176 |  |  |  |  | sub to_pennies { $_[1] * 100 }
177 |  |  |  |  |
178 |  |  |  |  | sub from_pennies { $_[1] / 100 }
179 |  |  |  |  |
180 |  |  |  |  | 1;
181 |  |  |  |  |
182 |  |  |  |  |
183 |  |  |  |  | =head1 DESCRIPTION
184 |  |  |  |  |
185 |  |  |  |  | This component is meant to be a more powerful, but less DWIM-y,
186 |  |  |  |  | L<DBIx::Class::InflateColumn>. One of the major issues with said component is
187 |  |  |  |  | that it B<only> works with references. Generally speaking anything that can
188 |  |  |  |  | be done with L<DBIx::Class::InflateColumn> can be done with this component.
189 |  |  |  |  |
190 |  |  |  |  | =head1 METHODS
191 |  |  |  |  |
192 |  |  |  |  | =head2 filter_column
193 |  |  |  |  |
194 |  |  |  |  | __PACKAGE__->filter_column( colname => {
195 |  |  |  |  | filter_from_storage => 'method'|\&coderef,
196 |  |  |  |  | filter_to_storage => 'method'|\&coderef,
197 |  |  |  |  | })
198 |  |  |  |  |
199 |  |  |  |  | This is the method that you need to call to set up a filtered column. It takes
200 |  |  |  |  | exactly two arguments; the first being the column name the second being a hash
201 |  |  |  |  | reference with C<filter_from_storage> and C<filter_to_storage> set to either
202 |  |  |  |  | a method name or a code reference. In either case the filter is invoked as:
203 |  |  |  |  |
204 |  |  |  |  | $row_obj->$filter_specification ($value_to_filter)
205 |  |  |  |  |
206 |  |  |  |  | with C<$filter_specification> being chosen depending on whether the
207 |  |  |  |  | C<$value_to_filter> is being retrieved from or written to permanent
208 |  |  |  |  | storage.
209 |  |  |  |  |
210 |  |  |  |  | If a specific directional filter is not specified, the original value will be
211 |  |  |  |  | passed to/from storage unfiltered.
212 |  |  |  |  |
213 |  |  |  |  | =head2 get_filtered_column
214 |  |  |  |  |
215 |  |  |  |  | $obj->get_filtered_column('colname')
216 |  |  |  |  |
217 |  |  |  |  | Returns the filtered value of the column
218 |  |  |  |  |
219 |  |  |  |  | =head2 set_filtered_column
220 |  |  |  |  |
221 |  |  |  |  | $obj->set_filtered_column(colname => 'new_value')
222 |  |  |  |  |
223 |  |  |  |  | Sets the filtered value of the column
224 |  |  |  |  |
225 |  |  |  |  | =head1 EXAMPLE OF USE
226 |  |  |  |  |
227 |  |  |  |  | Some databases have restrictions on values that can be passed to
228 |  |  |  |  | boolean columns, and problems can be caused by passing value that
229 |  |  |  |  | perl considers to be false (such as C<undef>).
230 |  |  |  |  |
231 |  |  |  |  | One solution to this is to ensure that the boolean values are set
232 |  |  |  |  | to something that the database can handle - such as numeric zero
233 |  |  |  |  | and one, using code like this:-
234 |  |  |  |  |
235 |  |  |  |  | __PACKAGE__->filter_column(
236 |  |  |  |  | my_boolean_column => {
237 |  |  |  |  | filter_to_storage => sub { $_[1] ? 1 : 0 },
238 |  |  |  |  | }
239 |  |  |  |  | );
240 |  |  |  |  |
241 |  |  |  |  | In this case the C<filter_from_storage> is not required, as just
242 |  |  |  |  | passing the database value through to perl does the right thing.