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

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/FilterColumn.pm
StatementsExecuted 20 statements in 700µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11128µs274µsDBIx::Class::FilterColumn::::filter_columnDBIx::Class::FilterColumn::filter_column
11117µs22µsDBIx::Class::FilterColumn::::BEGIN@2DBIx::Class::FilterColumn::BEGIN@2
11110µs95µsDBIx::Class::FilterColumn::::BEGIN@5DBIx::Class::FilterColumn::BEGIN@5
1119µs27µsDBIx::Class::FilterColumn::::BEGIN@3DBIx::Class::FilterColumn::BEGIN@3
0000s0sDBIx::Class::FilterColumn::::_column_from_storageDBIx::Class::FilterColumn::_column_from_storage
0000s0sDBIx::Class::FilterColumn::::_column_to_storageDBIx::Class::FilterColumn::_column_to_storage
0000s0sDBIx::Class::FilterColumn::::get_columnDBIx::Class::FilterColumn::get_column
0000s0sDBIx::Class::FilterColumn::::get_columnsDBIx::Class::FilterColumn::get_columns
0000s0sDBIx::Class::FilterColumn::::get_filtered_columnDBIx::Class::FilterColumn::get_filtered_column
0000s0sDBIx::Class::FilterColumn::::newDBIx::Class::FilterColumn::new
0000s0sDBIx::Class::FilterColumn::::set_filtered_columnDBIx::Class::FilterColumn::set_filtered_column
0000s0sDBIx::Class::FilterColumn::::store_columnDBIx::Class::FilterColumn::store_column
0000s0sDBIx::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
1package DBIx::Class::FilterColumn;
2322µs227µ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
3322µs244µ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
53628µs2181µ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 {
81026µs my ($self, $col, $attrs) = @_;
9
10117µs my $colinfo = $self->column_info($col);
# spent 17µs making 1 call to DBIx::Class::ResultSourceProxy::column_info
11
1212µ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
16116µ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 $self->throw_exception('filter_column expects a hashref of filter specifications')
20 unless ref $attrs eq 'HASH';
21
22 $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 $colinfo->{_filter_info} = $attrs;
26 my $acc = $colinfo->{accessor};
271211µ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 return 1;
29}
30
31sub _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
46sub _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
59sub 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
73sub 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() )
83sub 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
94sub store_column {
95 my ($self, $col) = (shift, @_);
96
97 # blow cache
98 delete $self->{_filtered_column}{$col};
99
100 $self->next::method(@_);
101}
102
103sub 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
120sub 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
141sub 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
15712µs1;
158
159=head1 NAME
160
161DBIx::Class::FilterColumn - Automatically convert column data
162
163=head1 SYNOPSIS
164
165In your Schema or DB class add "FilterColumn" to the top of the component list.
166
167 __PACKAGE__->load_components(qw( FilterColumn ... ));
168
169Set 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
185This component is meant to be a more powerful, but less DWIM-y,
186L<DBIx::Class::InflateColumn>. One of the major issues with said component is
187that it B<only> works with references. Generally speaking anything that can
188be 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
199This is the method that you need to call to set up a filtered column. It takes
200exactly two arguments; the first being the column name the second being a hash
201reference with C<filter_from_storage> and C<filter_to_storage> set to either
202a method name or a code reference. In either case the filter is invoked as:
203
204 $row_obj->$filter_specification ($value_to_filter)
205
206with C<$filter_specification> being chosen depending on whether the
207C<$value_to_filter> is being retrieved from or written to permanent
208storage.
209
210If a specific directional filter is not specified, the original value will be
211passed to/from storage unfiltered.
212
213=head2 get_filtered_column
214
215 $obj->get_filtered_column('colname')
216
217Returns the filtered value of the column
218
219=head2 set_filtered_column
220
221 $obj->set_filtered_column(colname => 'new_value')
222
223Sets the filtered value of the column
224
225=head1 EXAMPLE OF USE
226
227Some databases have restrictions on values that can be passed to
228boolean columns, and problems can be caused by passing value that
229perl considers to be false (such as C<undef>).
230
231One solution to this is to ensure that the boolean values are set
232to something that the database can handle - such as numeric zero
233and 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
241In this case the C<filter_from_storage> is not required, as just
242passing the database value through to perl does the right thing.