← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:05 2010

File /project/perl/lib/DBIx/ContextualFetch.pm
Statements Executed 1124
Statement Execution Time 304ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
4621113.7ms17.9msDBIx::ContextualFetch::st::::fetchDBIx::ContextualFetch::st::fetch
12111.84ms282msDBIx::ContextualFetch::st::::_untaint_executeDBIx::ContextualFetch::st::_untaint_execute
1263938µs283msDBIx::ContextualFetch::st::::executeDBIx::ContextualFetch::st::execute
1211378µs378µsDBIx::ContextualFetch::st::::_disallow_referencesDBIx::ContextualFetch::st::_disallow_references
111173µs1.96msDBIx::ContextualFetch::st::::select_rowDBIx::ContextualFetch::st::select_row
0000s0sDBIx::ContextualFetch::::BEGIN DBIx::ContextualFetch::BEGIN
0000s0sDBIx::ContextualFetch::db::::BEGINDBIx::ContextualFetch::db::BEGIN
0000s0sDBIx::ContextualFetch::st::::BEGINDBIx::ContextualFetch::st::BEGIN
0000s0sDBIx::ContextualFetch::st::::fetch_hashDBIx::ContextualFetch::st::fetch_hash
0000s0sDBIx::ContextualFetch::st::::fetchallDBIx::ContextualFetch::st::fetchall
0000s0sDBIx::ContextualFetch::st::::fetchall_hashDBIx::ContextualFetch::st::fetchall_hash
0000s0sDBIx::ContextualFetch::st::::select_colDBIx::ContextualFetch::st::select_col
0000s0sDBIx::ContextualFetch::st::::select_valDBIx::ContextualFetch::st::select_val
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package DBIx::ContextualFetch;
2
316µs$VERSION = '1.03';
4
5390µs127µsuse strict;
# spent 27µs making 1 call to strict::import
6387µs1120µsuse warnings;
# spent 120µs making 1 call to warnings::import
73106µs192µsno warnings 'uninitialized';
# spent 92µs making 1 call to warnings::unimport
8
93103µs1256µsuse base 'DBI';
# spent 256µs making 1 call to base::import
10
11package DBIx::ContextualFetch::db;
123120µs13.74msuse base 'DBI::db';
# spent 3.74ms making 1 call to base::import
13
14package DBIx::ContextualFetch::st;
1531.17ms1538µsuse base 'DBI::st';
# spent 538µs making 1 call to base::import
16
17
# spent 283ms (938µs+283) within DBIx::ContextualFetch::st::execute which was called 12 times, avg 23.6ms/call: # 4 times (291µs+19.8ms) by Class::DBI::Pg::pg_version at line 92 of Class/DBI/Pg.pm, avg 5.02ms/call # 2 times (149µs+157ms) by Class::DBI::Pg::set_up_table at line 25 of Class/DBI/Pg.pm, avg 78.7ms/call # 2 times (184µs+44.0ms) by Class::DBI::Pg::set_up_table at line 37 of Class/DBI/Pg.pm, avg 22.1ms/call # 2 times (168µs+3.82ms) by Class::DBI::Pg::set_up_table at line 48 of Class/DBI/Pg.pm, avg 1.99ms/call # once (73µs+56.2ms) by Class::DBI::sth_to_objects at line 1139 of Class/DBI.pm # once (73µs+1.59ms) by DBIx::ContextualFetch::st::select_row at line 87
sub execute {
181280µs my ($sth) = shift;
19
201274µs my $rv;
21
22 # Allow $sth->execute(\@param, \@cols) and
23 # $sth->execute(undef, \@cols) syntax.
2412127µs if ( @_ == 2
25 and (!defined $_[0] || ref $_[0] eq 'ARRAY')
26 and ref $_[1] eq 'ARRAY') {
27 my ($bind_params, $bind_cols) = @_;
28 $rv = $sth->_untaint_execute(@$bind_params);
29 $sth->SUPER::bind_columns(@$bind_cols);
30 } else {
3112190µs12378µs $sth->_disallow_references(@_);
# spent 378µs making 12 calls to DBIx::ContextualFetch::st::_disallow_references, avg 32µs/call
3212207µs12282ms $rv = $sth->_untaint_execute(@_);
# spent 282ms making 12 calls to DBIx::ContextualFetch::st::_untaint_execute, avg 23.5ms/call
33 }
3412203µs return $rv;
35}
36
37
# spent 378µs within DBIx::ContextualFetch::st::_disallow_references which was called 12 times, avg 32µs/call: # 12 times (378µs+0s) by DBIx::ContextualFetch::st::execute at line 31, avg 32µs/call
sub _disallow_references {
381252µs my $self = shift;
3912325µs foreach (@_) {
40761µs next unless ref $_;
41 next if overload::Method($_, q{""});
42 next if overload::Method($_, q{0+});
43 die "Cannot call execute with a reference ($_)\n";
44 }
45}
46
47# local $sth->{Taint} leaks in old perls :(
48
# spent 282ms (1.84+280) within DBIx::ContextualFetch::st::_untaint_execute which was called 12 times, avg 23.5ms/call: # 12 times (1.84ms+280ms) by DBIx::ContextualFetch::st::execute at line 32, avg 23.5ms/call
sub _untaint_execute {
491253µs my $sth = shift;
5012540µs12171µs my $old_value = $sth->{Taint};
# spent 171µs making 12 calls to DBI::common::FETCH, avg 14µs/call
5112452µs12156µs $sth->{Taint} = 0;
# spent 156µs making 12 calls to DBI::common::STORE, avg 13µs/call
5212280ms12280ms my $ret = $sth->SUPER::execute(@_);
# spent 280ms making 12 calls to DBI::st::execute, avg 23.3ms/call
5312631µs12184µs $sth->{Taint} = $old_value;
# spent 184µs making 12 calls to DBI::common::STORE, avg 15µs/call
5412199µs return $ret;
55}
56
57
# spent 17.9ms (13.7+4.20) within DBIx::ContextualFetch::st::fetch which was called 462 times, avg 39µs/call: # 462 times (13.7ms+4.20ms) by Class::DBI::sth_to_objects at line 1141 of Class/DBI.pm, avg 39µs/call
sub fetch {
584622.33ms my ($sth) = shift;
59 return wantarray
6046215.8ms4624.20ms ? $sth->SUPER::fetchrow_array
# spent 4.20ms making 462 calls to DBI::st::fetchrow_arrayref, avg 9µs/call
61 : $sth->SUPER::fetchrow_arrayref;
62}
63
64sub fetch_hash {
65 my ($sth) = shift;
66 my $row = $sth->SUPER::fetchrow_hashref;
67 return unless defined $row;
68 return wantarray ? %$row : $row;
69}
70
71sub fetchall {
72 my ($sth) = shift;
73 my $rows = $sth->SUPER::fetchall_arrayref;
74 return wantarray ? @$rows : $rows;
75}
76
77# There may be some code in DBI->fetchall_arrayref, but its undocumented.
78sub fetchall_hash {
79 my ($sth) = shift;
80 my (@rows, $row);
81 push @rows, $row while ($row = $sth->SUPER::fetchrow_hashref);
82 return wantarray ? @rows : \@rows;
83}
84
85
# spent 1.96ms (173µs+1.78) within DBIx::ContextualFetch::st::select_row which was called # once (173µs+1.78ms) by Class::DBI::_flesh at line 857 of Class/DBI.pm
sub select_row {
8616µs my ($sth, @args) = @_;
87115µs11.67ms $sth->execute(@args);
# spent 1.67ms making 1 call to DBIx::ContextualFetch::st::execute
881169µs1100µs my @row = $sth->fetchrow_array;
# spent 100µs making 1 call to DBI::st::fetchrow_array
89147µs116µs $sth->finish;
# spent 16µs making 1 call to DBI::st::finish
90151µs return @row;
91}
92
93sub select_col {
94 my ($sth, @args) = @_;
95 my (@row, $cur);
96 $sth->execute(@args);
97 $sth->bind_col(1, \$cur);
98 push @row, $cur while $sth->fetch;
99 $sth->finish;
100 return @row;
101}
102
103sub select_val {
104 my ($sth, @args) = @_;
105 return ($sth->select_row(@args))[0];
106}
107
108115µsreturn 1;
109
110__END__
111
112=head1 NAME
113
114DBIx::ContextualFetch - Add contextual fetches to DBI
115
116=head1 SYNOPSIS
117
118 my $dbh = DBI->connect(...., { RootClass => "DBIx::ContextualFetch" });
119
120 # Modified statement handle methods.
121 my $rv = $sth->execute;
122 my $rv = $sth->execute(@bind_values);
123 my $rv = $sth->execute(\@bind_values, \@bind_cols);
124
125 # In addition to the normal DBI sth methods...
126 my $row_ref = $sth->fetch;
127 my @row = $sth->fetch;
128
129 my $row_ref = $sth->fetch_hash;
130 my %row = $sth->fetch_hash;
131
132 my $rows_ref = $sth->fetchall;
133 my @rows = $sth->fetchall;
134
135 my $rows_ref = $sth->fetchall_hash;
136 my @tbl = $sth->fetchall_hash;
137
138=head1 DESCRIPTION
139
140It always struck me odd that DBI didn't take much advantage of Perl's
141context sensitivity. DBIx::ContextualFetch redefines some of the various
142fetch methods to fix this oversight. It also adds a few new methods for
143convenience (though not necessarily efficiency).
144
145=head1 SET-UP
146
147 my $dbh = DBIx::ContextualFetch->connect(@info);
148 my $dbh = DBI->connect(@info, { RootClass => "DBIx::ContextualFetch" });
149
150To use this method, you can either make sure that everywhere you normall
151call DBI->connect() you either call it on DBIx::ContextualFetch, or that
152you pass this as your RootClass. After this DBI will Do The Right Thing
153and pass all its calls through us.
154
155=head1 EXTENSIONS
156
157=head2 execute
158
159 $rv = $sth->execute;
160 $rv = $sth->execute(@bind_values);
161 $rv = $sth->execute(\@bind_values, \@bind_cols);
162
163execute() is enhanced slightly:
164
165If called with no arguments, or with a simple list, execute() operates
166normally. When when called with two array references, it performs
167the functions of bind_param, execute and bind_columns similar to the
168following:
169
170 $sth->execute(@bind_values);
171 $sth->bind_columns(undef, @bind_cols);
172
173In addition, execute will accept tainted @bind_values. I can't think of
174what a malicious user could do with a tainted bind value (in the general
175case. Your application may vary.)
176
177Thus a typical idiom would be:
178
179 $sth->execute([$this, $that], [\($foo, $bar)]);
180
181Of course, this method provides no way of passing bind attributes
182through to bind_param or bind_columns. If that is necessary, then you
183must perform the bind_param, execute, bind_col sequence yourself.
184
185=head2 fetch
186
187 $row_ref = $sth->fetch;
188 @row = $sth->fetch;
189
190A context sensitive version of fetch(). When in scalar context, it will
191act as fetchrow_arrayref. In list context it will use fetchrow_array.
192
193=head2 fetch_hash
194
195 $row_ref = $sth->fetch_hash;
196 %row = $sth->fetch_hash;
197
198A modification on fetchrow_hashref. When in scalar context, it acts just
199as fetchrow_hashref() does. In list context it returns the complete hash.
200
201=head2 fetchall
202
203 $rows_ref = $sth->fetchall;
204 @rows = $sth->fetchall;
205
206A modification on fetchall_arrayref. In scalar context it acts as
207fetchall_arrayref. In list it returns an array of references to rows
208fetched.
209
210=head2 fetchall_hash
211
212 $rows_ref = $sth->fetchall_hash;
213 @rows = $sth->fetchall_hash;
214
215A mating of fetchall_arrayref() with fetchrow_hashref(). It gets all rows
216from the hash, each as hash references. In scalar context it returns
217a reference to an array of hash references. In list context it returns
218a list of hash references.
219
220=head1 ORIGINAL AUTHOR
221
222Michael G Schwern as part of Ima::DBI
223
224=head1 CURRENT MAINTAINER
225
226Tony Bowden <tony@tmtm.com>
227
228=head1 LICENSE
229
230This library is free software; you can redistribute it and/or modify
231it under the same terms as Perl itself.
232
233=head1 SEE ALSO
234
235L<DBI>. L<Ima::DBI>. L<Class::DBI>.
236
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.