← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:33:28 2016

Filename/usr/share/perl5/SQL/Abstract.pm
StatementsExecuted 17072 statements in 41.7ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
32353124.1ms34.7msSQL::Abstract::::_assert_pass_injection_guardSQL::Abstract::_assert_pass_injection_guard
3191120.6ms130msSQL::Abstract::::_where_hashpair_HASHREFSQL::Abstract::_where_hashpair_HASHREF
6496115.0ms98.1msSQL::Abstract::::_SWITCH_refkindSQL::Abstract::_SWITCH_refkind (recurses: max depth 5, inclusive time 22.6ms)
3202112.0ms71.1msSQL::Abstract::::_where_unary_opSQL::Abstract::_where_unary_op (recurses: max depth 2, inclusive time 1.22ms)
318118.12ms91.0msSQL::Abstract::::__ANON__[:941]SQL::Abstract::__ANON__[:941]
7400817.72ms7.72msSQL::Abstract::::CORE:matchSQL::Abstract::CORE:match (opcode)
6758717.47ms7.47msSQL::Abstract::::CORE:regcompSQL::Abstract::CORE:regcomp (opcode)
321117.03ms145msSQL::Abstract::::_where_HASHREFSQL::Abstract::_where_HASHREF (recurses: max depth 2, inclusive time 1.74ms)
1290116.17ms6.93msSQL::Abstract::::_refkindSQL::Abstract::_refkind
1290216.06ms13.0msSQL::Abstract::::_try_refkindSQL::Abstract::_try_refkind
641215.67ms14.3msSQL::Abstract::::_METHOD_FOR_refkindSQL::Abstract::_METHOD_FOR_refkind
317114.33ms175msSQL::Abstract::::whereSQL::Abstract::where
1113.13ms3.14msSQL::Abstract::::BEGIN@3SQL::Abstract::BEGIN@3
321213.01ms157msSQL::Abstract::::_recurse_whereSQL::Abstract::_recurse_where (recurses: max depth 2, inclusive time 1.82ms)
318112.54ms5.02msSQL::Abstract::::__ANON__[:668]SQL::Abstract::__ANON__[:668]
1275822.18ms2.18msSQL::Abstract::::_sqlcaseSQL::Abstract::_sqlcase
318111.65ms1.65msSQL::Abstract::::_bindtypeSQL::Abstract::_bindtype
636211.33ms1.33msSQL::Abstract::::_convertSQL::Abstract::_convert
1603911.32ms1.32msSQL::Abstract::::CORE:substSQL::Abstract::CORE:subst (opcode)
323211.28ms1.28msSQL::Abstract::::_join_sql_clausesSQL::Abstract::_join_sql_clauses
32131855µs855µsSQL::Abstract::::_debugSQL::Abstract::_debug
64021355µs355µsSQL::Abstract::::CORE:sortSQL::Abstract::CORE:sort (opcode)
211101µs1.14msSQL::Abstract::::_where_ARRAYREFSQL::Abstract::_where_ARRAYREF (recurses: max depth 1, inclusive time 875µs)
43278µs216µsSQL::Abstract::::_order_by_chunksSQL::Abstract::_order_by_chunks (recurses: max depth 1, inclusive time 97µs)
21153µs1.20msSQL::Abstract::::_where_op_ANDORSQL::Abstract::_where_op_ANDOR (recurses: max depth 1, inclusive time 925µs)
11141µs62µsSQL::Abstract::::newSQL::Abstract::new
11124µs55µsSQL::Abstract::::__ANON__[:932]SQL::Abstract::__ANON__[:932]
11121µs118µsSQL::Abstract::::__ANON__[:1304]SQL::Abstract::__ANON__[:1304]
41118µs1.84msSQL::Abstract::::__ANON__[:547]SQL::Abstract::__ANON__[:547]
11116µs36µsSQL::Abstract::::_where_hashpair_UNDEFSQL::Abstract::_where_hashpair_UNDEF
21115µs2.03msSQL::Abstract::::__ANON__[:688]SQL::Abstract::__ANON__[:688]
167115µs15µsSQL::Abstract::::CORE:qrSQL::Abstract::CORE:qr (opcode)
11113µs20µsSQL::Abstract::::BEGIN@86SQL::Abstract::BEGIN@86
11112µs23µsSQL::Abstract::::BEGIN@9SQL::Abstract::BEGIN@9
11112µs21µsSQL::Abstract::::BEGIN@4SQL::Abstract::BEGIN@4
1118µs8µsSQL::Abstract::::BEGIN@12SQL::Abstract::BEGIN@12
2115µs48µsSQL::Abstract::::__ANON__[:1312]SQL::Abstract::__ANON__[:1312]
1114µs4µsSQL::Abstract::::BEGIN@6SQL::Abstract::BEGIN@6
1114µs4µsSQL::Abstract::::BEGIN@5SQL::Abstract::BEGIN@5
1114µs4µsSQL::Abstract::::BEGIN@7SQL::Abstract::BEGIN@7
2114µs4µsSQL::Abstract::::__ANON__[:1281]SQL::Abstract::__ANON__[:1281]
1111µs1µsSQL::Abstract::::__ANON__[:1314]SQL::Abstract::__ANON__[:1314]
0000s0sSQL::Abstract::::AUTOLOADSQL::Abstract::AUTOLOAD
0000s0sSQL::Abstract::::DESTROYSQL::Abstract::DESTROY
0000s0sSQL::Abstract::::__ANON__[:1105]SQL::Abstract::__ANON__[:1105]
0000s0sSQL::Abstract::::__ANON__[:1108]SQL::Abstract::__ANON__[:1108]
0000s0sSQL::Abstract::::__ANON__[:1117]SQL::Abstract::__ANON__[:1117]
0000s0sSQL::Abstract::::__ANON__[:1120]SQL::Abstract::__ANON__[:1120]
0000s0sSQL::Abstract::::__ANON__[:1125]SQL::Abstract::__ANON__[:1125]
0000s0sSQL::Abstract::::__ANON__[:1131]SQL::Abstract::__ANON__[:1131]
0000s0sSQL::Abstract::::__ANON__[:1134]SQL::Abstract::__ANON__[:1134]
0000s0sSQL::Abstract::::__ANON__[:1144]SQL::Abstract::__ANON__[:1144]
0000s0sSQL::Abstract::::__ANON__[:1147]SQL::Abstract::__ANON__[:1147]
0000s0sSQL::Abstract::::__ANON__[:1174]SQL::Abstract::__ANON__[:1174]
0000s0sSQL::Abstract::::__ANON__[:1177]SQL::Abstract::__ANON__[:1177]
0000s0sSQL::Abstract::::__ANON__[:1182]SQL::Abstract::__ANON__[:1182]
0000s0sSQL::Abstract::::__ANON__[:1188]SQL::Abstract::__ANON__[:1188]
0000s0sSQL::Abstract::::__ANON__[:1196]SQL::Abstract::__ANON__[:1196]
0000s0sSQL::Abstract::::__ANON__[:1215]SQL::Abstract::__ANON__[:1215]
0000s0sSQL::Abstract::::__ANON__[:1220]SQL::Abstract::__ANON__[:1220]
0000s0sSQL::Abstract::::__ANON__[:1226]SQL::Abstract::__ANON__[:1226]
0000s0sSQL::Abstract::::__ANON__[:1230]SQL::Abstract::__ANON__[:1230]
0000s0sSQL::Abstract::::__ANON__[:1234]SQL::Abstract::__ANON__[:1234]
0000s0sSQL::Abstract::::__ANON__[:1282]SQL::Abstract::__ANON__[:1282]
0000s0sSQL::Abstract::::__ANON__[:1310]SQL::Abstract::__ANON__[:1310]
0000s0sSQL::Abstract::::__ANON__[:1316]SQL::Abstract::__ANON__[:1316]
0000s0sSQL::Abstract::::__ANON__[:1337]SQL::Abstract::__ANON__[:1337]
0000s0sSQL::Abstract::::__ANON__[:1340]SQL::Abstract::__ANON__[:1340]
0000s0sSQL::Abstract::::__ANON__[:1349]SQL::Abstract::__ANON__[:1349]
0000s0sSQL::Abstract::::__ANON__[:1362]SQL::Abstract::__ANON__[:1362]
0000s0sSQL::Abstract::::__ANON__[:1363]SQL::Abstract::__ANON__[:1363]
0000s0sSQL::Abstract::::__ANON__[:1364]SQL::Abstract::__ANON__[:1364]
0000s0sSQL::Abstract::::__ANON__[:1554]SQL::Abstract::__ANON__[:1554]
0000s0sSQL::Abstract::::__ANON__[:1559]SQL::Abstract::__ANON__[:1559]
0000s0sSQL::Abstract::::__ANON__[:1561]SQL::Abstract::__ANON__[:1561]
0000s0sSQL::Abstract::::__ANON__[:1564]SQL::Abstract::__ANON__[:1564]
0000s0sSQL::Abstract::::__ANON__[:236]SQL::Abstract::__ANON__[:236]
0000s0sSQL::Abstract::::__ANON__[:237]SQL::Abstract::__ANON__[:237]
0000s0sSQL::Abstract::::__ANON__[:238]SQL::Abstract::__ANON__[:238]
0000s0sSQL::Abstract::::__ANON__[:309]SQL::Abstract::__ANON__[:309]
0000s0sSQL::Abstract::::__ANON__[:316]SQL::Abstract::__ANON__[:316]
0000s0sSQL::Abstract::::__ANON__[:324]SQL::Abstract::__ANON__[:324]
0000s0sSQL::Abstract::::__ANON__[:328]SQL::Abstract::__ANON__[:328]
0000s0sSQL::Abstract::::__ANON__[:333]SQL::Abstract::__ANON__[:333]
0000s0sSQL::Abstract::::__ANON__[:378]SQL::Abstract::__ANON__[:378]
0000s0sSQL::Abstract::::__ANON__[:384]SQL::Abstract::__ANON__[:384]
0000s0sSQL::Abstract::::__ANON__[:387]SQL::Abstract::__ANON__[:387]
0000s0sSQL::Abstract::::__ANON__[:399]SQL::Abstract::__ANON__[:399]
0000s0sSQL::Abstract::::__ANON__[:403]SQL::Abstract::__ANON__[:403]
0000s0sSQL::Abstract::::__ANON__[:532]SQL::Abstract::__ANON__[:532]
0000s0sSQL::Abstract::::__ANON__[:538]SQL::Abstract::__ANON__[:538]
0000s0sSQL::Abstract::::__ANON__[:540]SQL::Abstract::__ANON__[:540]
0000s0sSQL::Abstract::::__ANON__[:542]SQL::Abstract::__ANON__[:542]
0000s0sSQL::Abstract::::__ANON__[:549]SQL::Abstract::__ANON__[:549]
0000s0sSQL::Abstract::::__ANON__[:601]SQL::Abstract::__ANON__[:601]
0000s0sSQL::Abstract::::__ANON__[:635]SQL::Abstract::__ANON__[:635]
0000s0sSQL::Abstract::::__ANON__[:637]SQL::Abstract::__ANON__[:637]
0000s0sSQL::Abstract::::__ANON__[:671]SQL::Abstract::__ANON__[:671]
0000s0sSQL::Abstract::::__ANON__[:694]SQL::Abstract::__ANON__[:694]
0000s0sSQL::Abstract::::__ANON__[:702]SQL::Abstract::__ANON__[:702]
0000s0sSQL::Abstract::::__ANON__[:710]SQL::Abstract::__ANON__[:710]
0000s0sSQL::Abstract::::__ANON__[:714]SQL::Abstract::__ANON__[:714]
0000s0sSQL::Abstract::::__ANON__[:718]SQL::Abstract::__ANON__[:718]
0000s0sSQL::Abstract::::__ANON__[:731]SQL::Abstract::__ANON__[:731]
0000s0sSQL::Abstract::::__ANON__[:735]SQL::Abstract::__ANON__[:735]
0000s0sSQL::Abstract::::__ANON__[:739]SQL::Abstract::__ANON__[:739]
0000s0sSQL::Abstract::::__ANON__[:751]SQL::Abstract::__ANON__[:751]
0000s0sSQL::Abstract::::__ANON__[:755]SQL::Abstract::__ANON__[:755]
0000s0sSQL::Abstract::::__ANON__[:759]SQL::Abstract::__ANON__[:759]
0000s0sSQL::Abstract::::__ANON__[:891]SQL::Abstract::__ANON__[:891]
0000s0sSQL::Abstract::::__ANON__[:911]SQL::Abstract::__ANON__[:911]
0000s0sSQL::Abstract::::__ANON__[:920]SQL::Abstract::__ANON__[:920]
0000s0sSQL::Abstract::::__ANON__[:959]SQL::Abstract::__ANON__[:959]
0000s0sSQL::Abstract::::__ANON__[:962]SQL::Abstract::__ANON__[:962]
0000s0sSQL::Abstract::::_assert_bindval_matches_bindtypeSQL::Abstract::_assert_bindval_matches_bindtype
0000s0sSQL::Abstract::::_insert_ARRAYREFSQL::Abstract::_insert_ARRAYREF
0000s0sSQL::Abstract::::_insert_ARRAYREFREFSQL::Abstract::_insert_ARRAYREFREF
0000s0sSQL::Abstract::::_insert_HASHREFSQL::Abstract::_insert_HASHREF
0000s0sSQL::Abstract::::_insert_SCALARREFSQL::Abstract::_insert_SCALARREF
0000s0sSQL::Abstract::::_insert_returningSQL::Abstract::_insert_returning
0000s0sSQL::Abstract::::_insert_valuesSQL::Abstract::_insert_values
0000s0sSQL::Abstract::::_open_outer_parenSQL::Abstract::_open_outer_paren
0000s0sSQL::Abstract::::_order_bySQL::Abstract::_order_by
0000s0sSQL::Abstract::::_quoteSQL::Abstract::_quote
0000s0sSQL::Abstract::::_tableSQL::Abstract::_table
0000s0sSQL::Abstract::::_where_ARRAYREFREFSQL::Abstract::_where_ARRAYREFREF
0000s0sSQL::Abstract::::_where_SCALARSQL::Abstract::_where_SCALAR
0000s0sSQL::Abstract::::_where_SCALARREFSQL::Abstract::_where_SCALARREF
0000s0sSQL::Abstract::::_where_UNDEFSQL::Abstract::_where_UNDEF
0000s0sSQL::Abstract::::_where_field_BETWEENSQL::Abstract::_where_field_BETWEEN
0000s0sSQL::Abstract::::_where_field_INSQL::Abstract::_where_field_IN
0000s0sSQL::Abstract::::_where_field_ISSQL::Abstract::_where_field_IS
0000s0sSQL::Abstract::::_where_field_op_ARRAYREFSQL::Abstract::_where_field_op_ARRAYREF
0000s0sSQL::Abstract::::_where_hashpair_ARRAYREFSQL::Abstract::_where_hashpair_ARRAYREF
0000s0sSQL::Abstract::::_where_hashpair_ARRAYREFREFSQL::Abstract::_where_hashpair_ARRAYREFREF
0000s0sSQL::Abstract::::_where_hashpair_SCALARSQL::Abstract::_where_hashpair_SCALAR
0000s0sSQL::Abstract::::_where_hashpair_SCALARREFSQL::Abstract::_where_hashpair_SCALARREF
0000s0sSQL::Abstract::::_where_op_BOOLSQL::Abstract::_where_op_BOOL
0000s0sSQL::Abstract::::_where_op_IDENTSQL::Abstract::_where_op_IDENT
0000s0sSQL::Abstract::::_where_op_NESTSQL::Abstract::_where_op_NEST
0000s0sSQL::Abstract::::_where_op_VALUESQL::Abstract::_where_op_VALUE
0000s0sSQL::Abstract::::deleteSQL::Abstract::delete
0000s0sSQL::Abstract::::generateSQL::Abstract::generate
0000s0sSQL::Abstract::::insertSQL::Abstract::insert
0000s0sSQL::Abstract::::is_literal_valueSQL::Abstract::is_literal_value
0000s0sSQL::Abstract::::is_plain_valueSQL::Abstract::is_plain_value
0000s0sSQL::Abstract::::selectSQL::Abstract::select
0000s0sSQL::Abstract::::updateSQL::Abstract::update
0000s0sSQL::Abstract::::valuesSQL::Abstract::values
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package SQL::Abstract; # see doc at end of file
2
323.16ms
# spent 3.14ms (3.13+15µs) within SQL::Abstract::BEGIN@3 which was called: # once (3.13ms+15µs) by DBIx::Class::Row::BEGIN@12 at line 3
use strict;
# spent 3.14ms making 1 call to SQL::Abstract::BEGIN@3 # spent 15µs making 1 call to strict::import
4231µs
# spent 21µs (12+9) within SQL::Abstract::BEGIN@4 which was called: # once (12µs+9µs) by DBIx::Class::Row::BEGIN@12 at line 4
use warnings;
# spent 21µs making 1 call to SQL::Abstract::BEGIN@4 # spent 9µs making 1 call to warnings::import
514µs
# spent 4µs within SQL::Abstract::BEGIN@5 which was called: # once (4µs+0s) by DBIx::Class::Row::BEGIN@12 at line 5
use Carp ();
# spent 4µs making 1 call to SQL::Abstract::BEGIN@5
614µs
# spent 4µs within SQL::Abstract::BEGIN@6 which was called: # once (4µs+0s) by DBIx::Class::Row::BEGIN@12 at line 6
use List::Util ();
# spent 4µs making 1 call to SQL::Abstract::BEGIN@6
714µs
# spent 4µs within SQL::Abstract::BEGIN@7 which was called: # once (4µs+0s) by DBIx::Class::Row::BEGIN@12 at line 7
use Scalar::Util ();
# spent 4µs making 1 call to SQL::Abstract::BEGIN@7
8
9234µs
# spent 23µs (12+11) within SQL::Abstract::BEGIN@9 which was called: # once (12µs+11µs) by DBIx::Class::Row::BEGIN@12 at line 9
use Exporter 'import';
# spent 23µs making 1 call to SQL::Abstract::BEGIN@9 # spent 11µs making 1 call to Exporter::import
10our @EXPORT_OK = qw(is_plain_value is_literal_value);
11
12
# spent 8µs within SQL::Abstract::BEGIN@12 which was called: # once (8µs+0s) by DBIx::Class::Row::BEGIN@12 at line 24
BEGIN {
13 if ($] < 5.009_005) {
14 require MRO::Compat;
15 }
16 else {
17 require mro;
18 }
19
20 *SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION = $ENV{SQLA_ISVALUE_IGNORE_AUTOGENERATED_STRINGIFICATION}
21 ? sub () { 0 }
22 : sub () { 1 }
23 ;
2418µs}
# spent 8µs making 1 call to SQL::Abstract::BEGIN@12
25
26#======================================================================
27# GLOBALS
28#======================================================================
29
30our $VERSION = '1.81';
31
32# This would confuse some packagers
3313µs$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
# spent 3µs making 1 call to SQL::Abstract::CORE:match
34
35our $AUTOLOAD;
36
37# special operators (-in, -between). May be extended/overridden by user.
38# See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation
3956µsmy @BUILTIN_SPECIAL_OPS = (
# spent 6µs making 5 calls to SQL::Abstract::CORE:qr, avg 1µs/call
40 {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'},
41 {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'},
42 {regex => qr/^ ident $/ix, handler => '_where_op_IDENT'},
43 {regex => qr/^ value $/ix, handler => '_where_op_VALUE'},
44 {regex => qr/^ is (?: \s+ not )? $/ix, handler => '_where_field_IS'},
45);
46
47# unaryish operators - key maps to handler
4865µsmy @BUILTIN_UNARY_OPS = (
# spent 5µs making 6 calls to SQL::Abstract::CORE:qr, avg 767ns/call
49 # the digits are backcompat stuff
50 { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
51 { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' },
52 { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' },
53 { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' },
54 { regex => qr/^ ident $/xi, handler => '_where_op_IDENT' },
55 { regex => qr/^ value $/xi, handler => '_where_op_VALUE' },
56);
57
58#======================================================================
59# DEBUGGING AND ERROR REPORTING
60#======================================================================
61
62
# spent 855µs within SQL::Abstract::_debug which was called 321 times, avg 3µs/call: # 318 times (848µs+0s) by SQL::Abstract::_where_unary_op at line 655, avg 3µs/call # 2 times (5µs+0s) by SQL::Abstract::_where_HASHREF at line 595, avg 2µs/call # once (2µs+0s) by SQL::Abstract::_where_hashpair_UNDEF at line 1050
sub _debug {
6385260µs return unless $_[0]->{debug}; shift; # a little faster
64 my $func = (caller(1))[3];
65 warn "[$func] ", @_, "\n";
66}
67
68sub belch (@) {
69 my($func) = (caller(1))[3];
70 Carp::carp "[$func] Warning: ", @_;
71}
72
73sub puke (@) {
74 my($func) = (caller(1))[3];
75 Carp::croak "[$func] Fatal: ", @_;
76}
77
78sub is_literal_value ($) {
79 ref $_[0] eq 'SCALAR' ? [ ${$_[0]} ]
80 : ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' ) ? [ @${ $_[0] } ]
81 : undef;
82}
83
84# FIXME XSify - this can be done so much more efficiently
85sub is_plain_value ($) {
86227µs
# spent 20µs (13+7) within SQL::Abstract::BEGIN@86 which was called: # once (13µs+7µs) by DBIx::Class::Row::BEGIN@12 at line 86
no strict 'refs';
# spent 20µs making 1 call to SQL::Abstract::BEGIN@86 # spent 7µs making 1 call to strict::unimport
87 ! length ref $_[0] ? \($_[0])
88 : (
89 ref $_[0] eq 'HASH' and keys %{$_[0]} == 1
90 and
91 exists $_[0]->{-value}
92 ) ? \($_[0]->{-value})
93 : (
94 # reuse @_ for even moar speedz
95 defined ( $_[1] = Scalar::Util::blessed $_[0] )
96 and
97 (
98
- -
101 # simply using ->can('(""') can leave behind stub methods that
102 # break actually using the overload later (see L<perldiag/Stub
103 # found while resolving method "%s" overloading "%s" in package
104 # "%s"> and the source of overload::mycan())
105 #
106 # either has stringification which DBI SHOULD prefer out of the box
107 grep { *{ (qq[${_}::(""]) }{CODE} } @{ $_[2] = mro::get_linear_isa( $_[1] ) }
108 or
109 (
110
111 SQL::Abstract::_ENV_::DETECT_AUTOGENERATED_STRINGIFICATION
112 and
113 (
114 grep { *{"${_}::(0+"}{CODE} } @{$_[2]}
115 or
116 grep { *{"${_}::(bool"}{CODE} } @{$_[2]}
117 )
118 and
119 (
120 # no fallback specified at all
121 ! ( ($_[3]) = grep { *{"${_}::()"}{CODE} } @{$_[2]} )
122 or
123 ! defined ${"$_[3]::()"}
124
125 or
126 !! ${"$_[3]::()"}
127
128 )
129 )
130 )
131 ) ? \($_[0])
132 : undef;
133}
134
- -
137#======================================================================
138# NEW
139#======================================================================
140
141
# spent 62µs (41+21) within SQL::Abstract::new which was called: # once (41µs+21µs) by DBIx::Class::Storage::DBI::sql_maker at line 1021 of DBIx/Class/Storage/DBI.pm
sub new {
142 my $self = shift;
143 my $class = ref($self) || $self;
144 my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
145
146 # choose our case by keeping an option around
147 delete $opt{case} if $opt{case} && $opt{case} ne 'lower';
148
149 # default logic for interpreting arrayrefs
150 $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR';
151
152 # how to return bind vars
153 $opt{bindtype} ||= 'normal';
154
155 # default comparison is "=", but can be overridden
156 $opt{cmp} ||= '=';
157
158 # try to recognize which are the 'equality' and 'inequality' ops
159 # (temporary quickfix (in 2007), should go through a more seasoned API)
160218µs $opt{equality_op} = qr/^( \Q$opt{cmp}\E | \= )$/ix;
# spent 17µs making 1 call to SQL::Abstract::CORE:regcomp # spent 1µs making 1 call to SQL::Abstract::CORE:qr
16111µs $opt{inequality_op} = qr/^( != | <> )$/ix;
# spent 1µs making 1 call to SQL::Abstract::CORE:qr
162
1631900ns $opt{like_op} = qr/^ (is\s+)? r?like $/xi;
# spent 900ns making 1 call to SQL::Abstract::CORE:qr
1641700ns $opt{not_like_op} = qr/^ (is\s+)? not \s+ r?like $/xi;
# spent 700ns making 1 call to SQL::Abstract::CORE:qr
165
166 # SQL booleans
167 $opt{sqltrue} ||= '1=1';
168 $opt{sqlfalse} ||= '0=1';
169
170 # special operators
171 $opt{special_ops} ||= [];
172 # regexes are applied in order, thus push after user-defines
173 push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
174
175 # unary operators
176 $opt{unary_ops} ||= [];
177 push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS;
178
179 # rudimentary sanity-check for user supplied bits treated as functions/operators
180 # If a purported function matches this regular expression, an exception is thrown.
181 # Literal SQL is *NOT* subject to this check, only functions (and column names
182 # when quoting is not in effect)
183
184 # FIXME
185 # need to guard against ()'s in column names too, but this will break tons of
186 # hacks... ideas anyone?
1871800ns $opt{injection_guard} ||= qr/
# spent 800ns making 1 call to SQL::Abstract::CORE:qr
188 \;
189 |
190 ^ \s* go \s
191 /xmi;
192
193 return bless \%opt, $class;
194}
195
196
197
# spent 34.7ms (24.1+10.5) within SQL::Abstract::_assert_pass_injection_guard which was called 3235 times, avg 11µs/call: # 2598 times (21.7ms+9.11ms) by DBIx::Class::SQLMaker::_quote at line 1381, avg 12µs/call # 319 times (1.25ms+692µs) by SQL::Abstract::_where_hashpair_HASHREF at line 871, avg 6µs/call # 318 times (1.16ms+719µs) by SQL::Abstract::_where_unary_op at line 657, avg 6µs/call
sub _assert_pass_injection_guard {
19884612.1ms647010.5ms if ($_[1] =~ $_[0]->{injection_guard}) {
# spent 6.73ms making 3235 calls to SQL::Abstract::CORE:match, avg 2µs/call # spent 3.79ms making 3235 calls to SQL::Abstract::CORE:regcomp, avg 1µs/call
199 my $class = ref $_[0];
200 puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
201 . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
202 . "{injection_guard} attribute to ${class}->new()"
203 }
204}
205
206
207#======================================================================
208# INSERT methods
209#======================================================================
210
211sub insert {
212 my $self = shift;
213 my $table = $self->_table(shift);
214 my $data = shift || return;
215 my $options = shift;
216
217 my $method = $self->_METHOD_FOR_refkind("_insert", $data);
218 my ($sql, @bind) = $self->$method($data);
219 $sql = join " ", $self->_sqlcase('insert into'), $table, $sql;
220
221 if ($options->{returning}) {
222 my ($s, @b) = $self->_insert_returning ($options);
223 $sql .= $s;
224 push @bind, @b;
225 }
226
227 return wantarray ? ($sql, @bind) : $sql;
228}
229
230sub _insert_returning {
231 my ($self, $options) = @_;
232
233 my $f = $options->{returning};
234
235 my $fieldlist = $self->_SWITCH_refkind($f, {
236 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
237 SCALAR => sub {$self->_quote($f)},
238 SCALARREF => sub {$$f},
239 });
240 return $self->_sqlcase(' returning ') . $fieldlist;
241}
242
243sub _insert_HASHREF { # explicit list of fields and then values
244 my ($self, $data) = @_;
245
246 my @fields = sort keys %$data;
247
248 my ($sql, @bind) = $self->_insert_values($data);
249
250 # assemble SQL
251 $_ = $self->_quote($_) foreach @fields;
252 $sql = "( ".join(", ", @fields).") ".$sql;
253
254 return ($sql, @bind);
255}
256
257sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields)
258 my ($self, $data) = @_;
259
260 # no names (arrayref) so can't generate bindtype
261 $self->{bindtype} ne 'columns'
262 or belch "can't do 'columns' bindtype when called with arrayref";
263
264 # fold the list of values into a hash of column name - value pairs
265 # (where the column names are artificially generated, and their
266 # lexicographical ordering keep the ordering of the original list)
267 my $i = "a"; # incremented values will be in lexicographical order
268 my $data_in_hash = { map { ($i++ => $_) } @$data };
269
270 return $self->_insert_values($data_in_hash);
271}
272
273sub _insert_ARRAYREFREF { # literal SQL with bind
274 my ($self, $data) = @_;
275
276 my ($sql, @bind) = @${$data};
277 $self->_assert_bindval_matches_bindtype(@bind);
278
279 return ($sql, @bind);
280}
281
282
283sub _insert_SCALARREF { # literal SQL without bind
284 my ($self, $data) = @_;
285
286 return ($$data);
287}
288
289sub _insert_values {
290 my ($self, $data) = @_;
291
292 my (@values, @all_bind);
293 foreach my $column (sort keys %$data) {
294 my $v = $data->{$column};
295
296 $self->_SWITCH_refkind($v, {
297
298 ARRAYREF => sub {
299 if ($self->{array_datatypes}) { # if array datatype are activated
300 push @values, '?';
301 push @all_bind, $self->_bindtype($column, $v);
302 }
303 else { # else literal SQL with bind
304 my ($sql, @bind) = @$v;
305 $self->_assert_bindval_matches_bindtype(@bind);
306 push @values, $sql;
307 push @all_bind, @bind;
308 }
309 },
310
311 ARRAYREFREF => sub { # literal SQL with bind
312 my ($sql, @bind) = @${$v};
313 $self->_assert_bindval_matches_bindtype(@bind);
314 push @values, $sql;
315 push @all_bind, @bind;
316 },
317
318 # THINK : anything useful to do with a HASHREF ?
319 HASHREF => sub { # (nothing, but old SQLA passed it through)
320 #TODO in SQLA >= 2.0 it will die instead
321 belch "HASH ref as bind value in insert is not supported";
322 push @values, '?';
323 push @all_bind, $self->_bindtype($column, $v);
324 },
325
326 SCALARREF => sub { # literal SQL without bind
327 push @values, $$v;
328 },
329
330 SCALAR_or_UNDEF => sub {
331 push @values, '?';
332 push @all_bind, $self->_bindtype($column, $v);
333 },
334
335 });
336
337 }
338
339 my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )";
340 return ($sql, @all_bind);
341}
342
- -
345#======================================================================
346# UPDATE methods
347#======================================================================
348
349
350sub update {
351 my $self = shift;
352 my $table = $self->_table(shift);
353 my $data = shift || return;
354 my $where = shift;
355
356 # first build the 'SET' part of the sql statement
357 my (@set, @all_bind);
358 puke "Unsupported data type specified to \$sql->update"
359 unless ref $data eq 'HASH';
360
361 for my $k (sort keys %$data) {
362 my $v = $data->{$k};
363 my $r = ref $v;
364 my $label = $self->_quote($k);
365
366 $self->_SWITCH_refkind($v, {
367 ARRAYREF => sub {
368 if ($self->{array_datatypes}) { # array datatype
369 push @set, "$label = ?";
370 push @all_bind, $self->_bindtype($k, $v);
371 }
372 else { # literal SQL with bind
373 my ($sql, @bind) = @$v;
374 $self->_assert_bindval_matches_bindtype(@bind);
375 push @set, "$label = $sql";
376 push @all_bind, @bind;
377 }
378 },
379 ARRAYREFREF => sub { # literal SQL with bind
380 my ($sql, @bind) = @${$v};
381 $self->_assert_bindval_matches_bindtype(@bind);
382 push @set, "$label = $sql";
383 push @all_bind, @bind;
384 },
385 SCALARREF => sub { # literal SQL without bind
386 push @set, "$label = $$v";
387 },
388 HASHREF => sub {
389 my ($op, $arg, @rest) = %$v;
390
391 puke 'Operator calls in update must be in the form { -op => $arg }'
392 if (@rest or not $op =~ /^\-(.+)/);
393
394 local $self->{_nested_func_lhs} = $k;
395 my ($sql, @bind) = $self->_where_unary_op ($1, $arg);
396
397 push @set, "$label = $sql";
398 push @all_bind, @bind;
399 },
400 SCALAR_or_UNDEF => sub {
401 push @set, "$label = ?";
402 push @all_bind, $self->_bindtype($k, $v);
403 },
404 });
405 }
406
407 # generate sql
408 my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ')
409 . join ', ', @set;
410
411 if ($where) {
412 my($where_sql, @where_bind) = $self->where($where);
413 $sql .= $where_sql;
414 push @all_bind, @where_bind;
415 }
416
417 return wantarray ? ($sql, @all_bind) : $sql;
418}
419
- -
423#======================================================================
424# SELECT
425#======================================================================
426
427
428sub select {
4298534µs my $self = shift;
43085218µs31725.9ms my $table = $self->_table(shift);
# spent 25.9ms making 317 calls to DBIx::Class::SQLMaker::_table, avg 82µs/call
4318546µs my $fields = shift || '*';
4328523µs my $where = shift;
4338516µs my $order = shift;
434
43585283µs317175ms my($where_sql, @bind) = $self->where($where, $order);
# spent 175ms making 317 calls to SQL::Abstract::where, avg 553µs/call
436
4378553µs my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields
438 : $fields;
43985301µs634755µs my $sql = join(' ', $self->_sqlcase('select'), $f,
# spent 755µs making 634 calls to SQL::Abstract::_sqlcase, avg 1µs/call
440 $self->_sqlcase('from'), $table)
441 . $where_sql;
442
44385107µs return wantarray ? ($sql, @bind) : $sql;
444}
445
446#======================================================================
447# DELETE
448#======================================================================
449
450
451sub delete {
452 my $self = shift;
453 my $table = $self->_table(shift);
454 my $where = shift;
455
456
457 my($where_sql, @bind) = $self->where($where);
458 my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql;
459
460 return wantarray ? ($sql, @bind) : $sql;
461}
462
463
464#======================================================================
465# WHERE: entry point
466#======================================================================
467
- -
470# Finally, a separate routine just to handle WHERE clauses
471
# spent 175ms (4.33+171) within SQL::Abstract::where which was called 317 times, avg 553µs/call: # 317 times (4.33ms+171ms) by DBIx::Class::SQLMaker::select at line 435, avg 553µs/call
sub where {
4728545µs my ($self, $where, $order) = @_;
473
474 # where ?
47585187µs317157ms my ($sql, @bind) = $self->_recurse_where($where);
# spent 157ms making 317 calls to SQL::Abstract::_recurse_where, avg 496µs/call
47685216µs317449µs $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : '';
# spent 449µs making 317 calls to SQL::Abstract::_sqlcase, avg 1µs/call
477
478 # order by?
47985233µs31613.3ms if ($order) {
# spent 13.3ms making 316 calls to DBIx::Class::SQLMaker::_order_by, avg 42µs/call
480 $sql .= $self->_order_by($order);
481 }
482
48385244µs return wantarray ? ($sql, @bind) : $sql;
484}
485
486
487
# spent 157ms (3.01+154) within SQL::Abstract::_recurse_where which was called 321 times, avg 489µs/call: # 317 times (2.98ms+154ms) by SQL::Abstract::where at line 475, avg 496µs/call # 4 times (29µs+-29µs) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:547] at line 546, avg 0s/call
sub _recurse_where {
4888542µs my ($self, $where, $logic) = @_;
489
490 # dispatch on appropriate method according to refkind of $where
49185222µs3219.54ms my $method = $self->_METHOD_FOR_refkind("_where", $where);
# spent 9.54ms making 321 calls to SQL::Abstract::_METHOD_FOR_refkind, avg 30µs/call
492
49385266µs321145ms my ($sql, @bind) = $self->$method($where, $logic);
# spent 146ms making 321 calls to SQL::Abstract::_where_HASHREF, avg 456µs/call, recursion: max depth 2, sum of overlapping time 1.74ms
494
495 # DBIx::Class used to call _recurse_where in scalar context
496 # something else might too...
49785229µs if (wantarray) {
498 return ($sql, @bind);
499 }
500 else {
501 belch "Calling _recurse_where in scalar context is deprecated and will go away before 2.0";
502 return $sql;
503 }
504}
505
- -
508#======================================================================
509# WHERE: top-level ARRAYREF
510#======================================================================
511
512
513
# spent 1.14ms (101µs+1.04) within SQL::Abstract::_where_ARRAYREF which was called 2 times, avg 569µs/call: # 2 times (101µs+1.04ms) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:688] at line 687, avg 569µs/call
sub _where_ARRAYREF {
514 my ($self, $where, $logic) = @_;
515
516 $logic = uc($logic || $self->{logic});
517 $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic";
518
519 my @clauses = @$where;
520
521 my (@sql_clauses, @all_bind);
522 # need to use while() so can shift() for pairs
523 while (@clauses) {
524 my $el = shift @clauses;
525
526 $el = undef if (defined $el and ! length $el);
527
528 # switch according to kind of $el and get corresponding ($sql, @bind)
529 my ($sql, @bind) = $self->_SWITCH_refkind($el, {
530
531 # skip empty elements, otherwise get invalid trailing AND stuff
532 ARRAYREF => sub {$self->_recurse_where($el) if @$el},
533
534 ARRAYREFREF => sub {
535 my ($s, @b) = @$$el;
536 $self->_assert_bindval_matches_bindtype(@b);
537 ($s, @b);
538 },
539
540 HASHREF => sub {$self->_recurse_where($el, 'and') if %$el},
541
542 SCALARREF => sub { ($$el); },
543
544
# spent 1.84ms (18µs+1.82) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:547] which was called 4 times, avg 461µs/call: # 4 times (18µs+1.82ms) by SQL::Abstract::_SWITCH_refkind at line 1521, avg 461µs/call
SCALAR => sub {
545 # top-level arrayref with scalars, recurse in pairs
54640s $self->_recurse_where({$el => shift(@clauses)})
# spent 1.82ms making 4 calls to SQL::Abstract::_recurse_where, avg 456µs/call, recursion: max depth 2, sum of overlapping time 1.82ms
547 },
548
549 UNDEF => sub {puke "Supplying an empty left hand side argument is not supported in array-pairs" },
55040s });
# spent 1.90ms making 4 calls to SQL::Abstract::_SWITCH_refkind, avg 475µs/call, recursion: max depth 3, sum of overlapping time 1.90ms
551
552 if ($sql) {
553 push @sql_clauses, $sql;
554 push @all_bind, @bind;
555 }
556 }
557
558211µs return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind);
# spent 11µs making 2 calls to SQL::Abstract::_join_sql_clauses, avg 6µs/call
559}
560
561#======================================================================
562# WHERE: top-level ARRAYREFREF
563#======================================================================
564
565sub _where_ARRAYREFREF {
566 my ($self, $where) = @_;
567 my ($sql, @bind) = @$$where;
568 $self->_assert_bindval_matches_bindtype(@bind);
569 return ($sql, @bind);
570}
571
572#======================================================================
573# WHERE: top-level HASHREF
574#======================================================================
575
576
# spent 145ms (7.03+138) within SQL::Abstract::_where_HASHREF which was called 321 times, avg 451µs/call: # 321 times (7.03ms+138ms) by SQL::Abstract::_recurse_where at line 493, avg 451µs/call
sub _where_HASHREF {
5778554µs my ($self, $where) = @_;
5788536µs my (@sql_clauses, @all_bind);
579
58085425µs321259µs for my $k (sort keys %$where) {
# spent 259µs making 321 calls to SQL::Abstract::CORE:sort, avg 807ns/call
5818654µs my $v = $where->{$k};
582
583 # ($k => $v) is either a special unary op or a regular hashpair
58486101µs my ($sql, @bind) = do {
58586225µs322277µs if ($k =~ /^-./) {
# spent 277µs making 322 calls to SQL::Abstract::CORE:match, avg 861ns/call
586 # put the operator in canonical form
587 my $op = $k;
588 $op = substr $op, 1; # remove initial dash
58924µs $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
# spent 4µs making 2 calls to SQL::Abstract::CORE:subst, avg 2µs/call
5902900ns $op =~ s/\s+/ /g; # compress whitespace
# spent 900ns making 2 calls to SQL::Abstract::CORE:subst, avg 450ns/call
591
592 # so that -not_foo works correctly
5932300ns $op =~ s/^not_/NOT /i;
# spent 300ns making 2 calls to SQL::Abstract::CORE:subst, avg 150ns/call
594
59525µs $self->_debug("Unary OP(-$op) within hashref, recursing...");
# spent 5µs making 2 calls to SQL::Abstract::_debug, avg 2µs/call
59621.29ms my ($s, @b) = $self->_where_unary_op ($op, $v);
# spent 2.26ms making 2 calls to SQL::Abstract::_where_unary_op, avg 1.13ms/call, recursion: max depth 1, sum of overlapping time 976µs
597
598 # top level vs nested
599 # we assume that handled unary ops will take care of their ()s
60068µs $s = "($s)" unless (
# spent 5µs making 3 calls to SQL::Abstract::CORE:match, avg 2µs/call # spent 3µs making 3 calls to SQL::Abstract::CORE:regcomp, avg 1µs/call
601222µs List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}
# spent 22µs making 2 calls to List::Util::first, avg 11µs/call
602 or
603 ( defined $self->{_nested_func_lhs} and $self->{_nested_func_lhs} eq $k )
604 );
605 ($s, @b);
606 }
607 else {
6088662µs if (! length $k) {
609 if (is_literal_value ($v) ) {
610 belch 'Hash-pairs consisting of an empty string with a literal are deprecated, and will be removed in 2.0: use -and => [ $literal ] instead';
611 }
612 else {
613 puke "Supplying an empty left hand side argument is not supported in hash-pairs";
614 }
615 }
616
61786123µs3204.77ms my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v);
# spent 4.77ms making 320 calls to SQL::Abstract::_METHOD_FOR_refkind, avg 15µs/call
61886216µs320130ms $self->$method($k, $v);
# spent 130ms making 319 calls to SQL::Abstract::_where_hashpair_HASHREF, avg 409µs/call # spent 36µs making 1 call to SQL::Abstract::_where_hashpair_UNDEF
619 }
620 };
621
6228637µs push @sql_clauses, $sql;
62386100µs push @all_bind, @bind;
624 }
625
62685459µs3211.27ms return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind);
# spent 1.27ms making 321 calls to SQL::Abstract::_join_sql_clauses, avg 4µs/call
627}
628
629
# spent 71.1ms (12.0+59.1) within SQL::Abstract::_where_unary_op which was called 320 times, avg 222µs/call: # 318 times (11.9ms+57.9ms) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:941] at line 935, avg 219µs/call # 2 times (67µs+1.22ms) by SQL::Abstract::_where_HASHREF at line 596, avg 643µs/call
sub _where_unary_op {
6308449µs my ($self, $op, $rhs) = @_;
631
632 # top level special ops are illegal in general
633 # this includes the -ident/-value ops (dual purpose unary and special)
6342016µs puke "Illegal use of top-level '-$op'"
# spent 9µs making 10 calls to SQL::Abstract::CORE:regcomp, avg 890ns/call # spent 7µs making 10 calls to SQL::Abstract::CORE:match, avg 720ns/call
6358457µs251µs if ! defined $self->{_nested_func_lhs} and List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}};
# spent 51µs making 2 calls to List::Util::first, avg 25µs/call
636
6375882.47ms414237.3ms if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) {
# spent 35.1ms making 320 calls to List::Util::first, avg 110µs/call # spent 1.87ms making 1911 calls to SQL::Abstract::CORE:regcomp, avg 981ns/call # spent 290µs making 1911 calls to SQL::Abstract::CORE:match, avg 152ns/call
638 my $handler = $op_entry->{handler};
639
640 if (not ref $handler) {
64125µs if ($op =~ s/ [_\s]? \d+ $//x ) {
# spent 5µs making 2 calls to SQL::Abstract::CORE:subst, avg 3µs/call
642 belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
643 . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]";
644 }
64521.20ms return $self->$handler ($op, $rhs);
# spent 2.12ms making 2 calls to SQL::Abstract::_where_op_ANDOR, avg 1.06ms/call, recursion: max depth 1, sum of overlapping time 925µs
646 }
647 elsif (ref $handler eq 'CODE') {
648 return $handler->($self, $op, $rhs);
649 }
650 else {
651 puke "Illegal handler for operator $op - expecting a method name or a coderef";
652 }
653 }
654
65584274µs318848µs $self->_debug("Generic unary OP: $op - recursing as function");
# spent 848µs making 318 calls to SQL::Abstract::_debug, avg 3µs/call
656
6578495µs3181.88ms $self->_assert_pass_injection_guard($op);
# spent 1.88ms making 318 calls to SQL::Abstract::_assert_pass_injection_guard, avg 6µs/call
658
659 my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, {
660
# spent 5.02ms (2.54+2.48) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:668] which was called 318 times, avg 16µs/call: # 318 times (2.54ms+2.48ms) by SQL::Abstract::_SWITCH_refkind at line 1521, avg 16µs/call
SCALAR => sub {
6618453µs puke "Illegal use of top-level '-$op'"
662 unless defined $self->{_nested_func_lhs};
663
664 return (
66584501µs6362.48ms $self->_convert('?'),
# spent 1.65ms making 318 calls to SQL::Abstract::_bindtype, avg 5µs/call # spent 834µs making 318 calls to SQL::Abstract::_convert, avg 3µs/call
666 $self->_bindtype($self->{_nested_func_lhs}, $rhs)
667 );
668 },
669 FALLBACK => sub {
670 $self->_recurse_where ($rhs)
671 },
67284985µs3180s });
# spent 19.4ms making 318 calls to SQL::Abstract::_SWITCH_refkind, avg 61µs/call, recursion: max depth 5, sum of overlapping time 19.4ms
673
67484458µs318963µs $sql = sprintf ('%s %s',
# spent 963µs making 318 calls to SQL::Abstract::_sqlcase, avg 3µs/call
675 $self->_sqlcase($op),
676 $sql,
677 );
678
67984268µs return ($sql, @bind);
680}
681
682
# spent 1.20ms (53µs+1.14) within SQL::Abstract::_where_op_ANDOR which was called 2 times, avg 598µs/call: # 2 times (53µs+1.14ms) by SQL::Abstract::_where_unary_op at line 645, avg 598µs/call
sub _where_op_ANDOR {
683 my ($self, $op, $v) = @_;
684
685 $self->_SWITCH_refkind($v, {
686
# spent 2.03ms (15µs+2.01) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:688] which was called 2 times, avg 1.01ms/call: # 2 times (15µs+2.01ms) by SQL::Abstract::_SWITCH_refkind at line 1521, avg 1.01ms/call
ARRAYREF => sub {
68721.14ms return $self->_where_ARRAYREF($v, $op);
# spent 2.01ms making 2 calls to SQL::Abstract::_where_ARRAYREF, avg 1.01ms/call, recursion: max depth 1, sum of overlapping time 875µs
688 },
689
690 HASHREF => sub {
691 return ( $op =~ /^or/i )
692 ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op )
693 : $self->_where_HASHREF($v);
694 },
695
696 SCALARREF => sub {
697 puke "-$op => \\\$scalar makes little sense, use " .
698 ($op =~ /^or/i
699 ? '[ \$scalar, \%rest_of_conditions ] instead'
700 : '-and => [ \$scalar, \%rest_of_conditions ] instead'
701 );
702 },
703
704 ARRAYREFREF => sub {
705 puke "-$op => \\[...] makes little sense, use " .
706 ($op =~ /^or/i
707 ? '[ \[...], \%rest_of_conditions ] instead'
708 : '-and => [ \[...], \%rest_of_conditions ] instead'
709 );
710 },
711
712 SCALAR => sub { # permissively interpreted as SQL
713 puke "-$op => \$value makes little sense, use -bool => \$value instead";
714 },
715
716 UNDEF => sub {
717 puke "-$op => undef not supported";
718 },
71921.17ms });
# spent 2.07ms making 2 calls to SQL::Abstract::_SWITCH_refkind, avg 1.03ms/call, recursion: max depth 2, sum of overlapping time 903µs
720}
721
722sub _where_op_NEST {
723 my ($self, $op, $v) = @_;
724
725 $self->_SWITCH_refkind($v, {
726
727 SCALAR => sub { # permissively interpreted as SQL
728 belch "literal SQL should be -nest => \\'scalar' "
729 . "instead of -nest => 'scalar' ";
730 return ($v);
731 },
732
733 UNDEF => sub {
734 puke "-$op => undef not supported";
735 },
736
737 FALLBACK => sub {
738 $self->_recurse_where ($v);
739 },
740
741 });
742}
743
744
745sub _where_op_BOOL {
746 my ($self, $op, $v) = @_;
747
748 my ($s, @b) = $self->_SWITCH_refkind($v, {
749 SCALAR => sub { # interpreted as SQL column
750 $self->_convert($self->_quote($v));
751 },
752
753 UNDEF => sub {
754 puke "-$op => undef not supported";
755 },
756
757 FALLBACK => sub {
758 $self->_recurse_where ($v);
759 },
760 });
761
762 $s = "(NOT $s)" if $op =~ /^not/i;
763 ($s, @b);
764}
765
766
767sub _where_op_IDENT {
768 my $self = shift;
769 my ($op, $rhs) = splice @_, -2;
770 if (! defined $rhs or length ref $rhs) {
771 puke "-$op requires a single plain scalar argument (a quotable identifier)";
772 }
773
774 # in case we are called as a top level special op (no '=')
775 my $lhs = shift;
776
777 $_ = $self->_convert($self->_quote($_)) for ($lhs, $rhs);
778
779 return $lhs
780 ? "$lhs = $rhs"
781 : $rhs
782 ;
783}
784
785sub _where_op_VALUE {
786 my $self = shift;
787 my ($op, $rhs) = splice @_, -2;
788
789 # in case we are called as a top level special op (no '=')
790 my $lhs = shift;
791
792 # special-case NULL
793 if (! defined $rhs) {
794 return defined $lhs
795 ? $self->_convert($self->_quote($lhs)) . ' IS NULL'
796 : undef
797 ;
798 }
799
800 my @bind =
801 $self->_bindtype (
802 ( defined $lhs ? $lhs : $self->{_nested_func_lhs} ),
803 $rhs,
804 )
805 ;
806
807 return $lhs
808 ? (
809 $self->_convert($self->_quote($lhs)) . ' = ' . $self->_convert('?'),
810 @bind
811 )
812 : (
813 $self->_convert('?'),
814 @bind,
815 )
816 ;
817}
818
819sub _where_hashpair_ARRAYREF {
820 my ($self, $k, $v) = @_;
821
822 if( @$v ) {
823 my @v = @$v; # need copy because of shift below
824 $self->_debug("ARRAY($k) means distribute over elements");
825
826 # put apart first element if it is an operator (-and, -or)
827 my $op = (
828 (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix)
829 ? shift @v
830 : ''
831 );
832 my @distributed = map { {$k => $_} } @v;
833
834 if ($op) {
835 $self->_debug("OP($op) reinjected into the distributed array");
836 unshift @distributed, $op;
837 }
838
839 my $logic = $op ? substr($op, 1) : '';
840
841 return $self->_recurse_where(\@distributed, $logic);
842 }
843 else {
844 $self->_debug("empty ARRAY($k) means 0=1");
845 return ($self->{sqlfalse});
846 }
847}
848
849
# spent 130ms (20.6+110) within SQL::Abstract::_where_hashpair_HASHREF which was called 319 times, avg 409µs/call: # 319 times (20.6ms+110ms) by SQL::Abstract::_where_HASHREF at line 618, avg 409µs/call
sub _where_hashpair_HASHREF {
8508544µs my ($self, $k, $v, $logic) = @_;
8518549µs $logic ||= 'and';
852
85385208µs local $self->{_nested_func_lhs} = defined $self->{_nested_func_lhs}
854 ? $self->{_nested_func_lhs}
855 : $k
856 ;
857
8588519µs my ($all_sql, @all_bind);
859
86085284µs31996µs for my $orig_op (sort keys %$v) {
# spent 96µs making 319 calls to SQL::Abstract::CORE:sort, avg 301ns/call
8618543µs my $val = $v->{$orig_op};
862
863 # put the operator in canonical form
8648517µs my $op = $orig_op;
865
866 # FIXME - we need to phase out dash-less ops
86785254µs319290µs $op =~ s/^-//; # remove possible initial dash
# spent 290µs making 319 calls to SQL::Abstract::CORE:subst, avg 910ns/call
86885249µs319502µs $op =~ s/^\s+|\s+$//g;# remove leading/trailing space
# spent 502µs making 319 calls to SQL::Abstract::CORE:subst, avg 2µs/call
86985206µs319365µs $op =~ s/\s+/ /g; # compress whitespace
# spent 365µs making 319 calls to SQL::Abstract::CORE:subst, avg 1µs/call
870
87185129µs3191.94ms $self->_assert_pass_injection_guard($op);
# spent 1.94ms making 319 calls to SQL::Abstract::_assert_pass_injection_guard, avg 6µs/call
872
873 # fixup is_not
87485159µs31998µs $op =~ s/^is_not/IS NOT/i;
# spent 98µs making 319 calls to SQL::Abstract::CORE:subst, avg 306ns/call
875
876 # so that -not_foo works correctly
87785120µs31960µs $op =~ s/^not_/NOT /i;
# spent 60µs making 319 calls to SQL::Abstract::CORE:subst, avg 187ns/call
878
879 # another retarded special case: foo => { $op => { -value => undef } }
8808544µs if (ref $val eq 'HASH' and keys %$val == 1 and exists $val->{-value} and ! defined $val->{-value} ) {
881 $val = undef;
882 }
883
8848516µs my ($sql, @bind);
885
886 # CASE: col-value logic modifiers
8875103.84ms382811.5ms if ( $orig_op =~ /^ \- (and|or) $/xi ) {
# spent 9.31ms making 319 calls to List::Util::first, avg 29µs/call # spent 1.77ms making 1595 calls to SQL::Abstract::CORE:regcomp, avg 1µs/call # spent 400µs making 1914 calls to SQL::Abstract::CORE:match, avg 209ns/call
888 ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1);
889 }
890 # CASE: special operators like -in or -between
891 elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) {
892 my $handler = $special_op->{handler};
893 if (! $handler) {
894 puke "No handler supplied for special operator $orig_op";
895 }
896 elsif (not ref $handler) {
897 ($sql, @bind) = $self->$handler ($k, $op, $val);
898 }
899 elsif (ref $handler eq 'CODE') {
900 ($sql, @bind) = $handler->($self, $k, $op, $val);
901 }
902 else {
903 puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef";
904 }
905 }
906 else {
907 $self->_SWITCH_refkind($val, {
908
909 ARRAYREF => sub { # CASE: col => {op => \@vals}
910 ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val);
911 },
912
913 ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind)
914 my ($sub_sql, @sub_bind) = @$$val;
915 $self->_assert_bindval_matches_bindtype(@sub_bind);
916 $sql = join ' ', $self->_convert($self->_quote($k)),
917 $self->_sqlcase($op),
918 $sub_sql;
919 @bind = @sub_bind;
920 },
921
922
# spent 55µs (24+31) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:932] which was called: # once (24µs+31µs) by SQL::Abstract::_SWITCH_refkind at line 1521
UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL"
923128µs712µs my $is =
# spent 9µs making 3 calls to SQL::Abstract::CORE:regcomp, avg 3µs/call # spent 3µs making 4 calls to SQL::Abstract::CORE:match, avg 825ns/call
924 $op =~ /^not$/i ? 'is not' # legacy
925 : $op =~ $self->{equality_op} ? 'is'
926 : $op =~ $self->{like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is'
927 : $op =~ $self->{inequality_op} ? 'is not'
928 : $op =~ $self->{not_like_op} ? belch("Supplying an undefined argument to '@{[ uc $op]}' is deprecated") && 'is not'
929 : puke "unexpected operator '$orig_op' with undef operand";
930
93118µs219µs $sql = $self->_quote($k) . $self->_sqlcase(" $is null");
# spent 17µs making 1 call to DBIx::Class::SQLMaker::_quote # spent 2µs making 1 call to SQL::Abstract::_sqlcase
932 },
933
934
# spent 91.0ms (8.12+82.9) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:941] which was called 318 times, avg 286µs/call: # 318 times (8.12ms+82.9ms) by SQL::Abstract::_SWITCH_refkind at line 1521, avg 286µs/call
FALLBACK => sub { # CASE: col => {op/func => $stuff}
93584297µs31869.8ms ($sql, @bind) = $self->_where_unary_op ($op, $val);
# spent 70.0ms making 318 calls to SQL::Abstract::_where_unary_op, avg 220µs/call, recursion: max depth 2, sum of overlapping time 240µs
936
93784490µs63612.9ms $sql = join (' ',
# spent 12.4ms making 318 calls to DBIx::Class::SQLMaker::_quote, avg 39µs/call # spent 493µs making 318 calls to SQL::Abstract::_convert, avg 2µs/call
938 $self->_convert($self->_quote($k)),
939 $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested
940 );
941 },
942851.41ms31996.7ms });
# spent 97.1ms making 319 calls to SQL::Abstract::_SWITCH_refkind, avg 304µs/call, recursion: max depth 4, sum of overlapping time 367µs
943 }
944
9458585µs ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql;
94685171µs push @all_bind, @bind;
947 }
94885305µs return ($all_sql, @all_bind);
949}
950
951sub _where_field_IS {
952 my ($self, $k, $op, $v) = @_;
953
954 my ($s) = $self->_SWITCH_refkind($v, {
955 UNDEF => sub {
956 join ' ',
957 $self->_convert($self->_quote($k)),
958 map { $self->_sqlcase($_)} ($op, 'null')
959 },
960 FALLBACK => sub {
961 puke "$op can only take undef as argument";
962 },
963 });
964
965 $s;
966}
967
968sub _where_field_op_ARRAYREF {
969 my ($self, $k, $op, $vals) = @_;
970
971 my @vals = @$vals; #always work on a copy
972
973 if(@vals) {
974 $self->_debug(sprintf '%s means multiple elements: [ %s ]',
975 $vals,
976 join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ),
977 );
978
979 # see if the first element is an -and/-or op
980 my $logic;
981 if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) {
982 $logic = uc $1;
983 shift @vals;
984 }
985
986 # a long standing API wart - an attempt to change this behavior during
987 # the 1.50 series failed *spectacularly*. Warn instead and leave the
988 # behavior as is
989 if (
990 @vals > 1
991 and
992 (!$logic or $logic eq 'OR')
993 and
994 ( $op =~ $self->{inequality_op} or $op =~ $self->{not_like_op} )
995 ) {
996 my $o = uc($op);
997 belch "A multi-element arrayref as an argument to the inequality op '$o' "
998 . 'is technically equivalent to an always-true 1=1 (you probably wanted '
999 . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
1000 ;
1001 }
1002
1003 # distribute $op over each remaining member of @vals, append logic if exists
1004 return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
1005
1006 }
1007 else {
1008 # try to DWIM on equality operators
1009 return
1010 $op =~ $self->{equality_op} ? $self->{sqlfalse}
1011 : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
1012 : $op =~ $self->{inequality_op} ? $self->{sqltrue}
1013 : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
1014 : puke "operator '$op' applied on an empty array (field '$k')";
1015 }
1016}
1017
1018
1019sub _where_hashpair_SCALARREF {
1020 my ($self, $k, $v) = @_;
1021 $self->_debug("SCALAR($k) means literal SQL: $$v");
1022 my $sql = $self->_quote($k) . " " . $$v;
1023 return ($sql);
1024}
1025
1026# literal SQL with bind
1027sub _where_hashpair_ARRAYREFREF {
1028 my ($self, $k, $v) = @_;
1029 $self->_debug("REF($k) means literal SQL: @${$v}");
1030 my ($sql, @bind) = @$$v;
1031 $self->_assert_bindval_matches_bindtype(@bind);
1032 $sql = $self->_quote($k) . " " . $sql;
1033 return ($sql, @bind );
1034}
1035
1036# literal SQL without bind
1037sub _where_hashpair_SCALAR {
1038 my ($self, $k, $v) = @_;
1039 $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v");
1040 my $sql = join ' ', $self->_convert($self->_quote($k)),
1041 $self->_sqlcase($self->{cmp}),
1042 $self->_convert('?');
1043 my @bind = $self->_bindtype($k, $v);
1044 return ( $sql, @bind);
1045}
1046
1047
1048
# spent 36µs (16+20) within SQL::Abstract::_where_hashpair_UNDEF which was called: # once (16µs+20µs) by SQL::Abstract::_where_HASHREF at line 618
sub _where_hashpair_UNDEF {
10491600ns my ($self, $k, $v) = @_;
105013µs12µs $self->_debug("UNDEF($k) means IS NULL");
# spent 2µs making 1 call to SQL::Abstract::_debug
105113µs218µs my $sql = $self->_quote($k) . $self->_sqlcase(' is null');
# spent 17µs making 1 call to DBIx::Class::SQLMaker::_quote # spent 2µs making 1 call to SQL::Abstract::_sqlcase
105214µs return ($sql);
1053}
1054
1055#======================================================================
1056# WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF)
1057#======================================================================
1058
1059
1060sub _where_SCALARREF {
1061 my ($self, $where) = @_;
1062
1063 # literal sql
1064 $self->_debug("SCALAR(*top) means literal SQL: $$where");
1065 return ($$where);
1066}
1067
1068
1069sub _where_SCALAR {
1070 my ($self, $where) = @_;
1071
1072 # literal sql
1073 $self->_debug("NOREF(*top) means literal SQL: $where");
1074 return ($where);
1075}
1076
1077
1078sub _where_UNDEF {
1079 my ($self) = @_;
1080 return ();
1081}
1082
1083
1084#======================================================================
1085# WHERE: BUILTIN SPECIAL OPERATORS (-in, -between)
1086#======================================================================
1087
1088
1089sub _where_field_BETWEEN {
1090 my ($self, $k, $op, $vals) = @_;
1091
1092 my ($label, $and, $placeholder);
1093 $label = $self->_convert($self->_quote($k));
1094 $and = ' ' . $self->_sqlcase('and') . ' ';
1095 $placeholder = $self->_convert('?');
1096 $op = $self->_sqlcase($op);
1097
1098 my $invalid_args = "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref";
1099
1100 my ($clause, @bind) = $self->_SWITCH_refkind($vals, {
1101 ARRAYREFREF => sub {
1102 my ($s, @b) = @$$vals;
1103 $self->_assert_bindval_matches_bindtype(@b);
1104 ($s, @b);
1105 },
1106 SCALARREF => sub {
1107 return $$vals;
1108 },
1109 ARRAYREF => sub {
1110 puke $invalid_args if @$vals != 2;
1111
1112 my (@all_sql, @all_bind);
1113 foreach my $val (@$vals) {
1114 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1115 SCALAR => sub {
1116 return ($placeholder, $self->_bindtype($k, $val) );
1117 },
1118 SCALARREF => sub {
1119 return $$val;
1120 },
1121 ARRAYREFREF => sub {
1122 my ($sql, @bind) = @$$val;
1123 $self->_assert_bindval_matches_bindtype(@bind);
1124 return ($sql, @bind);
1125 },
1126 HASHREF => sub {
1127 my ($func, $arg, @rest) = %$val;
1128 puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN")
1129 if (@rest or $func !~ /^ \- (.+)/x);
1130 $self->_where_unary_op ($1 => $arg);
1131 },
1132 FALLBACK => sub {
1133 puke $invalid_args,
1134 },
1135 });
1136 push @all_sql, $sql;
1137 push @all_bind, @bind;
1138 }
1139
1140 return (
1141 (join $and, @all_sql),
1142 @all_bind
1143 );
1144 },
1145 FALLBACK => sub {
1146 puke $invalid_args,
1147 },
1148 });
1149
1150 my $sql = "( $label $op $clause )";
1151 return ($sql, @bind)
1152}
1153
1154
1155sub _where_field_IN {
1156 my ($self, $k, $op, $vals) = @_;
1157
1158 # backwards compatibility : if scalar, force into an arrayref
1159 $vals = [$vals] if defined $vals && ! ref $vals;
1160
1161 my ($label) = $self->_convert($self->_quote($k));
1162 my ($placeholder) = $self->_convert('?');
1163 $op = $self->_sqlcase($op);
1164
1165 my ($sql, @bind) = $self->_SWITCH_refkind($vals, {
1166 ARRAYREF => sub { # list of choices
1167 if (@$vals) { # nonempty list
1168 my (@all_sql, @all_bind);
1169
1170 for my $val (@$vals) {
1171 my ($sql, @bind) = $self->_SWITCH_refkind($val, {
1172 SCALAR => sub {
1173 return ($placeholder, $val);
1174 },
1175 SCALARREF => sub {
1176 return $$val;
1177 },
1178 ARRAYREFREF => sub {
1179 my ($sql, @bind) = @$$val;
1180 $self->_assert_bindval_matches_bindtype(@bind);
1181 return ($sql, @bind);
1182 },
1183 HASHREF => sub {
1184 my ($func, $arg, @rest) = %$val;
1185 puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN")
1186 if (@rest or $func !~ /^ \- (.+)/x);
1187 $self->_where_unary_op ($1 => $arg);
1188 },
1189 UNDEF => sub {
1190 puke(
1191 'SQL::Abstract before v1.75 used to generate incorrect SQL when the '
1192 . "-$op operator was given an undef-containing list: !!!AUDIT YOUR CODE "
1193 . 'AND DATA!!! (the upcoming Data::Query-based version of SQL::Abstract '
1194 . 'will emit the logically correct SQL instead of raising this exception)'
1195 );
1196 },
1197 });
1198 push @all_sql, $sql;
1199 push @all_bind, @bind;
1200 }
1201
1202 return (
1203 sprintf ('%s %s ( %s )',
1204 $label,
1205 $op,
1206 join (', ', @all_sql)
1207 ),
1208 $self->_bindtype($k, @all_bind),
1209 );
1210 }
1211 else { # empty list : some databases won't understand "IN ()", so DWIM
1212 my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse};
1213 return ($sql);
1214 }
1215 },
1216
1217 SCALARREF => sub { # literal SQL
1218 my $sql = $self->_open_outer_paren ($$vals);
1219 return ("$label $op ( $sql )");
1220 },
1221 ARRAYREFREF => sub { # literal SQL with bind
1222 my ($sql, @bind) = @$$vals;
1223 $self->_assert_bindval_matches_bindtype(@bind);
1224 $sql = $self->_open_outer_paren ($sql);
1225 return ("$label $op ( $sql )", @bind);
1226 },
1227
1228 UNDEF => sub {
1229 puke "Argument passed to the '$op' operator can not be undefined";
1230 },
1231
1232 FALLBACK => sub {
1233 puke "special op $op requires an arrayref (or scalarref/arrayref-ref)";
1234 },
1235 });
1236
1237 return ($sql, @bind);
1238}
1239
1240# Some databases (SQLite) treat col IN (1, 2) different from
1241# col IN ( (1, 2) ). Use this to strip all outer parens while
1242# adding them back in the corresponding method
1243sub _open_outer_paren {
1244 my ($self, $sql) = @_;
1245
1246 while ( my ($inner) = $sql =~ /^ \s* \( (.*) \) \s* $/xs ) {
1247
1248 # there are closing parens inside, need the heavy duty machinery
1249 # to reevaluate the extraction starting from $sql (full reevaluation)
1250 if ( $inner =~ /\)/ ) {
1251 require Text::Balanced;
1252
1253 my (undef, $remainder) = do {
1254 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
1255 local $@;
1256 Text::Balanced::extract_bracketed( $sql, '()', qr/\s*/ );
1257 };
1258
1259 # the entire expression needs to be a balanced bracketed thing
1260 # (after an extract no remainder sans trailing space)
1261 last if defined $remainder and $remainder =~ /\S/;
1262 }
1263
1264 $sql = $inner;
1265 }
1266
1267 $sql;
1268}
1269
1270
1271#======================================================================
1272# ORDER BY
1273#======================================================================
1274
1275sub _order_by {
1276 my ($self, $arg) = @_;
1277
1278 my (@sql, @bind);
12791157µs for my $c ($self->_order_by_chunks ($arg) ) {
# spent 157µs making 1 call to SQL::Abstract::_order_by_chunks
1280 $self->_SWITCH_refkind ($c, {
1281
# spent 4µs within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:1281] which was called 2 times, avg 2µs/call: # 2 times (4µs+0s) by SQL::Abstract::_SWITCH_refkind at line 1521, avg 2µs/call
SCALAR => sub { push @sql, $c },
1282 ARRAYREF => sub { push @sql, shift @$c; push @bind, @$c },
1283249µs });
# spent 49µs making 2 calls to SQL::Abstract::_SWITCH_refkind, avg 25µs/call
1284 }
1285
128612µs my $sql = @sql
# spent 2µs making 1 call to SQL::Abstract::_sqlcase
1287 ? sprintf ('%s %s',
1288 $self->_sqlcase(' order by'),
1289 join (', ', @sql)
1290 )
1291 : ''
1292 ;
1293
1294 return wantarray ? ($sql, @bind) : $sql;
1295}
1296
1297
# spent 216µs (78+138) within SQL::Abstract::_order_by_chunks which was called 4 times, avg 54µs/call: # 2 times (23µs+-23µs) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:1304] at line 1303, avg 0s/call # once (24µs+134µs) by DBIx::Class::SQLMaker::_order_by at line 1279 # once (32µs+26µs) by DBIx::Class::Storage::DBIHacks::__ANON__[/usr/share/perl5/DBIx/Class/Storage/DBIHacks.pm:869] at line 856 of DBIx/Class/Storage/DBIHacks.pm
sub _order_by_chunks {
12981700ns my ($self, $arg) = @_;
1299
1300 return $self->_SWITCH_refkind($arg, {
1301
1302
# spent 118µs (21+97) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:1304] which was called: # once (21µs+97µs) by SQL::Abstract::_SWITCH_refkind at line 1521
ARRAYREF => sub {
130320s map { $self->_order_by_chunks ($_ ) } @$arg;
# spent 97µs making 2 calls to SQL::Abstract::_order_by_chunks, avg 48µs/call, recursion: max depth 1, sum of overlapping time 97µs
1304 },
1305
1306 ARRAYREFREF => sub {
1307 my ($s, @b) = @$$arg;
1308 $self->_assert_bindval_matches_bindtype(@b);
1309 [ $s, @b ];
1310 },
1311
1312243µs
# spent 48µs (5+43) within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:1312] which was called 2 times, avg 24µs/call: # 2 times (5µs+43µs) by SQL::Abstract::_SWITCH_refkind at line 1521, avg 24µs/call
SCALAR => sub {$self->_quote($arg)},
# spent 43µs making 2 calls to DBIx::Class::SQLMaker::_quote, avg 22µs/call
1313
131416µs
# spent 1µs within SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:1314] which was called: # once (1µs+0s) by SQL::Abstract::_SWITCH_refkind at line 1521
UNDEF => sub {return () },
1315
1316 SCALARREF => sub {$$arg}, # literal SQL, no quoting
1317
1318 HASHREF => sub {
1319 # get first pair in hash
1320 my ($key, $val, @rest) = %$arg;
1321
1322 return () unless $key;
1323
1324 if ( @rest or not $key =~ /^-(desc|asc)/i ) {
1325 puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
1326 }
1327
1328 my $direction = $1;
1329
1330 my @ret;
1331 for my $c ($self->_order_by_chunks ($val)) {
1332 my ($sql, @bind);
1333
1334 $self->_SWITCH_refkind ($c, {
1335 SCALAR => sub {
1336 $sql = $c;
1337 },
1338 ARRAYREF => sub {
1339 ($sql, @bind) = @$c;
1340 },
1341 });
1342
1343 $sql = $sql . ' ' . $self->_sqlcase($direction);
1344
1345 push @ret, [ $sql, @bind];
1346 }
1347
1348 return @ret;
1349 },
1350124µs4160µs });
# spent 234µs making 4 calls to SQL::Abstract::_SWITCH_refkind, avg 59µs/call, recursion: max depth 1, sum of overlapping time 74µs
1351}
1352
1353
1354#======================================================================
1355# DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
1356#======================================================================
1357
1358sub _table {
1359 my $self = shift;
1360 my $from = shift;
1361 $self->_SWITCH_refkind($from, {
1362 ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
1363 SCALAR => sub {$self->_quote($from)},
1364 SCALARREF => sub {$$from},
1365 });
1366}
1367
1368
1369#======================================================================
1370# UTILITY FUNCTIONS
1371#======================================================================
1372
1373# highly optimized, as it's called way too often
1374sub _quote {
1375 # my ($self, $label) = @_;
1376
1377677204µs return '' unless defined $_[1];
1378677228µs return ${$_[1]} if ref($_[1]) eq 'SCALAR';
1379
1380677308µs unless ($_[0]->{quote_char}) {
1381677981µs259830.8ms $_[0]->_assert_pass_injection_guard($_[1]);
# spent 30.8ms making 2598 calls to SQL::Abstract::_assert_pass_injection_guard, avg 12µs/call
1382677459µs return $_[1];
1383 }
1384
1385 my $qref = ref $_[0]->{quote_char};
1386 my ($l, $r);
1387 if (!$qref) {
1388 ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} );
1389 }
1390 elsif ($qref eq 'ARRAY') {
1391 ($l, $r) = @{$_[0]->{quote_char}};
1392 }
1393 else {
1394 puke "Unsupported quote_char format: $_[0]->{quote_char}";
1395 }
1396 my $esc = $_[0]->{escape_char} || $r;
1397
1398 # parts containing * are naturally unquoted
1399 return join( $_[0]->{name_sep}||'', map
1400 { $_ eq '*' ? $_ : do { (my $n = $_) =~ s/(\Q$esc\E|\Q$r\E)/$esc$1/g; $l . $n . $r } }
1401 ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] )
1402 );
1403}
1404
1405
1406# Conversion, if applicable
1407
# spent 1.33ms within SQL::Abstract::_convert which was called 636 times, avg 2µs/call: # 318 times (834µs+0s) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:668] at line 665, avg 3µs/call # 318 times (493µs+0s) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:941] at line 937, avg 2µs/call
sub _convert ($) {
1408 #my ($self, $arg) = @_;
1409168113µs if ($_[0]->{convert}) {
1410 return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
1411 }
1412168341µs return $_[1];
1413}
1414
1415# And bindtype
1416
# spent 1.65ms within SQL::Abstract::_bindtype which was called 318 times, avg 5µs/call: # 318 times (1.65ms+0s) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:668] at line 665, avg 5µs/call
sub _bindtype (@) {
1417 #my ($self, $col, @vals) = @_;
1418 # called often - tighten code
1419 return $_[0]->{bindtype} eq 'columns'
142084497µs ? map {[$_[1], $_]} @_[2 .. $#_]
1421 : @_[2 .. $#_]
1422 ;
1423}
1424
1425# Dies if any element of @bind is not in [colname => value] format
1426# if bindtype is 'columns'.
1427sub _assert_bindval_matches_bindtype {
1428# my ($self, @bind) = @_;
1429 my $self = shift;
1430 if ($self->{bindtype} eq 'columns') {
1431 for (@_) {
1432 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
1433 puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
1434 }
1435 }
1436 }
1437}
1438
1439
# spent 1.28ms (1.28+2µs) within SQL::Abstract::_join_sql_clauses which was called 323 times, avg 4µs/call: # 321 times (1.27ms+800ns) by SQL::Abstract::_where_HASHREF at line 626, avg 4µs/call # 2 times (10µs+1µs) by SQL::Abstract::_where_ARRAYREF at line 558, avg 6µs/call
sub _join_sql_clauses {
14408563µs my ($self, $logic, $clauses_aref, $bind_aref) = @_;
1441
144285289µs if (@$clauses_aref > 1) {
144313µs22µs my $join = " " . $self->_sqlcase($logic) . " ";
# spent 2µs making 2 calls to SQL::Abstract::_sqlcase, avg 1µs/call
144413µs my $sql = '( ' . join($join, @$clauses_aref) . ' )';
144512µs return ($sql, @$bind_aref);
1446 }
1447 elsif (@$clauses_aref) {
1448 return ($clauses_aref->[0], @$bind_aref); # no parentheses
1449 }
1450 else {
1451 return (); # if no SQL, ignore @$bind_aref
1452 }
1453}
1454
1455
1456# Fix SQL case, if so requested
1457
# spent 2.18ms within SQL::Abstract::_sqlcase which was called 1275 times, avg 2µs/call: # 634 times (755µs+0s) by DBIx::Class::SQLMaker::select at line 439, avg 1µs/call # 318 times (963µs+0s) by SQL::Abstract::_where_unary_op at line 674, avg 3µs/call # 317 times (449µs+0s) by SQL::Abstract::where at line 476, avg 1µs/call # 2 times (2µs+0s) by SQL::Abstract::_join_sql_clauses at line 1443, avg 1µs/call # once (3µs+0s) by DBIx::Class::SQLMaker::_recurse_fields at line 271 of DBIx/Class/SQLMaker.pm # once (2µs+0s) by DBIx::Class::SQLMaker::_order_by at line 1286 # once (2µs+0s) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:932] at line 931 # once (2µs+0s) by SQL::Abstract::_where_hashpair_UNDEF at line 1051
sub _sqlcase {
1458 # LDNOTE: if $self->{case} is true, then it contains 'lower', so we
1459 # don't touch the argument ... crooked logic, but let's not change it!
1460343860µs return $_[0]->{case} ? $_[1] : uc($_[1]);
1461}
1462
1463
1464#======================================================================
1465# DISPATCHING FROM REFKIND
1466#======================================================================
1467
1468
# spent 6.93ms (6.17+754µs) within SQL::Abstract::_refkind which was called 1290 times, avg 5µs/call: # 1290 times (6.17ms+754µs) by SQL::Abstract::_try_refkind at line 1490, avg 5µs/call
sub _refkind {
146934179µs my ($self, $data) = @_;
1470
147134172µs return 'UNDEF' unless defined $data;
1472
1473 # blessed objects are treated like scalars
1474338946µs1287754µs my $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
# spent 754µs making 1287 calls to Scalar::Util::blessed, avg 586ns/call
1475
1476338344µs return 'SCALAR' unless $ref;
1477
147817035µs my $n_steps = 1;
1479170100µs while ($ref eq 'REF') {
1480 $data = $$data;
1481 $ref = (Scalar::Util::blessed $data) ? '' : ref $data;
1482 $n_steps++ if $ref;
1483 }
1484
1485170468µs return ($ref||'SCALAR') . ('REF' x $n_steps);
1486}
1487
1488
# spent 13.0ms (6.06+6.93) within SQL::Abstract::_try_refkind which was called 1290 times, avg 10µs/call: # 649 times (2.70ms+2.82ms) by SQL::Abstract::_SWITCH_refkind at line 1513, avg 9µs/call # 641 times (3.35ms+4.10ms) by SQL::Abstract::_METHOD_FOR_refkind at line 1500, avg 12µs/call
sub _try_refkind {
148934188µs my ($self, $data) = @_;
1490341588µs12906.93ms my @try = ($self->_refkind($data));
# spent 6.93ms making 1290 calls to SQL::Abstract::_refkind, avg 5µs/call
1491341158µs push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF';
149234182µs push @try, 'FALLBACK';
1493341630µs return \@try;
1494}
1495
1496
# spent 14.3ms (5.67+8.64) within SQL::Abstract::_METHOD_FOR_refkind which was called 641 times, avg 22µs/call: # 321 times (3.85ms+5.69ms) by SQL::Abstract::_recurse_where at line 491, avg 30µs/call # 320 times (1.83ms+2.95ms) by SQL::Abstract::_where_HASHREF at line 617, avg 15µs/call
sub _METHOD_FOR_refkind {
149717177µs my ($self, $meth_prefix, $data) = @_;
1498
149917133µs my $method;
1500171312µs6417.46ms for (@{$self->_try_refkind($data)}) {
# spent 7.46ms making 641 calls to SQL::Abstract::_try_refkind, avg 12µs/call
15011711.02ms6411.19ms $method = $self->can($meth_prefix."_".$_)
# spent 1.19ms making 641 calls to UNIVERSAL::can, avg 2µs/call
1502 and last;
1503 }
1504
1505171373µs return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data);
1506}
1507
1508
1509
# spent 98.1ms (15.0+83.0) within SQL::Abstract::_SWITCH_refkind which was called 649 times, avg 151µs/call: # 319 times (3.14ms+93.6ms) by SQL::Abstract::_where_hashpair_HASHREF at line 942, avg 303µs/call # 318 times (11.8ms+-11.8ms) by SQL::Abstract::_where_unary_op at line 672, avg 0s/call # 4 times (31µs+129µs) by SQL::Abstract::_order_by_chunks at line 1350, avg 40µs/call # 4 times (27µs+-27µs) by SQL::Abstract::_where_ARRAYREF at line 550, avg 0s/call # 2 times (20µs+1.15ms) by SQL::Abstract::_where_op_ANDOR at line 719, avg 583µs/call # 2 times (25µs+24µs) by DBIx::Class::SQLMaker::_order_by at line 1283, avg 25µs/call
sub _SWITCH_refkind {
1510170101µs my ($self, $data, $dispatch_table) = @_;
1511
151217032µs my $coderef;
1513170275µs6495.53ms for (@{$self->_try_refkind($data)}) {
# spent 5.53ms making 649 calls to SQL::Abstract::_try_refkind, avg 9µs/call
1514338231µs $coderef = $dispatch_table->{$_}
1515 and last;
1516 }
1517
151817027µs puke "no dispatch entry for ".$self->_refkind($data)
1519 unless $coderef;
1520
1521170575µs649100ms $coderef->();
# spent 91.0ms making 318 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:941], avg 286µs/call # spent 5.02ms making 318 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:668], avg 16µs/call # spent 2.03ms making 2 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:688], avg 1.01ms/call # spent 1.84ms making 4 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:547], avg 461µs/call # spent 118µs making 1 call to SQL::Abstract::__ANON__[SQL/Abstract.pm:1304] # spent 55µs making 1 call to SQL::Abstract::__ANON__[SQL/Abstract.pm:932] # spent 48µs making 2 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1312], avg 24µs/call # spent 4µs making 2 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1281], avg 2µs/call # spent 1µs making 1 call to SQL::Abstract::__ANON__[SQL/Abstract.pm:1314]
1522}
1523
- -
1527#======================================================================
1528# VALUES, GENERATE, AUTOLOAD
1529#======================================================================
1530
1531# LDNOTE: original code from nwiger, didn't touch code in that section
1532# I feel the AUTOLOAD stuff should not be the default, it should
1533# only be activated on explicit demand by user.
1534
1535sub values {
1536 my $self = shift;
1537 my $data = shift || return;
1538 puke "Argument to ", __PACKAGE__, "->values must be a \\%hash"
1539 unless ref $data eq 'HASH';
1540
1541 my @all_bind;
1542 foreach my $k ( sort keys %$data ) {
1543 my $v = $data->{$k};
1544 $self->_SWITCH_refkind($v, {
1545 ARRAYREF => sub {
1546 if ($self->{array_datatypes}) { # array datatype
1547 push @all_bind, $self->_bindtype($k, $v);
1548 }
1549 else { # literal SQL with bind
1550 my ($sql, @bind) = @$v;
1551 $self->_assert_bindval_matches_bindtype(@bind);
1552 push @all_bind, @bind;
1553 }
1554 },
1555 ARRAYREFREF => sub { # literal SQL with bind
1556 my ($sql, @bind) = @${$v};
1557 $self->_assert_bindval_matches_bindtype(@bind);
1558 push @all_bind, @bind;
1559 },
1560 SCALARREF => sub { # literal SQL without bind
1561 },
1562 SCALAR_or_UNDEF => sub {
1563 push @all_bind, $self->_bindtype($k, $v);
1564 },
1565 });
1566 }
1567
1568 return @all_bind;
1569}
1570
1571sub generate {
1572 my $self = shift;
1573
1574 my(@sql, @sqlq, @sqlv);
1575
1576 for (@_) {
1577 my $ref = ref $_;
1578 if ($ref eq 'HASH') {
1579 for my $k (sort keys %$_) {
1580 my $v = $_->{$k};
1581 my $r = ref $v;
1582 my $label = $self->_quote($k);
1583 if ($r eq 'ARRAY') {
1584 # literal SQL with bind
1585 my ($sql, @bind) = @$v;
1586 $self->_assert_bindval_matches_bindtype(@bind);
1587 push @sqlq, "$label = $sql";
1588 push @sqlv, @bind;
1589 } elsif ($r eq 'SCALAR') {
1590 # literal SQL without bind
1591 push @sqlq, "$label = $$v";
1592 } else {
1593 push @sqlq, "$label = ?";
1594 push @sqlv, $self->_bindtype($k, $v);
1595 }
1596 }
1597 push @sql, $self->_sqlcase('set'), join ', ', @sqlq;
1598 } elsif ($ref eq 'ARRAY') {
1599 # unlike insert(), assume these are ONLY the column names, i.e. for SQL
1600 for my $v (@$_) {
1601 my $r = ref $v;
1602 if ($r eq 'ARRAY') { # literal SQL with bind
1603 my ($sql, @bind) = @$v;
1604 $self->_assert_bindval_matches_bindtype(@bind);
1605 push @sqlq, $sql;
1606 push @sqlv, @bind;
1607 } elsif ($r eq 'SCALAR') { # literal SQL without bind
1608 # embedded literal SQL
1609 push @sqlq, $$v;
1610 } else {
1611 push @sqlq, '?';
1612 push @sqlv, $v;
1613 }
1614 }
1615 push @sql, '(' . join(', ', @sqlq) . ')';
1616 } elsif ($ref eq 'SCALAR') {
1617 # literal SQL
1618 push @sql, $$_;
1619 } else {
1620 # strings get case twiddled
1621 push @sql, $self->_sqlcase($_);
1622 }
1623 }
1624
1625 my $sql = join ' ', @sql;
1626
1627 # this is pretty tricky
1628 # if ask for an array, return ($stmt, @bind)
1629 # otherwise, s/?/shift @sqlv/ to put it inline
1630 if (wantarray) {
1631 return ($sql, @sqlv);
1632 } else {
1633 1 while $sql =~ s/\?/my $d = shift(@sqlv);
1634 ref $d ? $d->[1] : $d/e;
1635 return $sql;
1636 }
1637}
1638
1639
1640sub DESTROY { 1 }
1641
1642sub AUTOLOAD {
1643 # This allows us to check for a local, then _form, attr
1644 my $self = shift;
1645 my($name) = $AUTOLOAD =~ /.*::(.+)/;
1646 return $self->generate($name, @_);
1647}
1648
16491;
1650
- -
1653__END__
 
# spent 7.72ms within SQL::Abstract::CORE:match which was called 7400 times, avg 1µs/call: # 3235 times (6.73ms+0s) by SQL::Abstract::_assert_pass_injection_guard at line 198, avg 2µs/call # 1914 times (400µs+0s) by List::Util::first or SQL::Abstract::_where_hashpair_HASHREF at line 887, avg 209ns/call # 1911 times (290µs+0s) by List::Util::first at line 637, avg 152ns/call # 322 times (277µs+0s) by SQL::Abstract::_where_HASHREF at line 585, avg 861ns/call # 10 times (7µs+0s) by List::Util::first at line 634, avg 720ns/call # 4 times (3µs+0s) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:932] at line 923, avg 825ns/call # 3 times (5µs+0s) by List::Util::first at line 600, avg 2µs/call # once (3µs+0s) by DBIx::Class::Row::BEGIN@12 at line 33
sub SQL::Abstract::CORE:match; # opcode
# spent 15µs within SQL::Abstract::CORE:qr which was called 16 times, avg 956ns/call: # 6 times (5µs+0s) by DBIx::Class::Row::BEGIN@12 at line 48, avg 767ns/call # 5 times (6µs+0s) by DBIx::Class::Row::BEGIN@12 at line 39, avg 1µs/call # once (1µs+0s) by SQL::Abstract::new at line 160 # once (1µs+0s) by SQL::Abstract::new at line 161 # once (900ns+0s) by SQL::Abstract::new at line 163 # once (800ns+0s) by SQL::Abstract::new at line 187 # once (700ns+0s) by SQL::Abstract::new at line 164
sub SQL::Abstract::CORE:qr; # opcode
# spent 7.47ms within SQL::Abstract::CORE:regcomp which was called 6758 times, avg 1µs/call: # 3235 times (3.79ms+0s) by SQL::Abstract::_assert_pass_injection_guard at line 198, avg 1µs/call # 1911 times (1.87ms+0s) by List::Util::first at line 637, avg 981ns/call # 1595 times (1.77ms+0s) by List::Util::first at line 887, avg 1µs/call # 10 times (9µs+0s) by List::Util::first at line 634, avg 890ns/call # 3 times (9µs+0s) by SQL::Abstract::__ANON__[/usr/share/perl5/SQL/Abstract.pm:932] at line 923, avg 3µs/call # 3 times (3µs+0s) by List::Util::first at line 600, avg 1µs/call # once (17µs+0s) by SQL::Abstract::new at line 160
sub SQL::Abstract::CORE:regcomp; # opcode
# spent 355µs within SQL::Abstract::CORE:sort which was called 640 times, avg 555ns/call: # 321 times (259µs+0s) by SQL::Abstract::_where_HASHREF at line 580, avg 807ns/call # 319 times (96µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 860, avg 301ns/call
sub SQL::Abstract::CORE:sort; # opcode
# spent 1.32ms within SQL::Abstract::CORE:subst which was called 1603 times, avg 827ns/call: # 319 times (502µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 868, avg 2µs/call # 319 times (365µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 869, avg 1µs/call # 319 times (290µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 867, avg 910ns/call # 319 times (98µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 874, avg 306ns/call # 319 times (60µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 877, avg 187ns/call # 2 times (5µs+0s) by SQL::Abstract::_where_unary_op at line 641, avg 3µs/call # 2 times (4µs+0s) by SQL::Abstract::_where_HASHREF at line 589, avg 2µs/call # 2 times (900ns+0s) by SQL::Abstract::_where_HASHREF at line 590, avg 450ns/call # 2 times (300ns+0s) by SQL::Abstract::_where_HASHREF at line 593, avg 150ns/call
sub SQL::Abstract::CORE:subst; # opcode
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.