Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm |
Statements | Executed 1363371 statements in 3.68s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
63788 | 1 | 1 | 346ms | 923ms | _quote | SQL::Abstract::
64007 | 3 | 1 | 326ms | 583ms | _assert_pass_injection_guard | SQL::Abstract::
9094 | 1 | 1 | 259ms | 1.42s | _where_HASHREF (recurses: max depth 1, inclusive time 135ms) | SQL::Abstract::
30239 | 2 | 1 | 238ms | 444ms | _try_refkind | SQL::Abstract::
7879 | 1 | 1 | 232ms | 549ms | _where_hashpair_SCALAR | SQL::Abstract::
81254 | 8 | 1 | 210ms | 210ms | CORE:match (opcode) | SQL::Abstract::
18438 | 3 | 1 | 208ms | 509ms | _METHOD_FOR_refkind | SQL::Abstract::
30239 | 1 | 1 | 184ms | 206ms | _refkind | SQL::Abstract::
6706 | 1 | 1 | 156ms | 3.06s | select | SQL::Abstract::
11801 | 10 | 1 | 147ms | 827ms | _SWITCH_refkind (recurses: max depth 2, inclusive time 256ms) | SQL::Abstract::
7570 | 3 | 1 | 134ms | 2.33s | where | SQL::Abstract::
845 | 1 | 1 | 112ms | 576ms | update | SQL::Abstract::
9486 | 4 | 3 | 104ms | 1.80s | _recurse_where (recurses: max depth 1, inclusive time 172ms) | SQL::Abstract::
3522 | 4 | 2 | 92.6ms | 203ms | _order_by_chunks (recurses: max depth 2, inclusive time 45.7ms) | SQL::Abstract::
449 | 1 | 1 | 79.3ms | 173ms | _insert_values | SQL::Abstract::
36128 | 14 | 2 | 75.6ms | 75.6ms | _sqlcase | SQL::Abstract::
11300 | 4 | 1 | 71.6ms | 71.6ms | _bindtype | SQL::Abstract::
70837 | 5 | 1 | 71.0ms | 71.0ms | CORE:regcomp (opcode) | SQL::Abstract::
9905 | 2 | 1 | 50.4ms | 51.9ms | _join_sql_clauses | SQL::Abstract::
811 | 2 | 1 | 47.0ms | 263ms | _where_ARRAYREF | SQL::Abstract::
1313 | 1 | 1 | 39.8ms | 204ms | _table | SQL::Abstract::
624 | 1 | 1 | 39.5ms | 167ms | _where_hashpair_HASHREF | SQL::Abstract::
17006 | 4 | 2 | 35.3ms | 35.3ms | _convert | SQL::Abstract::
1284 | 2 | 1 | 31.7ms | 395ms | _where_unary_op | SQL::Abstract::
449 | 1 | 1 | 30.3ms | 281ms | _insert_HASHREF | SQL::Abstract::
629 | 1 | 1 | 24.6ms | 98.0ms | _order_by | SQL::Abstract::
807 | 1 | 1 | 22.5ms | 302ms | _where_op_ANDOR | SQL::Abstract::
8687 | 3 | 1 | 22.1ms | 22.1ms | _debug | SQL::Abstract::
449 | 1 | 1 | 22.1ms | 414ms | insert | SQL::Abstract::
11461 | 5 | 1 | 17.1ms | 17.1ms | CORE:sort (opcode) | SQL::Abstract::
1952 | 1 | 1 | 15.9ms | 27.9ms | __ANON__[:257] | SQL::Abstract::
477 | 1 | 1 | 13.1ms | 90.2ms | __ANON__[:782] | SQL::Abstract::
1313 | 1 | 1 | 12.7ms | 97.6ms | __ANON__[:1149] | SQL::Abstract::
992 | 1 | 1 | 11.2ms | 20.4ms | __ANON__[:327] | SQL::Abstract::
1622 | 1 | 1 | 9.39ms | 182ms | __ANON__[:455] | SQL::Abstract::
477 | 1 | 1 | 9.23ms | 11.7ms | generate | SQL::Abstract::
6201 | 9 | 1 | 8.32ms | 8.32ms | CORE:subst (opcode) | SQL::Abstract::
477 | 1 | 1 | 4.40ms | 8.76ms | __ANON__[:572] | SQL::Abstract::
781 | 1 | 1 | 4.16ms | 48.5ms | __ANON__[:1090] | SQL::Abstract::
807 | 1 | 1 | 3.75ms | 264ms | __ANON__[:592] | SQL::Abstract::
477 | 1 | 1 | 3.59ms | 17.2ms | AUTOLOAD | SQL::Abstract::
1950 | 1 | 1 | 3.01ms | 3.01ms | __ANON__[:1100] | SQL::Abstract::
781 | 1 | 1 | 3.00ms | 17.6ms | __ANON__[:1098] | SQL::Abstract::
387 | 1 | 1 | 1.36ms | 1.36ms | _where_UNDEF | SQL::Abstract::
624 | 1 | 1 | 993µs | 993µs | __ANON__[:1067] | SQL::Abstract::
19 | 1 | 1 | 955µs | 7.67ms | delete | SQL::Abstract::
10 | 1 | 1 | 758µs | 2.58ms | __ANON__[:1135] | SQL::Abstract::
5 | 1 | 1 | 298µs | 372µs | new | SQL::Abstract::
21 | 5 | 1 | 55µs | 55µs | CORE:qr (opcode) | SQL::Abstract::
10 | 1 | 1 | 25µs | 25µs | __ANON__[:1123] | SQL::Abstract::
5 | 1 | 1 | 19µs | 19µs | __ANON__[:1068] | SQL::Abstract::
1 | 1 | 1 | 16µs | 69µs | BEGIN@8 | SQL::Abstract::
1 | 1 | 1 | 11µs | 27µs | BEGIN@10 | SQL::Abstract::
1 | 1 | 1 | 9µs | 13µs | BEGIN@9 | SQL::Abstract::
1 | 1 | 1 | 8µs | 10µs | _where_SCALARREF | SQL::Abstract::
1 | 1 | 1 | 4µs | 4µs | BEGIN@12 | SQL::Abstract::
1 | 1 | 1 | 4µs | 4µs | BEGIN@11 | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | DESTROY | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1004] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1007] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1026] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1031] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1037] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1041] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1096] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1102] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1126] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1148] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1150] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1151] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1355] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1360] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1362] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:1365] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:160] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:161] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:162] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:233] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:240] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:248] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:252] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:302] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:308] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:311] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:323] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:447] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:453] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:462] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:465] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:467] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:519] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:541] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:575] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:598] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:606] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:614] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:618] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:622] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:635] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:639] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:643] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:655] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:659] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:663] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:733] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:753] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:762] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:769] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:921] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:924] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:934] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:937] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:942] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:949] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:959] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:962] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:989] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:992] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | __ANON__[:997] | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _assert_bindval_matches_bindtype | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _insert_ARRAYREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _insert_ARRAYREFREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _insert_SCALARREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _insert_returning | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _open_outer_paren | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_ARRAYREFREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_SCALAR | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_field_BETWEEN | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_field_IN | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_field_op_ARRAYREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_hashpair_ARRAYREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_hashpair_ARRAYREFREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_hashpair_SCALARREF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_hashpair_UNDEF | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_op_BOOL | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | _where_op_NEST | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | belch | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | puke | SQL::Abstract::
0 | 0 | 0 | 0s | 0s | values | SQL::Abstract::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package SQL::Abstract; # see doc at end of file | ||||
2 | |||||
3 | # LDNOTE : this code is heavy refactoring from original SQLA. | ||||
4 | # Several design decisions will need discussion during | ||||
5 | # the test / diffusion / acceptance phase; those are marked with flag | ||||
6 | # 'LDNOTE' (note by laurent.dami AT free.fr) | ||||
7 | |||||
8 | 3 | 24µs | 2 | 122µs | # spent 69µs (16+53) within SQL::Abstract::BEGIN@8 which was called:
# once (16µs+53µs) by base::import at line 8 # spent 69µs making 1 call to SQL::Abstract::BEGIN@8
# spent 53µs making 1 call to Exporter::import |
9 | 3 | 19µs | 2 | 18µs | # spent 13µs (9+4) within SQL::Abstract::BEGIN@9 which was called:
# once (9µs+4µs) by base::import at line 9 # spent 13µs making 1 call to SQL::Abstract::BEGIN@9
# spent 4µs making 1 call to strict::import |
10 | 3 | 19µs | 2 | 43µs | # spent 27µs (11+16) within SQL::Abstract::BEGIN@10 which was called:
# once (11µs+16µs) by base::import at line 10 # spent 27µs making 1 call to SQL::Abstract::BEGIN@10
# spent 16µs making 1 call to warnings::import |
11 | 3 | 17µs | 1 | 4µs | # spent 4µs within SQL::Abstract::BEGIN@11 which was called:
# once (4µs+0s) by base::import at line 11 # spent 4µs making 1 call to SQL::Abstract::BEGIN@11 |
12 | 3 | 5.84ms | 1 | 4µs | # spent 4µs within SQL::Abstract::BEGIN@12 which was called:
# once (4µs+0s) by base::import at line 12 # spent 4µs making 1 call to SQL::Abstract::BEGIN@12 |
13 | |||||
14 | #====================================================================== | ||||
15 | # GLOBALS | ||||
16 | #====================================================================== | ||||
17 | |||||
18 | 1 | 1µs | our $VERSION = '1.72'; | ||
19 | |||||
20 | # This would confuse some packagers | ||||
21 | 1 | 21µs | 1 | 5µs | $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases # spent 5µs making 1 call to SQL::Abstract::CORE:match |
22 | |||||
23 | 1 | 100ns | our $AUTOLOAD; | ||
24 | |||||
25 | # special operators (-in, -between). May be extended/overridden by user. | ||||
26 | # See section WHERE: BUILTIN SPECIAL OPERATORS below for implementation | ||||
27 | 1 | 16µs | 2 | 5µs | my @BUILTIN_SPECIAL_OPS = ( # spent 5µs making 2 calls to SQL::Abstract::CORE:qr, avg 3µs/call |
28 | {regex => qr/^ (?: not \s )? between $/ix, handler => '_where_field_BETWEEN'}, | ||||
29 | {regex => qr/^ (?: not \s )? in $/ix, handler => '_where_field_IN'}, | ||||
30 | ); | ||||
31 | |||||
32 | # unaryish operators - key maps to handler | ||||
33 | 1 | 14µs | 4 | 4µs | my @BUILTIN_UNARY_OPS = ( # spent 4µs making 4 calls to SQL::Abstract::CORE:qr, avg 1µs/call |
34 | # the digits are backcompat stuff | ||||
35 | { regex => qr/^ and (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' }, | ||||
36 | { regex => qr/^ or (?: [_\s]? \d+ )? $/xi, handler => '_where_op_ANDOR' }, | ||||
37 | { regex => qr/^ nest (?: [_\s]? \d+ )? $/xi, handler => '_where_op_NEST' }, | ||||
38 | { regex => qr/^ (?: not \s )? bool $/xi, handler => '_where_op_BOOL' }, | ||||
39 | ); | ||||
40 | |||||
41 | #====================================================================== | ||||
42 | # DEBUGGING AND ERROR REPORTING | ||||
43 | #====================================================================== | ||||
44 | |||||
45 | # spent 22.1ms within SQL::Abstract::_debug which was called 8687 times, avg 3µs/call:
# 7879 times (19.9ms+0s) by SQL::Abstract::_where_hashpair_SCALAR at line 857, avg 3µs/call
# 807 times (2.15ms+0s) by SQL::Abstract::_where_HASHREF at line 513, avg 3µs/call
# once (2µs+0s) by SQL::Abstract::_where_SCALARREF at line 882 | ||||
46 | 8687 | 30.8ms | return unless $_[0]->{debug}; shift; # a little faster | ||
47 | my $func = (caller(1))[3]; | ||||
48 | warn "[$func] ", @_, "\n"; | ||||
49 | } | ||||
50 | |||||
51 | sub belch (@) { | ||||
52 | my($func) = (caller(1))[3]; | ||||
53 | carp "[$func] Warning: ", @_; | ||||
54 | } | ||||
55 | |||||
56 | sub puke (@) { | ||||
57 | my($func) = (caller(1))[3]; | ||||
58 | croak "[$func] Fatal: ", @_; | ||||
59 | } | ||||
60 | |||||
61 | |||||
62 | #====================================================================== | ||||
63 | # NEW | ||||
64 | #====================================================================== | ||||
65 | |||||
66 | # spent 372µs (298+74) within SQL::Abstract::new which was called 5 times, avg 74µs/call:
# 5 times (298µs+74µs) by DBIx::Class::SQLMaker::new at line 28 of mro.pm, avg 74µs/call | ||||
67 | 85 | 380µs | my $self = shift; | ||
68 | my $class = ref($self) || $self; | ||||
69 | my %opt = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_; | ||||
70 | |||||
71 | # choose our case by keeping an option around | ||||
72 | delete $opt{case} if $opt{case} && $opt{case} ne 'lower'; | ||||
73 | |||||
74 | # default logic for interpreting arrayrefs | ||||
75 | $opt{logic} = $opt{logic} ? uc $opt{logic} : 'OR'; | ||||
76 | |||||
77 | # how to return bind vars | ||||
78 | # LDNOTE: changed nwiger code : why this 'delete' ?? | ||||
79 | # $opt{bindtype} ||= delete($opt{bind_type}) || 'normal'; | ||||
80 | $opt{bindtype} ||= 'normal'; | ||||
81 | |||||
82 | # default comparison is "=", but can be overridden | ||||
83 | $opt{cmp} ||= '='; | ||||
84 | |||||
85 | # try to recognize which are the 'equality' and 'unequality' ops | ||||
86 | # (temporary quickfix, should go through a more seasoned API) | ||||
87 | 10 | 54µs | $opt{equality_op} = qr/^(\Q$opt{cmp}\E|is|(is\s+)?like)$/i; # spent 28µs making 5 calls to SQL::Abstract::CORE:regcomp, avg 6µs/call
# spent 26µs making 5 calls to SQL::Abstract::CORE:qr, avg 5µs/call | ||
88 | 5 | 10µs | $opt{inequality_op} = qr/^(!=|<>|(is\s+)?not(\s+like)?)$/i; # spent 10µs making 5 calls to SQL::Abstract::CORE:qr, avg 2µs/call | ||
89 | |||||
90 | # SQL booleans | ||||
91 | $opt{sqltrue} ||= '1=1'; | ||||
92 | $opt{sqlfalse} ||= '0=1'; | ||||
93 | |||||
94 | # special operators | ||||
95 | $opt{special_ops} ||= []; | ||||
96 | # regexes are applied in order, thus push after user-defines | ||||
97 | push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS; | ||||
98 | |||||
99 | # unary operators | ||||
100 | $opt{unary_ops} ||= []; | ||||
101 | push @{$opt{unary_ops}}, @BUILTIN_UNARY_OPS; | ||||
102 | |||||
103 | # rudimentary saniy-check for user supplied bits treated as functions/operators | ||||
104 | # If a purported function matches this regular expression, an exception is thrown. | ||||
105 | # Literal SQL is *NOT* subject to this check, only functions (and column names | ||||
106 | # when quoting is not in effect) | ||||
107 | |||||
108 | # FIXME | ||||
109 | # need to guard against ()'s in column names too, but this will break tons of | ||||
110 | # hacks... ideas anyone? | ||||
111 | 5 | 9µs | $opt{injection_guard} ||= qr/ # spent 9µs making 5 calls to SQL::Abstract::CORE:qr, avg 2µs/call | ||
112 | \; | ||||
113 | | | ||||
114 | ^ \s* go \s | ||||
115 | /xmi; | ||||
116 | |||||
117 | return bless \%opt, $class; | ||||
118 | } | ||||
119 | |||||
120 | |||||
121 | # spent 583ms (326+257) within SQL::Abstract::_assert_pass_injection_guard which was called 64007 times, avg 9µs/call:
# 62906 times (322ms+256ms) by SQL::Abstract::_quote at line 1168, avg 9µs/call
# 624 times (2.32ms+985µs) by SQL::Abstract::_where_hashpair_HASHREF at line 721, avg 5µs/call
# 477 times (1.70ms+729µs) by SQL::Abstract::_where_unary_op at line 561, avg 5µs/call | ||||
122 | 64007 | 641ms | 128014 | 257ms | if ($_[1] =~ $_[0]->{injection_guard}) { # spent 193ms making 64007 calls to SQL::Abstract::CORE:match, avg 3µs/call
# spent 64.7ms making 64007 calls to SQL::Abstract::CORE:regcomp, avg 1µs/call |
123 | my $class = ref $_[0]; | ||||
124 | puke "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the " | ||||
125 | . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own " | ||||
126 | . "{injection_guard} attribute to ${class}->new()" | ||||
127 | } | ||||
128 | } | ||||
129 | |||||
130 | |||||
131 | #====================================================================== | ||||
132 | # INSERT methods | ||||
133 | #====================================================================== | ||||
134 | |||||
135 | # spent 414ms (22.1+392) within SQL::Abstract::insert which was called 449 times, avg 922µs/call:
# 449 times (22.1ms+392ms) by DBIx::Class::SQLMaker::insert at line 28 of mro.pm, avg 922µs/call | ||||
136 | 4041 | 19.3ms | my $self = shift; | ||
137 | 449 | 87.6ms | my $table = $self->_table(shift); # spent 87.6ms making 449 calls to DBIx::Class::SQLMaker::_table, avg 195µs/call | ||
138 | my $data = shift || return; | ||||
139 | my $options = shift; | ||||
140 | |||||
141 | 449 | 22.2ms | my $method = $self->_METHOD_FOR_refkind("_insert", $data); # spent 22.2ms making 449 calls to SQL::Abstract::_METHOD_FOR_refkind, avg 49µs/call | ||
142 | 449 | 281ms | my ($sql, @bind) = $self->$method($data); # spent 281ms making 449 calls to SQL::Abstract::_insert_HASHREF, avg 625µs/call | ||
143 | 449 | 1.33ms | $sql = join " ", $self->_sqlcase('insert into'), $table, $sql; # spent 1.33ms making 449 calls to SQL::Abstract::_sqlcase, avg 3µs/call | ||
144 | |||||
145 | if ($options->{returning}) { | ||||
146 | my ($s, @b) = $self->_insert_returning ($options); | ||||
147 | $sql .= $s; | ||||
148 | push @bind, @b; | ||||
149 | } | ||||
150 | |||||
151 | return wantarray ? ($sql, @bind) : $sql; | ||||
152 | } | ||||
153 | |||||
154 | sub _insert_returning { | ||||
155 | my ($self, $options) = @_; | ||||
156 | |||||
157 | my $f = $options->{returning}; | ||||
158 | |||||
159 | my $fieldlist = $self->_SWITCH_refkind($f, { | ||||
160 | ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;}, | ||||
161 | SCALAR => sub {$self->_quote($f)}, | ||||
162 | SCALARREF => sub {$$f}, | ||||
163 | }); | ||||
164 | return $self->_sqlcase(' returning ') . $fieldlist; | ||||
165 | } | ||||
166 | |||||
167 | # spent 281ms (30.3+250) within SQL::Abstract::_insert_HASHREF which was called 449 times, avg 625µs/call:
# 449 times (30.3ms+250ms) by SQL::Abstract::insert at line 142, avg 625µs/call | ||||
168 | 3143 | 30.1ms | my ($self, $data) = @_; | ||
169 | |||||
170 | 449 | 2.71ms | my @fields = sort keys %$data; # spent 2.71ms making 449 calls to SQL::Abstract::CORE:sort, avg 6µs/call | ||
171 | |||||
172 | 449 | 173ms | my ($sql, @bind) = $self->_insert_values($data); # spent 173ms making 449 calls to SQL::Abstract::_insert_values, avg 386µs/call | ||
173 | |||||
174 | # assemble SQL | ||||
175 | 1952 | 74.4ms | $_ = $self->_quote($_) foreach @fields; # spent 74.4ms making 1952 calls to DBIx::Class::SQLMaker::_quote, avg 38µs/call | ||
176 | $sql = "( ".join(", ", @fields).") ".$sql; | ||||
177 | |||||
178 | return ($sql, @bind); | ||||
179 | } | ||||
180 | |||||
181 | sub _insert_ARRAYREF { # just generate values(?,?) part (no list of fields) | ||||
182 | my ($self, $data) = @_; | ||||
183 | |||||
184 | # no names (arrayref) so can't generate bindtype | ||||
185 | $self->{bindtype} ne 'columns' | ||||
186 | or belch "can't do 'columns' bindtype when called with arrayref"; | ||||
187 | |||||
188 | # fold the list of values into a hash of column name - value pairs | ||||
189 | # (where the column names are artificially generated, and their | ||||
190 | # lexicographical ordering keep the ordering of the original list) | ||||
191 | my $i = "a"; # incremented values will be in lexicographical order | ||||
192 | my $data_in_hash = { map { ($i++ => $_) } @$data }; | ||||
193 | |||||
194 | return $self->_insert_values($data_in_hash); | ||||
195 | } | ||||
196 | |||||
197 | sub _insert_ARRAYREFREF { # literal SQL with bind | ||||
198 | my ($self, $data) = @_; | ||||
199 | |||||
200 | my ($sql, @bind) = @${$data}; | ||||
201 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
202 | |||||
203 | return ($sql, @bind); | ||||
204 | } | ||||
205 | |||||
206 | |||||
207 | sub _insert_SCALARREF { # literal SQL without bind | ||||
208 | my ($self, $data) = @_; | ||||
209 | |||||
210 | return ($$data); | ||||
211 | } | ||||
212 | |||||
213 | # spent 173ms (79.3+94.0) within SQL::Abstract::_insert_values which was called 449 times, avg 386µs/call:
# 449 times (79.3ms+94.0ms) by SQL::Abstract::_insert_HASHREF at line 172, avg 386µs/call | ||||
214 | 2245 | 11.3ms | my ($self, $data) = @_; | ||
215 | |||||
216 | my (@values, @all_bind); | ||||
217 | 449 | 652µs | foreach my $column (sort keys %$data) { # spent 652µs making 449 calls to SQL::Abstract::CORE:sort, avg 1µs/call | ||
218 | 3904 | 65.3ms | my $v = $data->{$column}; | ||
219 | |||||
220 | $self->_SWITCH_refkind($v, { | ||||
221 | |||||
222 | ARRAYREF => sub { | ||||
223 | if ($self->{array_datatypes}) { # if array datatype are activated | ||||
224 | push @values, '?'; | ||||
225 | push @all_bind, $self->_bindtype($column, $v); | ||||
226 | } | ||||
227 | else { # else literal SQL with bind | ||||
228 | my ($sql, @bind) = @$v; | ||||
229 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
230 | push @values, $sql; | ||||
231 | push @all_bind, @bind; | ||||
232 | } | ||||
233 | }, | ||||
234 | |||||
235 | ARRAYREFREF => sub { # literal SQL with bind | ||||
236 | my ($sql, @bind) = @${$v}; | ||||
237 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
238 | push @values, $sql; | ||||
239 | push @all_bind, @bind; | ||||
240 | }, | ||||
241 | |||||
242 | # THINK : anything useful to do with a HASHREF ? | ||||
243 | HASHREF => sub { # (nothing, but old SQLA passed it through) | ||||
244 | #TODO in SQLA >= 2.0 it will die instead | ||||
245 | belch "HASH ref as bind value in insert is not supported"; | ||||
246 | push @values, '?'; | ||||
247 | push @all_bind, $self->_bindtype($column, $v); | ||||
248 | }, | ||||
249 | |||||
250 | SCALARREF => sub { # literal SQL without bind | ||||
251 | push @values, $$v; | ||||
252 | }, | ||||
253 | |||||
254 | # spent 27.9ms (15.9+12.0) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:257] which was called 1952 times, avg 14µs/call:
# 1952 times (15.9ms+12.0ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 14µs/call | ||||
255 | 3904 | 14.5ms | push @values, '?'; | ||
256 | 1952 | 12.0ms | push @all_bind, $self->_bindtype($column, $v); # spent 12.0ms making 1952 calls to SQL::Abstract::_bindtype, avg 6µs/call | ||
257 | }, | ||||
258 | |||||
259 | 1952 | 91.2ms | }); # spent 91.2ms making 1952 calls to SQL::Abstract::_SWITCH_refkind, avg 47µs/call | ||
260 | |||||
261 | } | ||||
262 | |||||
263 | 449 | 2.16ms | my $sql = $self->_sqlcase('values')." ( ".join(", ", @values)." )"; # spent 2.16ms making 449 calls to SQL::Abstract::_sqlcase, avg 5µs/call | ||
264 | return ($sql, @all_bind); | ||||
265 | } | ||||
266 | |||||
- - | |||||
269 | #====================================================================== | ||||
270 | # UPDATE methods | ||||
271 | #====================================================================== | ||||
272 | |||||
273 | |||||
274 | # spent 576ms (112+464) within SQL::Abstract::update which was called 845 times, avg 682µs/call:
# 845 times (112ms+464ms) by DBIx::Class::Storage::DBI::_gen_sql_bind at line 1428 of DBIx/Class/Storage/DBI.pm, avg 682µs/call | ||||
275 | 8450 | 39.0ms | my $self = shift; | ||
276 | 845 | 148ms | my $table = $self->_table(shift); # spent 148ms making 845 calls to DBIx::Class::SQLMaker::_table, avg 175µs/call | ||
277 | my $data = shift || return; | ||||
278 | my $where = shift; | ||||
279 | |||||
280 | # first build the 'SET' part of the sql statement | ||||
281 | my (@set, @all_bind); | ||||
282 | puke "Unsupported data type specified to \$sql->update" | ||||
283 | unless ref $data eq 'HASH'; | ||||
284 | |||||
285 | 845 | 1.92ms | for my $k (sort keys %$data) { # spent 1.92ms making 845 calls to SQL::Abstract::CORE:sort, avg 2µs/call | ||
286 | 3968 | 61.6ms | my $v = $data->{$k}; | ||
287 | my $r = ref $v; | ||||
288 | 992 | 41.0ms | my $label = $self->_quote($k); # spent 41.0ms making 992 calls to DBIx::Class::SQLMaker::_quote, avg 41µs/call | ||
289 | |||||
290 | $self->_SWITCH_refkind($v, { | ||||
291 | ARRAYREF => sub { | ||||
292 | if ($self->{array_datatypes}) { # array datatype | ||||
293 | push @set, "$label = ?"; | ||||
294 | push @all_bind, $self->_bindtype($k, $v); | ||||
295 | } | ||||
296 | else { # literal SQL with bind | ||||
297 | my ($sql, @bind) = @$v; | ||||
298 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
299 | push @set, "$label = $sql"; | ||||
300 | push @all_bind, @bind; | ||||
301 | } | ||||
302 | }, | ||||
303 | ARRAYREFREF => sub { # literal SQL with bind | ||||
304 | my ($sql, @bind) = @${$v}; | ||||
305 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
306 | push @set, "$label = $sql"; | ||||
307 | push @all_bind, @bind; | ||||
308 | }, | ||||
309 | SCALARREF => sub { # literal SQL without bind | ||||
310 | push @set, "$label = $$v"; | ||||
311 | }, | ||||
312 | HASHREF => sub { | ||||
313 | my ($op, $arg, @rest) = %$v; | ||||
314 | |||||
315 | puke 'Operator calls in update must be in the form { -op => $arg }' | ||||
316 | if (@rest or not $op =~ /^\-(.+)/); | ||||
317 | |||||
318 | local $self->{_nested_func_lhs} = $k; | ||||
319 | my ($sql, @bind) = $self->_where_unary_op ($1, $arg); | ||||
320 | |||||
321 | push @set, "$label = $sql"; | ||||
322 | push @all_bind, @bind; | ||||
323 | }, | ||||
324 | # spent 20.4ms (11.2+9.21) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:327] which was called 992 times, avg 21µs/call:
# 992 times (11.2ms+9.21ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 21µs/call | ||||
325 | 1984 | 9.70ms | push @set, "$label = ?"; | ||
326 | 992 | 9.21ms | push @all_bind, $self->_bindtype($k, $v); # spent 9.21ms making 992 calls to SQL::Abstract::_bindtype, avg 9µs/call | ||
327 | }, | ||||
328 | 992 | 55.3ms | }); # spent 55.3ms making 992 calls to SQL::Abstract::_SWITCH_refkind, avg 56µs/call | ||
329 | } | ||||
330 | |||||
331 | # generate sql | ||||
332 | 1690 | 5.85ms | my $sql = $self->_sqlcase('update') . " $table " . $self->_sqlcase('set ') # spent 5.85ms making 1690 calls to SQL::Abstract::_sqlcase, avg 3µs/call | ||
333 | . join ', ', @set; | ||||
334 | |||||
335 | 2535 | 6.31ms | if ($where) { | ||
336 | 845 | 212ms | my($where_sql, @where_bind) = $self->where($where); # spent 212ms making 845 calls to SQL::Abstract::where, avg 251µs/call | ||
337 | $sql .= $where_sql; | ||||
338 | push @all_bind, @where_bind; | ||||
339 | } | ||||
340 | |||||
341 | return wantarray ? ($sql, @all_bind) : $sql; | ||||
342 | } | ||||
343 | |||||
- - | |||||
347 | #====================================================================== | ||||
348 | # SELECT | ||||
349 | #====================================================================== | ||||
350 | |||||
351 | |||||
352 | # spent 3.06s (156ms+2.91) within SQL::Abstract::select which was called 6706 times, avg 457µs/call:
# 6706 times (156ms+2.91s) by DBIx::Class::SQLMaker::select at line 28 of mro.pm, avg 457µs/call | ||||
353 | 60354 | 146ms | my $self = shift; | ||
354 | 6706 | 766ms | my $table = $self->_table(shift); # spent 766ms making 6706 calls to DBIx::Class::SQLMaker::_table, avg 114µs/call | ||
355 | my $fields = shift || '*'; | ||||
356 | my $where = shift; | ||||
357 | my $order = shift; | ||||
358 | |||||
359 | 6706 | 2.12s | my($where_sql, @bind) = $self->where($where, $order); # spent 2.12s making 6706 calls to SQL::Abstract::where, avg 316µs/call | ||
360 | |||||
361 | my $f = (ref $fields eq 'ARRAY') ? join ', ', map { $self->_quote($_) } @$fields | ||||
362 | : $fields; | ||||
363 | 13412 | 21.2ms | my $sql = join(' ', $self->_sqlcase('select'), $f, # spent 21.2ms making 13412 calls to SQL::Abstract::_sqlcase, avg 2µs/call | ||
364 | $self->_sqlcase('from'), $table) | ||||
365 | . $where_sql; | ||||
366 | |||||
367 | return wantarray ? ($sql, @bind) : $sql; | ||||
368 | } | ||||
369 | |||||
370 | #====================================================================== | ||||
371 | # DELETE | ||||
372 | #====================================================================== | ||||
373 | |||||
374 | |||||
375 | # spent 7.67ms (955µs+6.71) within SQL::Abstract::delete which was called 19 times, avg 403µs/call:
# 19 times (955µs+6.71ms) by DBIx::Class::Storage::DBI::_gen_sql_bind at line 1428 of DBIx/Class/Storage/DBI.pm, avg 403µs/call | ||||
376 | 114 | 822µs | my $self = shift; | ||
377 | 19 | 4.84ms | my $table = $self->_table(shift); # spent 4.84ms making 19 calls to DBIx::Class::SQLMaker::_table, avg 255µs/call | ||
378 | my $where = shift; | ||||
379 | |||||
380 | |||||
381 | 19 | 1.75ms | my($where_sql, @bind) = $self->where($where); # spent 1.75ms making 19 calls to SQL::Abstract::where, avg 92µs/call | ||
382 | 19 | 123µs | my $sql = $self->_sqlcase('delete from') . " $table" . $where_sql; # spent 123µs making 19 calls to SQL::Abstract::_sqlcase, avg 6µs/call | ||
383 | |||||
384 | return wantarray ? ($sql, @bind) : $sql; | ||||
385 | } | ||||
386 | |||||
387 | |||||
388 | #====================================================================== | ||||
389 | # WHERE: entry point | ||||
390 | #====================================================================== | ||||
391 | |||||
- - | |||||
394 | # Finally, a separate routine just to handle WHERE clauses | ||||
395 | # spent 2.33s (134ms+2.20) within SQL::Abstract::where which was called 7570 times, avg 308µs/call:
# 6706 times (119ms+2.00s) by SQL::Abstract::select at line 359, avg 316µs/call
# 845 times (15.5ms+196ms) by SQL::Abstract::update at line 336, avg 251µs/call
# 19 times (315µs+1.43ms) by SQL::Abstract::delete at line 381, avg 92µs/call | ||||
396 | 37850 | 118ms | my ($self, $where, $order) = @_; | ||
397 | |||||
398 | # where ? | ||||
399 | 7570 | 1.75s | my ($sql, @bind) = $self->_recurse_where($where); # spent 1.75s making 7570 calls to SQL::Abstract::_recurse_where, avg 231µs/call | ||
400 | 7183 | 12.5ms | $sql = $sql ? $self->_sqlcase(' where ') . "( $sql )" : ''; # spent 12.5ms making 7183 calls to SQL::Abstract::_sqlcase, avg 2µs/call | ||
401 | |||||
402 | # order by? | ||||
403 | 6701 | 437ms | if ($order) { # spent 437ms making 6701 calls to DBIx::Class::SQLMaker::_order_by, avg 65µs/call | ||
404 | $sql .= $self->_order_by($order); | ||||
405 | } | ||||
406 | |||||
407 | return wantarray ? ($sql, @bind) : $sql; | ||||
408 | } | ||||
409 | |||||
410 | |||||
411 | # spent 1.80s (104ms+1.70) within SQL::Abstract::_recurse_where which was called 9486 times, avg 190µs/call:
# 7570 times (90.0ms+1.66s) by SQL::Abstract::where at line 399, avg 231µs/call
# 1622 times (11.2ms+-11.2ms) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:455] at line 455, avg 0s/call
# 147 times (1.07ms+28.0ms) by DBIx::Class::SQLMaker::_join_condition at line 502 of DBIx/Class/SQLMaker.pm, avg 197µs/call
# 147 times (1.63ms+23.0ms) by DBIx::Class::Storage::DBIHacks::_resolve_aliastypes_from_select_args at line 333 of DBIx/Class/Storage/DBIHacks.pm, avg 168µs/call | ||||
412 | 37944 | 107ms | my ($self, $where, $logic) = @_; | ||
413 | |||||
414 | # dispatch on appropriate method according to refkind of $where | ||||
415 | 9486 | 310ms | my $method = $self->_METHOD_FOR_refkind("_where", $where); # spent 310ms making 9486 calls to SQL::Abstract::_METHOD_FOR_refkind, avg 33µs/call | ||
416 | |||||
417 | 9486 | 1.43s | my ($sql, @bind) = $self->$method($where, $logic); # spent 1.56s making 9094 calls to SQL::Abstract::_where_HASHREF, avg 171µs/call, recursion: max depth 1, sum of overlapping time 135ms
# spent 3.23ms making 4 calls to SQL::Abstract::_where_ARRAYREF, avg 809µs/call
# spent 1.36ms making 387 calls to SQL::Abstract::_where_UNDEF, avg 4µs/call
# spent 10µs making 1 call to SQL::Abstract::_where_SCALARREF | ||
418 | |||||
419 | # DBIx::Class directly calls _recurse_where in scalar context, so | ||||
420 | # we must implement it, even if not in the official API | ||||
421 | return wantarray ? ($sql, @bind) : $sql; | ||||
422 | } | ||||
423 | |||||
- - | |||||
426 | #====================================================================== | ||||
427 | # WHERE: top-level ARRAYREF | ||||
428 | #====================================================================== | ||||
429 | |||||
430 | |||||
431 | # spent 263ms (47.0+216) within SQL::Abstract::_where_ARRAYREF which was called 811 times, avg 325µs/call:
# 807 times (46.5ms+214ms) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:592] at line 591, avg 322µs/call
# 4 times (522µs+2.71ms) by SQL::Abstract::_recurse_where at line 417, avg 809µs/call | ||||
432 | 5677 | 9.56ms | my ($self, $where, $logic) = @_; | ||
433 | |||||
434 | $logic = uc($logic || $self->{logic}); | ||||
435 | $logic eq 'AND' or $logic eq 'OR' or puke "unknown logic: $logic"; | ||||
436 | |||||
437 | my @clauses = @$where; | ||||
438 | |||||
439 | my (@sql_clauses, @all_bind); | ||||
440 | # need to use while() so can shift() for pairs | ||||
441 | 3244 | 34.1ms | while (my $el = shift @clauses) { | ||
442 | |||||
443 | # switch according to kind of $el and get corresponding ($sql, @bind) | ||||
444 | my ($sql, @bind) = $self->_SWITCH_refkind($el, { | ||||
445 | |||||
446 | # skip empty elements, otherwise get invalid trailing AND stuff | ||||
447 | ARRAYREF => sub {$self->_recurse_where($el) if @$el}, | ||||
448 | |||||
449 | ARRAYREFREF => sub { | ||||
450 | my ($s, @b) = @$$el; | ||||
451 | $self->_assert_bindval_matches_bindtype(@b); | ||||
452 | ($s, @b); | ||||
453 | }, | ||||
454 | |||||
455 | 1622 | 8.65ms | 1622 | 0s | # spent 182ms (9.39+172) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:455] which was called 1622 times, avg 112µs/call:
# 1622 times (9.39ms+172ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 112µs/call # spent 172ms making 1622 calls to SQL::Abstract::_recurse_where, avg 106µs/call, recursion: max depth 1, sum of overlapping time 172ms |
456 | # LDNOTE : previous SQLA code for hashrefs was creating a dirty | ||||
457 | # side-effect: the first hashref within an array would change | ||||
458 | # the global logic to 'AND'. So [ {cond1, cond2}, [cond3, cond4] ] | ||||
459 | # was interpreted as "(cond1 AND cond2) OR (cond3 AND cond4)", | ||||
460 | # whereas it should be "(cond1 AND cond2) OR (cond3 OR cond4)". | ||||
461 | |||||
462 | SCALARREF => sub { ($$el); }, | ||||
463 | |||||
464 | SCALAR => sub {# top-level arrayref with scalars, recurse in pairs | ||||
465 | $self->_recurse_where({$el => shift(@clauses)})}, | ||||
466 | |||||
467 | UNDEF => sub {puke "not supported : UNDEF in arrayref" }, | ||||
468 | 1622 | 2.63ms | }); # spent 209ms making 1622 calls to SQL::Abstract::_SWITCH_refkind, avg 129µs/call, recursion: max depth 1, sum of overlapping time 206ms | ||
469 | |||||
470 | 3244 | 1.68ms | if ($sql) { | ||
471 | push @sql_clauses, $sql; | ||||
472 | push @all_bind, @bind; | ||||
473 | } | ||||
474 | } | ||||
475 | |||||
476 | 811 | 7.62ms | return $self->_join_sql_clauses($logic, \@sql_clauses, \@all_bind); # spent 7.62ms making 811 calls to SQL::Abstract::_join_sql_clauses, avg 9µs/call | ||
477 | } | ||||
478 | |||||
479 | #====================================================================== | ||||
480 | # WHERE: top-level ARRAYREFREF | ||||
481 | #====================================================================== | ||||
482 | |||||
483 | sub _where_ARRAYREFREF { | ||||
484 | my ($self, $where) = @_; | ||||
485 | my ($sql, @bind) = @$$where; | ||||
486 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
487 | return ($sql, @bind); | ||||
488 | } | ||||
489 | |||||
490 | #====================================================================== | ||||
491 | # WHERE: top-level HASHREF | ||||
492 | #====================================================================== | ||||
493 | |||||
494 | # spent 1.42s (259ms+1.16) within SQL::Abstract::_where_HASHREF which was called 9094 times, avg 156µs/call:
# 9094 times (259ms+1.16s) by SQL::Abstract::_recurse_where at line 417, avg 156µs/call | ||||
495 | 36376 | 115ms | my ($self, $where) = @_; | ||
496 | my (@sql_clauses, @all_bind); | ||||
497 | |||||
498 | 9094 | 11.7ms | for my $k (sort keys %$where) { # spent 11.7ms making 9094 calls to SQL::Abstract::CORE:sort, avg 1µs/call | ||
499 | 37240 | 43.3ms | my $v = $where->{$k}; | ||
500 | |||||
501 | # ($k => $v) is either a special unary op or a regular hashpair | ||||
502 | 9310 | 31.7ms | my ($sql, @bind) = do { | ||
503 | 24269 | 71.0ms | 9310 | 7.77ms | if ($k =~ /^-./) { # spent 7.77ms making 9310 calls to SQL::Abstract::CORE:match, avg 834ns/call |
504 | # put the operator in canonical form | ||||
505 | my $op = $k; | ||||
506 | $op = substr $op, 1; # remove initial dash | ||||
507 | 807 | 1.87ms | $op =~ s/^\s+|\s+$//g;# remove leading/trailing space # spent 1.87ms making 807 calls to SQL::Abstract::CORE:subst, avg 2µs/call | ||
508 | 807 | 912µs | $op =~ s/\s+/ /g; # compress whitespace # spent 912µs making 807 calls to SQL::Abstract::CORE:subst, avg 1µs/call | ||
509 | |||||
510 | # so that -not_foo works correctly | ||||
511 | 807 | 415µs | $op =~ s/^not_/NOT /i; # spent 415µs making 807 calls to SQL::Abstract::CORE:subst, avg 514ns/call | ||
512 | |||||
513 | 807 | 2.15ms | $self->_debug("Unary OP(-$op) within hashref, recursing..."); # spent 2.15ms making 807 calls to SQL::Abstract::_debug, avg 3µs/call | ||
514 | 807 | 328ms | my ($s, @b) = $self->_where_unary_op ($op, $v); # spent 328ms making 807 calls to SQL::Abstract::_where_unary_op, avg 406µs/call | ||
515 | |||||
516 | # top level vs nested | ||||
517 | # we assume that handled unary ops will take care of their ()s | ||||
518 | 807 | 8.06ms | 1614 | 2.26ms | $s = "($s)" unless ( # spent 1.49ms making 807 calls to SQL::Abstract::CORE:match, avg 2µs/call
# spent 769µs making 807 calls to SQL::Abstract::CORE:regcomp, avg 953ns/call |
519 | 807 | 6.79ms | List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}} # spent 6.79ms making 807 calls to List::Util::first, avg 8µs/call | ||
520 | or | ||||
521 | defined($self->{_nested_func_lhs}) && ($self->{_nested_func_lhs} eq $k) | ||||
522 | ); | ||||
523 | ($s, @b); | ||||
524 | } | ||||
525 | else { | ||||
526 | 8503 | 177ms | my $method = $self->_METHOD_FOR_refkind("_where_hashpair", $v); # spent 177ms making 8503 calls to SQL::Abstract::_METHOD_FOR_refkind, avg 21µs/call | ||
527 | 8503 | 716ms | $self->$method($k, $v); # spent 549ms making 7879 calls to SQL::Abstract::_where_hashpair_SCALAR, avg 70µs/call
# spent 167ms making 624 calls to SQL::Abstract::_where_hashpair_HASHREF, avg 267µs/call | ||
528 | } | ||||
529 | }; | ||||
530 | |||||
531 | push @sql_clauses, $sql; | ||||
532 | push @all_bind, @bind; | ||||
533 | } | ||||
534 | |||||
535 | 9094 | 44.3ms | return $self->_join_sql_clauses('and', \@sql_clauses, \@all_bind); # spent 44.3ms making 9094 calls to SQL::Abstract::_join_sql_clauses, avg 5µs/call | ||
536 | } | ||||
537 | |||||
538 | # spent 395ms (31.7+363) within SQL::Abstract::_where_unary_op which was called 1284 times, avg 308µs/call:
# 807 times (12.9ms+315ms) by SQL::Abstract::_where_HASHREF at line 514, avg 406µs/call
# 477 times (18.7ms+48.4ms) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:782] at line 776, avg 141µs/call | ||||
539 | 4953 | 20.8ms | my ($self, $op, $rhs) = @_; | ||
540 | |||||
541 | 5283 | 25.5ms | 8622 | 30.6ms | if (my $op_entry = List::Util::first {$op =~ $_->{regex}} @{$self->{unary_ops}}) { # spent 22.5ms making 1284 calls to List::Util::first, avg 17µs/call
# spent 4.60ms making 3669 calls to SQL::Abstract::CORE:match, avg 1µs/call
# spent 3.56ms making 3669 calls to SQL::Abstract::CORE:regcomp, avg 969ns/call |
542 | my $handler = $op_entry->{handler}; | ||||
543 | |||||
544 | 1614 | 7.44ms | if (not ref $handler) { | ||
545 | 807 | 1.76ms | if ($op =~ s/ [_\s]? \d+ $//x ) { # spent 1.76ms making 807 calls to SQL::Abstract::CORE:subst, avg 2µs/call | ||
546 | belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. ' | ||||
547 | . "You probably wanted ...-and => [ -$op => COND1, -$op => COND2 ... ]"; | ||||
548 | } | ||||
549 | 807 | 302ms | return $self->$handler ($op, $rhs); # spent 302ms making 807 calls to SQL::Abstract::_where_op_ANDOR, avg 375µs/call | ||
550 | } | ||||
551 | elsif (ref $handler eq 'CODE') { | ||||
552 | return $handler->($self, $op, $rhs); | ||||
553 | } | ||||
554 | else { | ||||
555 | puke "Illegal handler for operator $op - expecting a method name or a coderef"; | ||||
556 | } | ||||
557 | } | ||||
558 | |||||
559 | 477 | 17.2ms | $self->debug("Generic unary OP: $op - recursing as function"); # spent 17.2ms making 477 calls to SQL::Abstract::AUTOLOAD, avg 36µs/call | ||
560 | |||||
561 | 477 | 2.43ms | $self->_assert_pass_injection_guard($op); # spent 2.43ms making 477 calls to SQL::Abstract::_assert_pass_injection_guard, avg 5µs/call | ||
562 | |||||
563 | my ($sql, @bind) = $self->_SWITCH_refkind ($rhs, { | ||||
564 | # spent 8.76ms (4.40+4.36) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:572] which was called 477 times, avg 18µs/call:
# 477 times (4.40ms+4.36ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 18µs/call | ||||
565 | 954 | 3.85ms | puke "Illegal use of top-level '$op'" | ||
566 | unless $self->{_nested_func_lhs}; | ||||
567 | |||||
568 | return ( | ||||
569 | 954 | 4.36ms | $self->_convert('?'), # spent 3.08ms making 477 calls to SQL::Abstract::_bindtype, avg 6µs/call
# spent 1.28ms making 477 calls to SQL::Abstract::_convert, avg 3µs/call | ||
570 | $self->_bindtype($self->{_nested_func_lhs}, $rhs) | ||||
571 | ); | ||||
572 | }, | ||||
573 | FALLBACK => sub { | ||||
574 | $self->_recurse_where ($rhs) | ||||
575 | }, | ||||
576 | 477 | 0s | }); # spent 16.5ms making 477 calls to SQL::Abstract::_SWITCH_refkind, avg 35µs/call, recursion: max depth 1, sum of overlapping time 16.5ms | ||
577 | |||||
578 | 477 | 594µs | $sql = sprintf ('%s %s', # spent 594µs making 477 calls to SQL::Abstract::_sqlcase, avg 1µs/call | ||
579 | $self->_sqlcase($op), | ||||
580 | $sql, | ||||
581 | ); | ||||
582 | |||||
583 | return ($sql, @bind); | ||||
584 | } | ||||
585 | |||||
586 | # spent 302ms (22.5+280) within SQL::Abstract::_where_op_ANDOR which was called 807 times, avg 375µs/call:
# 807 times (22.5ms+280ms) by SQL::Abstract::_where_unary_op at line 549, avg 375µs/call | ||||
587 | 1614 | 22.8ms | my ($self, $op, $v) = @_; | ||
588 | |||||
589 | $self->_SWITCH_refkind($v, { | ||||
590 | # spent 264ms (3.75+260) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:592] which was called 807 times, avg 327µs/call:
# 807 times (3.75ms+260ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 327µs/call | ||||
591 | 807 | 3.43ms | 807 | 260ms | return $self->_where_ARRAYREF($v, $op); # spent 260ms making 807 calls to SQL::Abstract::_where_ARRAYREF, avg 322µs/call |
592 | }, | ||||
593 | |||||
594 | HASHREF => sub { | ||||
595 | return ( $op =~ /^or/i ) | ||||
596 | ? $self->_where_ARRAYREF( [ map { $_ => $v->{$_} } ( sort keys %$v ) ], $op ) | ||||
597 | : $self->_where_HASHREF($v); | ||||
598 | }, | ||||
599 | |||||
600 | SCALARREF => sub { | ||||
601 | puke "-$op => \\\$scalar makes little sense, use " . | ||||
602 | ($op =~ /^or/i | ||||
603 | ? '[ \$scalar, \%rest_of_conditions ] instead' | ||||
604 | : '-and => [ \$scalar, \%rest_of_conditions ] instead' | ||||
605 | ); | ||||
606 | }, | ||||
607 | |||||
608 | ARRAYREFREF => sub { | ||||
609 | puke "-$op => \\[...] makes little sense, use " . | ||||
610 | ($op =~ /^or/i | ||||
611 | ? '[ \[...], \%rest_of_conditions ] instead' | ||||
612 | : '-and => [ \[...], \%rest_of_conditions ] instead' | ||||
613 | ); | ||||
614 | }, | ||||
615 | |||||
616 | SCALAR => sub { # permissively interpreted as SQL | ||||
617 | puke "-$op => \$value makes little sense, use -bool => \$value instead"; | ||||
618 | }, | ||||
619 | |||||
620 | UNDEF => sub { | ||||
621 | puke "-$op => undef not supported"; | ||||
622 | }, | ||||
623 | 807 | 280ms | }); # spent 280ms making 807 calls to SQL::Abstract::_SWITCH_refkind, avg 347µs/call | ||
624 | } | ||||
625 | |||||
626 | sub _where_op_NEST { | ||||
627 | my ($self, $op, $v) = @_; | ||||
628 | |||||
629 | $self->_SWITCH_refkind($v, { | ||||
630 | |||||
631 | SCALAR => sub { # permissively interpreted as SQL | ||||
632 | belch "literal SQL should be -nest => \\'scalar' " | ||||
633 | . "instead of -nest => 'scalar' "; | ||||
634 | return ($v); | ||||
635 | }, | ||||
636 | |||||
637 | UNDEF => sub { | ||||
638 | puke "-$op => undef not supported"; | ||||
639 | }, | ||||
640 | |||||
641 | FALLBACK => sub { | ||||
642 | $self->_recurse_where ($v); | ||||
643 | }, | ||||
644 | |||||
645 | }); | ||||
646 | } | ||||
647 | |||||
648 | |||||
649 | sub _where_op_BOOL { | ||||
650 | my ($self, $op, $v) = @_; | ||||
651 | |||||
652 | my ($s, @b) = $self->_SWITCH_refkind($v, { | ||||
653 | SCALAR => sub { # interpreted as SQL column | ||||
654 | $self->_convert($self->_quote($v)); | ||||
655 | }, | ||||
656 | |||||
657 | UNDEF => sub { | ||||
658 | puke "-$op => undef not supported"; | ||||
659 | }, | ||||
660 | |||||
661 | FALLBACK => sub { | ||||
662 | $self->_recurse_where ($v); | ||||
663 | }, | ||||
664 | }); | ||||
665 | |||||
666 | $s = "(NOT $s)" if $op =~ /^not/i; | ||||
667 | ($s, @b); | ||||
668 | } | ||||
669 | |||||
670 | |||||
671 | sub _where_hashpair_ARRAYREF { | ||||
672 | my ($self, $k, $v) = @_; | ||||
673 | |||||
674 | if( @$v ) { | ||||
675 | my @v = @$v; # need copy because of shift below | ||||
676 | $self->_debug("ARRAY($k) means distribute over elements"); | ||||
677 | |||||
678 | # put apart first element if it is an operator (-and, -or) | ||||
679 | my $op = ( | ||||
680 | (defined $v[0] && $v[0] =~ /^ - (?: AND|OR ) $/ix) | ||||
681 | ? shift @v | ||||
682 | : '' | ||||
683 | ); | ||||
684 | my @distributed = map { {$k => $_} } @v; | ||||
685 | |||||
686 | if ($op) { | ||||
687 | $self->_debug("OP($op) reinjected into the distributed array"); | ||||
688 | unshift @distributed, $op; | ||||
689 | } | ||||
690 | |||||
691 | my $logic = $op ? substr($op, 1) : ''; | ||||
692 | |||||
693 | return $self->_recurse_where(\@distributed, $logic); | ||||
694 | } | ||||
695 | else { | ||||
696 | # LDNOTE : not sure of this one. What does "distribute over nothing" mean? | ||||
697 | $self->_debug("empty ARRAY($k) means 0=1"); | ||||
698 | return ($self->{sqlfalse}); | ||||
699 | } | ||||
700 | } | ||||
701 | |||||
702 | # spent 167ms (39.5+127) within SQL::Abstract::_where_hashpair_HASHREF which was called 624 times, avg 267µs/call:
# 624 times (39.5ms+127ms) by SQL::Abstract::_where_HASHREF at line 527, avg 267µs/call | ||||
703 | 3744 | 8.09ms | my ($self, $k, $v, $logic) = @_; | ||
704 | $logic ||= 'and'; | ||||
705 | |||||
706 | local $self->{_nested_func_lhs} = $self->{_nested_func_lhs}; | ||||
707 | |||||
708 | my ($all_sql, @all_bind); | ||||
709 | |||||
710 | 624 | 177µs | for my $orig_op (sort keys %$v) { # spent 177µs making 624 calls to SQL::Abstract::CORE:sort, avg 283ns/call | ||
711 | 6864 | 22.6ms | my $val = $v->{$orig_op}; | ||
712 | |||||
713 | # put the operator in canonical form | ||||
714 | my $op = $orig_op; | ||||
715 | |||||
716 | # FIXME - we need to phase out dash-less ops | ||||
717 | 624 | 1.07ms | $op =~ s/^-//; # remove possible initial dash # spent 1.07ms making 624 calls to SQL::Abstract::CORE:subst, avg 2µs/call | ||
718 | 624 | 938µs | $op =~ s/^\s+|\s+$//g;# remove leading/trailing space # spent 938µs making 624 calls to SQL::Abstract::CORE:subst, avg 2µs/call | ||
719 | 624 | 621µs | $op =~ s/\s+/ /g; # compress whitespace # spent 621µs making 624 calls to SQL::Abstract::CORE:subst, avg 996ns/call | ||
720 | |||||
721 | 624 | 3.30ms | $self->_assert_pass_injection_guard($op); # spent 3.30ms making 624 calls to SQL::Abstract::_assert_pass_injection_guard, avg 5µs/call | ||
722 | |||||
723 | # so that -not_foo works correctly | ||||
724 | 624 | 369µs | $op =~ s/^not_/NOT /i; # spent 369µs making 624 calls to SQL::Abstract::CORE:subst, avg 591ns/call | ||
725 | |||||
726 | my ($sql, @bind); | ||||
727 | |||||
728 | # CASE: col-value logic modifiers | ||||
729 | 3120 | 24.1ms | 5946 | 15.3ms | if ( $orig_op =~ /^ \- (and|or) $/xi ) { # spent 12.0ms making 624 calls to List::Util::first, avg 19µs/call
# spent 1.97ms making 2349 calls to SQL::Abstract::CORE:regcomp, avg 839ns/call
# spent 1.32ms making 2973 calls to SQL::Abstract::CORE:match, avg 445ns/call |
730 | ($sql, @bind) = $self->_where_hashpair_HASHREF($k, $val, $1); | ||||
731 | } | ||||
732 | # CASE: special operators like -in or -between | ||||
733 | elsif ( my $special_op = List::Util::first {$op =~ $_->{regex}} @{$self->{special_ops}} ) { | ||||
734 | my $handler = $special_op->{handler}; | ||||
735 | 147 | 8.56ms | if (! $handler) { # spent 8.56ms making 147 calls to DBIx::Class::SQLMaker::_where_op_IDENT, avg 58µs/call | ||
736 | puke "No handler supplied for special operator $orig_op"; | ||||
737 | } | ||||
738 | elsif (not ref $handler) { | ||||
739 | ($sql, @bind) = $self->$handler ($k, $op, $val); | ||||
740 | } | ||||
741 | elsif (ref $handler eq 'CODE') { | ||||
742 | ($sql, @bind) = $handler->($self, $k, $op, $val); | ||||
743 | } | ||||
744 | else { | ||||
745 | puke "Illegal handler for special operator $orig_op - expecting a method name or a coderef"; | ||||
746 | } | ||||
747 | } | ||||
748 | else { | ||||
749 | $self->_SWITCH_refkind($val, { | ||||
750 | |||||
751 | ARRAYREF => sub { # CASE: col => {op => \@vals} | ||||
752 | ($sql, @bind) = $self->_where_field_op_ARRAYREF($k, $op, $val); | ||||
753 | }, | ||||
754 | |||||
755 | ARRAYREFREF => sub { # CASE: col => {op => \[$sql, @bind]} (literal SQL with bind) | ||||
756 | my ($sub_sql, @sub_bind) = @$$val; | ||||
757 | $self->_assert_bindval_matches_bindtype(@sub_bind); | ||||
758 | $sql = join ' ', $self->_convert($self->_quote($k)), | ||||
759 | $self->_sqlcase($op), | ||||
760 | $sub_sql; | ||||
761 | @bind = @sub_bind; | ||||
762 | }, | ||||
763 | |||||
764 | UNDEF => sub { # CASE: col => {op => undef} : sql "IS (NOT)? NULL" | ||||
765 | my $is = ($op =~ $self->{equality_op}) ? 'is' : | ||||
766 | ($op =~ $self->{inequality_op}) ? 'is not' : | ||||
767 | puke "unexpected operator '$orig_op' with undef operand"; | ||||
768 | $sql = $self->_quote($k) . $self->_sqlcase(" $is null"); | ||||
769 | }, | ||||
770 | |||||
771 | # spent 90.2ms (13.1+77.1) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:782] which was called 477 times, avg 189µs/call:
# 477 times (13.1ms+77.1ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 189µs/call | ||||
772 | |||||
773 | # retain for proper column type bind | ||||
774 | 1431 | 11.9ms | $self->{_nested_func_lhs} ||= $k; | ||
775 | |||||
776 | 477 | 67.1ms | ($sql, @bind) = $self->_where_unary_op ($op, $val); # spent 67.1ms making 477 calls to SQL::Abstract::_where_unary_op, avg 141µs/call | ||
777 | |||||
778 | 954 | 10.0ms | $sql = join (' ', # spent 9.43ms making 477 calls to DBIx::Class::SQLMaker::_quote, avg 20µs/call
# spent 571µs making 477 calls to SQL::Abstract::_convert, avg 1µs/call | ||
779 | $self->_convert($self->_quote($k)), | ||||
780 | $self->{_nested_func_lhs} eq $k ? $sql : "($sql)", # top level vs nested | ||||
781 | ); | ||||
782 | }, | ||||
783 | 477 | 99.6ms | }); # spent 99.6ms making 477 calls to SQL::Abstract::_SWITCH_refkind, avg 209µs/call | ||
784 | } | ||||
785 | |||||
786 | ($all_sql) = (defined $all_sql and $all_sql) ? $self->_join_sql_clauses($logic, [$all_sql, $sql], []) : $sql; | ||||
787 | push @all_bind, @bind; | ||||
788 | } | ||||
789 | return ($all_sql, @all_bind); | ||||
790 | } | ||||
791 | |||||
- - | |||||
794 | sub _where_field_op_ARRAYREF { | ||||
795 | my ($self, $k, $op, $vals) = @_; | ||||
796 | |||||
797 | my @vals = @$vals; #always work on a copy | ||||
798 | |||||
799 | if(@vals) { | ||||
800 | $self->_debug(sprintf '%s means multiple elements: [ %s ]', | ||||
801 | $vals, | ||||
802 | join (', ', map { defined $_ ? "'$_'" : 'NULL' } @vals ), | ||||
803 | ); | ||||
804 | |||||
805 | # see if the first element is an -and/-or op | ||||
806 | my $logic; | ||||
807 | if (defined $vals[0] && $vals[0] =~ /^ - ( AND|OR ) $/ix) { | ||||
808 | $logic = uc $1; | ||||
809 | shift @vals; | ||||
810 | } | ||||
811 | |||||
812 | # distribute $op over each remaining member of @vals, append logic if exists | ||||
813 | return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic); | ||||
814 | |||||
815 | # LDNOTE : had planned to change the distribution logic when | ||||
816 | # $op =~ $self->{inequality_op}, because of Morgan laws : | ||||
817 | # with {field => {'!=' => [22, 33]}}, it would be ridiculous to generate | ||||
818 | # WHERE field != 22 OR field != 33 : the user probably means | ||||
819 | # WHERE field != 22 AND field != 33. | ||||
820 | # To do this, replace the above to roughly : | ||||
821 | # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR'; | ||||
822 | # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic); | ||||
823 | |||||
824 | } | ||||
825 | else { | ||||
826 | # try to DWIM on equality operators | ||||
827 | # LDNOTE : not 100% sure this is the correct thing to do ... | ||||
828 | return ($self->{sqlfalse}) if $op =~ $self->{equality_op}; | ||||
829 | return ($self->{sqltrue}) if $op =~ $self->{inequality_op}; | ||||
830 | |||||
831 | # otherwise | ||||
832 | puke "operator '$op' applied on an empty array (field '$k')"; | ||||
833 | } | ||||
834 | } | ||||
835 | |||||
836 | |||||
837 | sub _where_hashpair_SCALARREF { | ||||
838 | my ($self, $k, $v) = @_; | ||||
839 | $self->_debug("SCALAR($k) means literal SQL: $$v"); | ||||
840 | my $sql = $self->_quote($k) . " " . $$v; | ||||
841 | return ($sql); | ||||
842 | } | ||||
843 | |||||
844 | # literal SQL with bind | ||||
845 | sub _where_hashpair_ARRAYREFREF { | ||||
846 | my ($self, $k, $v) = @_; | ||||
847 | $self->_debug("REF($k) means literal SQL: @${$v}"); | ||||
848 | my ($sql, @bind) = @$$v; | ||||
849 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
850 | $sql = $self->_quote($k) . " " . $sql; | ||||
851 | return ($sql, @bind ); | ||||
852 | } | ||||
853 | |||||
854 | # literal SQL without bind | ||||
855 | # spent 549ms (232+318) within SQL::Abstract::_where_hashpair_SCALAR which was called 7879 times, avg 70µs/call:
# 7879 times (232ms+318ms) by SQL::Abstract::_where_HASHREF at line 527, avg 70µs/call | ||||
856 | 39395 | 180ms | my ($self, $k, $v) = @_; | ||
857 | 7879 | 19.9ms | $self->_debug("NOREF($k) means simple key=val: $k $self->{cmp} $v"); # spent 19.9ms making 7879 calls to SQL::Abstract::_debug, avg 3µs/call | ||
858 | 31516 | 251ms | my $sql = join ' ', $self->_convert($self->_quote($k)), # spent 198ms making 7879 calls to DBIx::Class::SQLMaker::_quote, avg 25µs/call
# spent 33.0ms making 15758 calls to SQL::Abstract::_convert, avg 2µs/call
# spent 19.7ms making 7879 calls to SQL::Abstract::_sqlcase, avg 3µs/call | ||
859 | $self->_sqlcase($self->{cmp}), | ||||
860 | $self->_convert('?'); | ||||
861 | 7879 | 47.3ms | my @bind = $self->_bindtype($k, $v); # spent 47.3ms making 7879 calls to SQL::Abstract::_bindtype, avg 6µs/call | ||
862 | return ( $sql, @bind); | ||||
863 | } | ||||
864 | |||||
865 | |||||
866 | sub _where_hashpair_UNDEF { | ||||
867 | my ($self, $k, $v) = @_; | ||||
868 | $self->_debug("UNDEF($k) means IS NULL"); | ||||
869 | my $sql = $self->_quote($k) . $self->_sqlcase(' is null'); | ||||
870 | return ($sql); | ||||
871 | } | ||||
872 | |||||
873 | #====================================================================== | ||||
874 | # WHERE: TOP-LEVEL OTHERS (SCALARREF, SCALAR, UNDEF) | ||||
875 | #====================================================================== | ||||
876 | |||||
877 | |||||
878 | # spent 10µs (8+2) within SQL::Abstract::_where_SCALARREF which was called:
# once (8µs+2µs) by SQL::Abstract::_recurse_where at line 417 | ||||
879 | 3 | 8µs | my ($self, $where) = @_; | ||
880 | |||||
881 | # literal sql | ||||
882 | 1 | 2µs | $self->_debug("SCALAR(*top) means literal SQL: $$where"); # spent 2µs making 1 call to SQL::Abstract::_debug | ||
883 | return ($$where); | ||||
884 | } | ||||
885 | |||||
886 | |||||
887 | sub _where_SCALAR { | ||||
888 | my ($self, $where) = @_; | ||||
889 | |||||
890 | # literal sql | ||||
891 | $self->_debug("NOREF(*top) means literal SQL: $where"); | ||||
892 | return ($where); | ||||
893 | } | ||||
894 | |||||
895 | |||||
896 | # spent 1.36ms within SQL::Abstract::_where_UNDEF which was called 387 times, avg 4µs/call:
# 387 times (1.36ms+0s) by SQL::Abstract::_recurse_where at line 417, avg 4µs/call | ||||
897 | 774 | 1.73ms | my ($self) = @_; | ||
898 | return (); | ||||
899 | } | ||||
900 | |||||
901 | |||||
902 | #====================================================================== | ||||
903 | # WHERE: BUILTIN SPECIAL OPERATORS (-in, -between) | ||||
904 | #====================================================================== | ||||
905 | |||||
906 | |||||
907 | sub _where_field_BETWEEN { | ||||
908 | my ($self, $k, $op, $vals) = @_; | ||||
909 | |||||
910 | my ($label, $and, $placeholder); | ||||
911 | $label = $self->_convert($self->_quote($k)); | ||||
912 | $and = ' ' . $self->_sqlcase('and') . ' '; | ||||
913 | $placeholder = $self->_convert('?'); | ||||
914 | $op = $self->_sqlcase($op); | ||||
915 | |||||
916 | my ($clause, @bind) = $self->_SWITCH_refkind($vals, { | ||||
917 | ARRAYREFREF => sub { | ||||
918 | my ($s, @b) = @$$vals; | ||||
919 | $self->_assert_bindval_matches_bindtype(@b); | ||||
920 | ($s, @b); | ||||
921 | }, | ||||
922 | SCALARREF => sub { | ||||
923 | return $$vals; | ||||
924 | }, | ||||
925 | ARRAYREF => sub { | ||||
926 | puke "special op 'between' accepts an arrayref with exactly two values" | ||||
927 | if @$vals != 2; | ||||
928 | |||||
929 | my (@all_sql, @all_bind); | ||||
930 | foreach my $val (@$vals) { | ||||
931 | my ($sql, @bind) = $self->_SWITCH_refkind($val, { | ||||
932 | SCALAR => sub { | ||||
933 | return ($placeholder, $self->_bindtype($k, $val) ); | ||||
934 | }, | ||||
935 | SCALARREF => sub { | ||||
936 | return $$val; | ||||
937 | }, | ||||
938 | ARRAYREFREF => sub { | ||||
939 | my ($sql, @bind) = @$$val; | ||||
940 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
941 | return ($sql, @bind); | ||||
942 | }, | ||||
943 | HASHREF => sub { | ||||
944 | my ($func, $arg, @rest) = %$val; | ||||
945 | puke ("Only simple { -func => arg } functions accepted as sub-arguments to BETWEEN") | ||||
946 | if (@rest or $func !~ /^ \- (.+)/x); | ||||
947 | local $self->{_nested_func_lhs} = $k; | ||||
948 | $self->_where_unary_op ($1 => $arg); | ||||
949 | } | ||||
950 | }); | ||||
951 | push @all_sql, $sql; | ||||
952 | push @all_bind, @bind; | ||||
953 | } | ||||
954 | |||||
955 | return ( | ||||
956 | (join $and, @all_sql), | ||||
957 | @all_bind | ||||
958 | ); | ||||
959 | }, | ||||
960 | FALLBACK => sub { | ||||
961 | puke "special op 'between' accepts an arrayref with two values, or a single literal scalarref/arrayref-ref"; | ||||
962 | }, | ||||
963 | }); | ||||
964 | |||||
965 | my $sql = "( $label $op $clause )"; | ||||
966 | return ($sql, @bind) | ||||
967 | } | ||||
968 | |||||
969 | |||||
970 | sub _where_field_IN { | ||||
971 | my ($self, $k, $op, $vals) = @_; | ||||
972 | |||||
973 | # backwards compatibility : if scalar, force into an arrayref | ||||
974 | $vals = [$vals] if defined $vals && ! ref $vals; | ||||
975 | |||||
976 | my ($label) = $self->_convert($self->_quote($k)); | ||||
977 | my ($placeholder) = $self->_convert('?'); | ||||
978 | $op = $self->_sqlcase($op); | ||||
979 | |||||
980 | my ($sql, @bind) = $self->_SWITCH_refkind($vals, { | ||||
981 | ARRAYREF => sub { # list of choices | ||||
982 | if (@$vals) { # nonempty list | ||||
983 | my (@all_sql, @all_bind); | ||||
984 | |||||
985 | for my $val (@$vals) { | ||||
986 | my ($sql, @bind) = $self->_SWITCH_refkind($val, { | ||||
987 | SCALAR => sub { | ||||
988 | return ($placeholder, $val); | ||||
989 | }, | ||||
990 | SCALARREF => sub { | ||||
991 | return $$val; | ||||
992 | }, | ||||
993 | ARRAYREFREF => sub { | ||||
994 | my ($sql, @bind) = @$$val; | ||||
995 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
996 | return ($sql, @bind); | ||||
997 | }, | ||||
998 | HASHREF => sub { | ||||
999 | my ($func, $arg, @rest) = %$val; | ||||
1000 | puke ("Only simple { -func => arg } functions accepted as sub-arguments to IN") | ||||
1001 | if (@rest or $func !~ /^ \- (.+)/x); | ||||
1002 | local $self->{_nested_func_lhs} = $k; | ||||
1003 | $self->_where_unary_op ($1 => $arg); | ||||
1004 | }, | ||||
1005 | UNDEF => sub { | ||||
1006 | return $self->_sqlcase('null'); | ||||
1007 | }, | ||||
1008 | }); | ||||
1009 | push @all_sql, $sql; | ||||
1010 | push @all_bind, @bind; | ||||
1011 | } | ||||
1012 | |||||
1013 | return ( | ||||
1014 | sprintf ('%s %s ( %s )', | ||||
1015 | $label, | ||||
1016 | $op, | ||||
1017 | join (', ', @all_sql) | ||||
1018 | ), | ||||
1019 | $self->_bindtype($k, @all_bind), | ||||
1020 | ); | ||||
1021 | } | ||||
1022 | else { # empty list : some databases won't understand "IN ()", so DWIM | ||||
1023 | my $sql = ($op =~ /\bnot\b/i) ? $self->{sqltrue} : $self->{sqlfalse}; | ||||
1024 | return ($sql); | ||||
1025 | } | ||||
1026 | }, | ||||
1027 | |||||
1028 | SCALARREF => sub { # literal SQL | ||||
1029 | my $sql = $self->_open_outer_paren ($$vals); | ||||
1030 | return ("$label $op ( $sql )"); | ||||
1031 | }, | ||||
1032 | ARRAYREFREF => sub { # literal SQL with bind | ||||
1033 | my ($sql, @bind) = @$$vals; | ||||
1034 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
1035 | $sql = $self->_open_outer_paren ($sql); | ||||
1036 | return ("$label $op ( $sql )", @bind); | ||||
1037 | }, | ||||
1038 | |||||
1039 | FALLBACK => sub { | ||||
1040 | puke "special op 'in' requires an arrayref (or scalarref/arrayref-ref)"; | ||||
1041 | }, | ||||
1042 | }); | ||||
1043 | |||||
1044 | return ($sql, @bind); | ||||
1045 | } | ||||
1046 | |||||
1047 | # Some databases (SQLite) treat col IN (1, 2) different from | ||||
1048 | # col IN ( (1, 2) ). Use this to strip all outer parens while | ||||
1049 | # adding them back in the corresponding method | ||||
1050 | sub _open_outer_paren { | ||||
1051 | my ($self, $sql) = @_; | ||||
1052 | $sql = $1 while $sql =~ /^ \s* \( (.*) \) \s* $/xs; | ||||
1053 | return $sql; | ||||
1054 | } | ||||
1055 | |||||
1056 | |||||
1057 | #====================================================================== | ||||
1058 | # ORDER BY | ||||
1059 | #====================================================================== | ||||
1060 | |||||
1061 | # spent 98.0ms (24.6+73.3) within SQL::Abstract::_order_by which was called 629 times, avg 156µs/call:
# 629 times (24.6ms+73.3ms) by DBIx::Class::SQLMaker::_order_by at line 28 of mro.pm, avg 156µs/call | ||||
1062 | 3145 | 17.3ms | my ($self, $arg) = @_; | ||
1063 | |||||
1064 | my (@sql, @bind); | ||||
1065 | 629 | 61.5ms | for my $c ($self->_order_by_chunks ($arg) ) { # spent 61.5ms making 629 calls to SQL::Abstract::_order_by_chunks, avg 98µs/call | ||
1066 | $self->_SWITCH_refkind ($c, { | ||||
1067 | 624 | 1.89ms | # spent 993µs within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1067] which was called 624 times, avg 2µs/call:
# 624 times (993µs+0s) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 2µs/call | ||
1068 | 10 | 33µs | # spent 19µs within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1068] which was called 5 times, avg 4µs/call:
# 5 times (19µs+0s) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 4µs/call | ||
1069 | 629 | 6.66ms | 629 | 10.9ms | }); # spent 10.9ms making 629 calls to SQL::Abstract::_SWITCH_refkind, avg 17µs/call |
1070 | } | ||||
1071 | |||||
1072 | 629 | 949µs | my $sql = @sql # spent 949µs making 629 calls to SQL::Abstract::_sqlcase, avg 2µs/call | ||
1073 | ? sprintf ('%s %s', | ||||
1074 | $self->_sqlcase(' order by'), | ||||
1075 | join (', ', @sql) | ||||
1076 | ) | ||||
1077 | : '' | ||||
1078 | ; | ||||
1079 | |||||
1080 | return wantarray ? ($sql, @bind) : $sql; | ||||
1081 | } | ||||
1082 | |||||
1083 | # spent 203ms (92.6+110) within SQL::Abstract::_order_by_chunks which was called 3522 times, avg 58µs/call:
# 2102 times (67.6ms+73.5ms) by DBIx::Class::Storage::DBIHacks::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Storage/DBIHacks.pm:667] at line 660 of DBIx/Class/Storage/DBIHacks.pm, avg 67µs/call
# 781 times (12.2ms+-12.2ms) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1090] at line 1089, avg 0s/call
# 629 times (12.4ms+49.1ms) by SQL::Abstract::_order_by at line 1065, avg 98µs/call
# 10 times (304µs+-304µs) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1135] at line 1117, avg 0s/call | ||||
1084 | 7044 | 92.9ms | my ($self, $arg) = @_; | ||
1085 | |||||
1086 | return $self->_SWITCH_refkind($arg, { | ||||
1087 | |||||
1088 | # spent 48.5ms (4.16+44.4) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1090] which was called 781 times, avg 62µs/call:
# 781 times (4.16ms+44.4ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 62µs/call | ||||
1089 | 1562 | 3.68ms | 781 | 0s | map { $self->_order_by_chunks ($_ ) } @$arg; # spent 44.4ms making 781 calls to SQL::Abstract::_order_by_chunks, avg 57µs/call, recursion: max depth 1, sum of overlapping time 44.4ms |
1090 | }, | ||||
1091 | |||||
1092 | ARRAYREFREF => sub { | ||||
1093 | my ($s, @b) = @$$arg; | ||||
1094 | $self->_assert_bindval_matches_bindtype(@b); | ||||
1095 | [ $s, @b ]; | ||||
1096 | }, | ||||
1097 | |||||
1098 | 781 | 2.58ms | 781 | 14.6ms | # spent 17.6ms (3.00+14.6) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1098] which was called 781 times, avg 23µs/call:
# 781 times (3.00ms+14.6ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 23µs/call # spent 14.6ms making 781 calls to DBIx::Class::SQLMaker::_quote, avg 19µs/call |
1099 | |||||
1100 | 1950 | 6.47ms | # spent 3.01ms within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1100] which was called 1950 times, avg 2µs/call:
# 1950 times (3.01ms+0s) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 2µs/call | ||
1101 | |||||
1102 | SCALARREF => sub {$$arg}, # literal SQL, no quoting | ||||
1103 | |||||
1104 | # spent 2.58ms (758µs+1.82) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1135] which was called 10 times, avg 258µs/call:
# 10 times (758µs+1.82ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 258µs/call | ||||
1105 | # get first pair in hash | ||||
1106 | 70 | 460µs | my ($key, $val, @rest) = %$arg; | ||
1107 | |||||
1108 | return () unless $key; | ||||
1109 | |||||
1110 | 10 | 53µs | if ( @rest or not $key =~ /^-(desc|asc)/i ) { # spent 53µs making 10 calls to SQL::Abstract::CORE:match, avg 5µs/call | ||
1111 | puke "hash passed to _order_by must have exactly one key (-desc or -asc)"; | ||||
1112 | } | ||||
1113 | |||||
1114 | my $direction = $1; | ||||
1115 | |||||
1116 | my @ret; | ||||
1117 | 10 | 0s | for my $c ($self->_order_by_chunks ($val)) { # spent 1.38ms making 10 calls to SQL::Abstract::_order_by_chunks, avg 138µs/call, recursion: max depth 2, sum of overlapping time 1.38ms | ||
1118 | 40 | 282µs | my ($sql, @bind); | ||
1119 | |||||
1120 | $self->_SWITCH_refkind ($c, { | ||||
1121 | # spent 25µs within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1123] which was called 10 times, avg 3µs/call:
# 10 times (25µs+0s) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 3µs/call | ||||
1122 | 10 | 53µs | $sql = $c; | ||
1123 | }, | ||||
1124 | ARRAYREF => sub { | ||||
1125 | ($sql, @bind) = @$c; | ||||
1126 | }, | ||||
1127 | 10 | 0s | }); # spent 352µs making 10 calls to SQL::Abstract::_SWITCH_refkind, avg 35µs/call, recursion: max depth 2, sum of overlapping time 352µs | ||
1128 | |||||
1129 | 10 | 38µs | $sql = $sql . ' ' . $self->_sqlcase($direction); # spent 38µs making 10 calls to SQL::Abstract::_sqlcase, avg 4µs/call | ||
1130 | |||||
1131 | push @ret, [ $sql, @bind]; | ||||
1132 | } | ||||
1133 | |||||
1134 | return @ret; | ||||
1135 | }, | ||||
1136 | 3522 | 123ms | }); # spent 156ms making 3522 calls to SQL::Abstract::_SWITCH_refkind, avg 44µs/call, recursion: max depth 2, sum of overlapping time 33.2ms | ||
1137 | } | ||||
1138 | |||||
1139 | |||||
1140 | #====================================================================== | ||||
1141 | # DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES) | ||||
1142 | #====================================================================== | ||||
1143 | |||||
1144 | # spent 204ms (39.8+165) within SQL::Abstract::_table which was called 1313 times, avg 156µs/call:
# 1313 times (39.8ms+165ms) by DBIx::Class::SQLMaker::_table at line 28 of mro.pm, avg 156µs/call | ||||
1145 | 3939 | 41.8ms | my $self = shift; | ||
1146 | my $from = shift; | ||||
1147 | $self->_SWITCH_refkind($from, { | ||||
1148 | ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;}, | ||||
1149 | 1313 | 11.8ms | 1313 | 84.9ms | # spent 97.6ms (12.7+84.9) within SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1149] which was called 1313 times, avg 74µs/call:
# 1313 times (12.7ms+84.9ms) by SQL::Abstract::_SWITCH_refkind at line 1322, avg 74µs/call # spent 84.9ms making 1313 calls to DBIx::Class::SQLMaker::_quote, avg 65µs/call |
1150 | SCALARREF => sub {$$from}, | ||||
1151 | ARRAYREFREF => sub {join ', ', @$from;}, | ||||
1152 | 1313 | 165ms | }); # spent 165ms making 1313 calls to SQL::Abstract::_SWITCH_refkind, avg 125µs/call | ||
1153 | } | ||||
1154 | |||||
1155 | |||||
1156 | #====================================================================== | ||||
1157 | # UTILITY FUNCTIONS | ||||
1158 | #====================================================================== | ||||
1159 | |||||
1160 | # highly optimized, as it's called way too often | ||||
1161 | # spent 923ms (346+578) within SQL::Abstract::_quote which was called 63788 times, avg 14µs/call:
# 63788 times (346ms+578ms) by DBIx::Class::SQLMaker::_quote at line 28 of mro.pm, avg 14µs/call | ||||
1162 | # my ($self, $label) = @_; | ||||
1163 | |||||
1164 | 194892 | 91.6ms | return '' unless defined $_[1]; | ||
1165 | return ${$_[1]} if ref($_[1]) eq 'SCALAR'; | ||||
1166 | |||||
1167 | 125812 | 263ms | unless ($_[0]->{quote_char}) { | ||
1168 | 62906 | 578ms | $_[0]->_assert_pass_injection_guard($_[1]); # spent 578ms making 62906 calls to SQL::Abstract::_assert_pass_injection_guard, avg 9µs/call | ||
1169 | return $_[1]; | ||||
1170 | } | ||||
1171 | |||||
1172 | my $qref = ref $_[0]->{quote_char}; | ||||
1173 | my ($l, $r); | ||||
1174 | if (!$qref) { | ||||
1175 | ($l, $r) = ( $_[0]->{quote_char}, $_[0]->{quote_char} ); | ||||
1176 | } | ||||
1177 | elsif ($qref eq 'ARRAY') { | ||||
1178 | ($l, $r) = @{$_[0]->{quote_char}}; | ||||
1179 | } | ||||
1180 | else { | ||||
1181 | puke "Unsupported quote_char format: $_[0]->{quote_char}"; | ||||
1182 | } | ||||
1183 | |||||
1184 | # parts containing * are naturally unquoted | ||||
1185 | return join( $_[0]->{name_sep}||'', map | ||||
1186 | { $_ eq '*' ? $_ : $l . $_ . $r } | ||||
1187 | ( $_[0]->{name_sep} ? split (/\Q$_[0]->{name_sep}\E/, $_[1] ) : $_[1] ) | ||||
1188 | ); | ||||
1189 | } | ||||
1190 | |||||
1191 | |||||
1192 | # Conversion, if applicable | ||||
1193 | # spent 35.3ms within SQL::Abstract::_convert which was called 17006 times, avg 2µs/call:
# 15758 times (33.0ms+0s) by SQL::Abstract::_where_hashpair_SCALAR at line 858, avg 2µs/call
# 477 times (1.28ms+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:572] at line 569, avg 3µs/call
# 477 times (571µs+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:782] at line 778, avg 1µs/call
# 294 times (463µs+0s) by DBIx::Class::SQLMaker::_where_op_IDENT at line 129 of DBIx/Class/SQLMaker.pm, avg 2µs/call | ||||
1194 | #my ($self, $arg) = @_; | ||||
1195 | |||||
1196 | # LDNOTE : modified the previous implementation below because | ||||
1197 | # it was not consistent : the first "return" is always an array, | ||||
1198 | # the second "return" is context-dependent. Anyway, _convert | ||||
1199 | # seems always used with just a single argument, so make it a | ||||
1200 | # scalar function. | ||||
1201 | # return @_ unless $self->{convert}; | ||||
1202 | # my $conv = $self->_sqlcase($self->{convert}); | ||||
1203 | # my @ret = map { $conv.'('.$_.')' } @_; | ||||
1204 | # return wantarray ? @ret : $ret[0]; | ||||
1205 | 34012 | 50.8ms | if ($_[0]->{convert}) { | ||
1206 | return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')'; | ||||
1207 | } | ||||
1208 | return $_[1]; | ||||
1209 | } | ||||
1210 | |||||
1211 | # And bindtype | ||||
1212 | # spent 71.6ms within SQL::Abstract::_bindtype which was called 11300 times, avg 6µs/call:
# 7879 times (47.3ms+0s) by SQL::Abstract::_where_hashpair_SCALAR at line 861, avg 6µs/call
# 1952 times (12.0ms+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:257] at line 256, avg 6µs/call
# 992 times (9.21ms+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:327] at line 326, avg 9µs/call
# 477 times (3.08ms+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:572] at line 569, avg 6µs/call | ||||
1213 | #my ($self, $col, @vals) = @_; | ||||
1214 | |||||
1215 | #LDNOTE : changed original implementation below because it did not make | ||||
1216 | # sense when bindtype eq 'columns' and @vals > 1. | ||||
1217 | # return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals; | ||||
1218 | |||||
1219 | # called often - tighten code | ||||
1220 | return $_[0]->{bindtype} eq 'columns' | ||||
1221 | 11300 | 90.1ms | ? map {[$_[1], $_]} @_[2 .. $#_] | ||
1222 | : @_[2 .. $#_] | ||||
1223 | ; | ||||
1224 | } | ||||
1225 | |||||
1226 | # Dies if any element of @bind is not in [colname => value] format | ||||
1227 | # if bindtype is 'columns'. | ||||
1228 | sub _assert_bindval_matches_bindtype { | ||||
1229 | # my ($self, @bind) = @_; | ||||
1230 | my $self = shift; | ||||
1231 | if ($self->{bindtype} eq 'columns') { | ||||
1232 | for (@_) { | ||||
1233 | if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) { | ||||
1234 | puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]" | ||||
1235 | } | ||||
1236 | } | ||||
1237 | } | ||||
1238 | } | ||||
1239 | |||||
1240 | sub _join_sql_clauses { | ||||
1241 | 19810 | 50.5ms | my ($self, $logic, $clauses_aref, $bind_aref) = @_; | ||
1242 | |||||
1243 | 3081 | 8.20ms | if (@$clauses_aref > 1) { | ||
1244 | 1027 | 1.55ms | my $join = " " . $self->_sqlcase($logic) . " "; # spent 1.55ms making 1027 calls to SQL::Abstract::_sqlcase, avg 2µs/call | ||
1245 | my $sql = '( ' . join($join, @$clauses_aref) . ' )'; | ||||
1246 | return ($sql, @$bind_aref); | ||||
1247 | } | ||||
1248 | elsif (@$clauses_aref) { | ||||
1249 | return ($clauses_aref->[0], @$bind_aref); # no parentheses | ||||
1250 | } | ||||
1251 | else { | ||||
1252 | return (); # if no SQL, ignore @$bind_aref | ||||
1253 | } | ||||
1254 | } | ||||
1255 | |||||
1256 | |||||
1257 | # Fix SQL case, if so requested | ||||
1258 | # spent 75.6ms within SQL::Abstract::_sqlcase which was called 36128 times, avg 2µs/call:
# 13412 times (21.2ms+0s) by SQL::Abstract::select at line 363, avg 2µs/call
# 7879 times (19.7ms+0s) by SQL::Abstract::_where_hashpair_SCALAR at line 858, avg 3µs/call
# 7183 times (12.5ms+0s) by SQL::Abstract::where at line 400, avg 2µs/call
# 1949 times (7.40ms+0s) by DBIx::Class::SQLMaker::_recurse_fields at line 300 of DBIx/Class/SQLMaker.pm, avg 4µs/call
# 1690 times (5.85ms+0s) by SQL::Abstract::update at line 332, avg 3µs/call
# 1027 times (1.55ms+0s) by SQL::Abstract::_join_sql_clauses at line 1244, avg 2µs/call
# 954 times (2.12ms+0s) by SQL::Abstract::generate at line 1422, avg 2µs/call
# 629 times (949µs+0s) by SQL::Abstract::_order_by at line 1072, avg 2µs/call
# 477 times (594µs+0s) by SQL::Abstract::_where_unary_op at line 578, avg 1µs/call
# 449 times (2.16ms+0s) by SQL::Abstract::_insert_values at line 263, avg 5µs/call
# 449 times (1.33ms+0s) by SQL::Abstract::insert at line 143, avg 3µs/call
# 19 times (123µs+0s) by SQL::Abstract::delete at line 382, avg 6µs/call
# 10 times (38µs+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1135] at line 1129, avg 4µs/call
# once (3µs+0s) by DBIx::Class::SQLMaker::_parse_rs_attrs at line 338 of DBIx/Class/SQLMaker.pm | ||||
1259 | # LDNOTE: if $self->{case} is true, then it contains 'lower', so we | ||||
1260 | # don't touch the argument ... crooked logic, but let's not change it! | ||||
1261 | 36128 | 122ms | return $_[0]->{case} ? $_[1] : uc($_[1]); | ||
1262 | } | ||||
1263 | |||||
1264 | |||||
1265 | #====================================================================== | ||||
1266 | # DISPATCHING FROM REFKIND | ||||
1267 | #====================================================================== | ||||
1268 | |||||
1269 | # spent 206ms (184+21.5) within SQL::Abstract::_refkind which was called 30239 times, avg 7µs/call:
# 30239 times (184ms+21.5ms) by SQL::Abstract::_try_refkind at line 1291, avg 7µs/call | ||||
1270 | 155917 | 241ms | my ($self, $data) = @_; | ||
1271 | |||||
1272 | return 'UNDEF' unless defined $data; | ||||
1273 | |||||
1274 | # blessed objects are treated like scalars | ||||
1275 | 27624 | 21.5ms | my $ref = (Scalar::Util::blessed $data) ? '' : ref $data; # spent 21.5ms making 27624 calls to Scalar::Util::blessed, avg 779ns/call | ||
1276 | |||||
1277 | return 'SCALAR' unless $ref; | ||||
1278 | |||||
1279 | my $n_steps = 1; | ||||
1280 | while ($ref eq 'REF') { | ||||
1281 | $data = $$data; | ||||
1282 | $ref = (Scalar::Util::blessed $data) ? '' : ref $data; | ||||
1283 | $n_steps++ if $ref; | ||||
1284 | } | ||||
1285 | |||||
1286 | return ($ref||'SCALAR') . ('REF' x $n_steps); | ||||
1287 | } | ||||
1288 | |||||
1289 | sub _try_refkind { | ||||
1290 | 151195 | 236ms | my ($self, $data) = @_; | ||
1291 | 30239 | 206ms | my @try = ($self->_refkind($data)); # spent 206ms making 30239 calls to SQL::Abstract::_refkind, avg 7µs/call | ||
1292 | push @try, 'SCALAR_or_UNDEF' if $try[0] eq 'SCALAR' || $try[0] eq 'UNDEF'; | ||||
1293 | push @try, 'FALLBACK'; | ||||
1294 | return \@try; | ||||
1295 | } | ||||
1296 | |||||
1297 | # spent 509ms (208+302) within SQL::Abstract::_METHOD_FOR_refkind which was called 18438 times, avg 28µs/call:
# 9486 times (124ms+186ms) by SQL::Abstract::_recurse_where at line 415, avg 33µs/call
# 8503 times (74.2ms+103ms) by SQL::Abstract::_where_HASHREF at line 526, avg 21µs/call
# 449 times (9.52ms+12.6ms) by SQL::Abstract::insert at line 141, avg 49µs/call | ||||
1298 | 73752 | 121ms | my ($self, $meth_prefix, $data) = @_; | ||
1299 | |||||
1300 | my $method; | ||||
1301 | 18438 | 272ms | for (@{$self->_try_refkind($data)}) { # spent 272ms making 18438 calls to SQL::Abstract::_try_refkind, avg 15µs/call | ||
1302 | 18438 | 113ms | 18438 | 29.9ms | $method = $self->can($meth_prefix."_".$_) # spent 29.9ms making 18438 calls to UNIVERSAL::can, avg 2µs/call |
1303 | and last; | ||||
1304 | } | ||||
1305 | |||||
1306 | return $method || puke "cannot dispatch on '$meth_prefix' for ".$self->_refkind($data); | ||||
1307 | } | ||||
1308 | |||||
1309 | |||||
1310 | # spent 827ms (147+679) within SQL::Abstract::_SWITCH_refkind which was called 11801 times, avg 70µs/call:
# 3522 times (40.1ms+82.5ms) by SQL::Abstract::_order_by_chunks at line 1136, avg 35µs/call
# 1952 times (29.0ms+62.2ms) by SQL::Abstract::_insert_values at line 259, avg 47µs/call
# 1622 times (11.5ms+-8.83ms) by SQL::Abstract::_where_ARRAYREF at line 468, avg 2µs/call
# 1313 times (29.5ms+135ms) by SQL::Abstract::_table at line 1152, avg 125µs/call
# 992 times (15.8ms+39.5ms) by SQL::Abstract::update at line 328, avg 56µs/call
# 807 times (7.78ms+272ms) by SQL::Abstract::_where_op_ANDOR at line 623, avg 347µs/call
# 629 times (4.61ms+6.32ms) by SQL::Abstract::_order_by at line 1069, avg 17µs/call
# 477 times (5.11ms+94.5ms) by SQL::Abstract::_where_hashpair_HASHREF at line 783, avg 209µs/call
# 477 times (3.76ms+-3.76ms) by SQL::Abstract::_where_unary_op at line 576, avg 0s/call
# 10 times (149µs+-149µs) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1135] at line 1127, avg 0s/call | ||||
1311 | 59005 | 105ms | my ($self, $data, $dispatch_table) = @_; | ||
1312 | |||||
1313 | my $coderef; | ||||
1314 | 11801 | 172ms | for (@{$self->_try_refkind($data)}) { # spent 172ms making 11801 calls to SQL::Abstract::_try_refkind, avg 15µs/call | ||
1315 | 15699 | 22.4ms | $coderef = $dispatch_table->{$_} | ||
1316 | and last; | ||||
1317 | } | ||||
1318 | |||||
1319 | puke "no dispatch entry for ".$self->_refkind($data) | ||||
1320 | unless $coderef; | ||||
1321 | |||||
1322 | 11801 | 763ms | $coderef->(); # spent 264ms making 807 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:592], avg 327µs/call
# spent 182ms making 1622 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:455], avg 112µs/call
# spent 97.6ms making 1313 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1149], avg 74µs/call
# spent 90.2ms making 477 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:782], avg 189µs/call
# spent 48.5ms making 781 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1090], avg 62µs/call
# spent 27.9ms making 1952 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:257], avg 14µs/call
# spent 20.4ms making 992 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:327], avg 21µs/call
# spent 17.6ms making 781 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1098], avg 23µs/call
# spent 8.76ms making 477 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:572], avg 18µs/call
# spent 3.01ms making 1950 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1100], avg 2µs/call
# spent 2.58ms making 10 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1135], avg 258µs/call
# spent 993µs making 624 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1067], avg 2µs/call
# spent 25µs making 10 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1123], avg 3µs/call
# spent 19µs making 5 calls to SQL::Abstract::__ANON__[SQL/Abstract.pm:1068], avg 4µs/call | ||
1323 | } | ||||
1324 | |||||
- - | |||||
1328 | #====================================================================== | ||||
1329 | # VALUES, GENERATE, AUTOLOAD | ||||
1330 | #====================================================================== | ||||
1331 | |||||
1332 | # LDNOTE: original code from nwiger, didn't touch code in that section | ||||
1333 | # I feel the AUTOLOAD stuff should not be the default, it should | ||||
1334 | # only be activated on explicit demand by user. | ||||
1335 | |||||
1336 | sub values { | ||||
1337 | my $self = shift; | ||||
1338 | my $data = shift || return; | ||||
1339 | puke "Argument to ", __PACKAGE__, "->values must be a \\%hash" | ||||
1340 | unless ref $data eq 'HASH'; | ||||
1341 | |||||
1342 | my @all_bind; | ||||
1343 | foreach my $k ( sort keys %$data ) { | ||||
1344 | my $v = $data->{$k}; | ||||
1345 | $self->_SWITCH_refkind($v, { | ||||
1346 | ARRAYREF => sub { | ||||
1347 | if ($self->{array_datatypes}) { # array datatype | ||||
1348 | push @all_bind, $self->_bindtype($k, $v); | ||||
1349 | } | ||||
1350 | else { # literal SQL with bind | ||||
1351 | my ($sql, @bind) = @$v; | ||||
1352 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
1353 | push @all_bind, @bind; | ||||
1354 | } | ||||
1355 | }, | ||||
1356 | ARRAYREFREF => sub { # literal SQL with bind | ||||
1357 | my ($sql, @bind) = @${$v}; | ||||
1358 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
1359 | push @all_bind, @bind; | ||||
1360 | }, | ||||
1361 | SCALARREF => sub { # literal SQL without bind | ||||
1362 | }, | ||||
1363 | SCALAR_or_UNDEF => sub { | ||||
1364 | push @all_bind, $self->_bindtype($k, $v); | ||||
1365 | }, | ||||
1366 | }); | ||||
1367 | } | ||||
1368 | |||||
1369 | return @all_bind; | ||||
1370 | } | ||||
1371 | |||||
1372 | # spent 11.7ms (9.23+2.49) within SQL::Abstract::generate which was called 477 times, avg 25µs/call:
# 477 times (9.23ms+2.49ms) by SQL::Abstract::AUTOLOAD at line 1447, avg 25µs/call | ||||
1373 | 2385 | 1.94ms | my $self = shift; | ||
1374 | |||||
1375 | my(@sql, @sqlq, @sqlv); | ||||
1376 | |||||
1377 | for (@_) { | ||||
1378 | 1908 | 1.92ms | my $ref = ref $_; | ||
1379 | 954 | 1.85ms | if ($ref eq 'HASH') { | ||
1380 | for my $k (sort keys %$_) { | ||||
1381 | my $v = $_->{$k}; | ||||
1382 | my $r = ref $v; | ||||
1383 | my $label = $self->_quote($k); | ||||
1384 | if ($r eq 'ARRAY') { | ||||
1385 | # literal SQL with bind | ||||
1386 | my ($sql, @bind) = @$v; | ||||
1387 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
1388 | push @sqlq, "$label = $sql"; | ||||
1389 | push @sqlv, @bind; | ||||
1390 | } elsif ($r eq 'SCALAR') { | ||||
1391 | # literal SQL without bind | ||||
1392 | push @sqlq, "$label = $$v"; | ||||
1393 | } else { | ||||
1394 | push @sqlq, "$label = ?"; | ||||
1395 | push @sqlv, $self->_bindtype($k, $v); | ||||
1396 | } | ||||
1397 | } | ||||
1398 | push @sql, $self->_sqlcase('set'), join ', ', @sqlq; | ||||
1399 | } elsif ($ref eq 'ARRAY') { | ||||
1400 | # unlike insert(), assume these are ONLY the column names, i.e. for SQL | ||||
1401 | for my $v (@$_) { | ||||
1402 | my $r = ref $v; | ||||
1403 | if ($r eq 'ARRAY') { # literal SQL with bind | ||||
1404 | my ($sql, @bind) = @$v; | ||||
1405 | $self->_assert_bindval_matches_bindtype(@bind); | ||||
1406 | push @sqlq, $sql; | ||||
1407 | push @sqlv, @bind; | ||||
1408 | } elsif ($r eq 'SCALAR') { # literal SQL without bind | ||||
1409 | # embedded literal SQL | ||||
1410 | push @sqlq, $$v; | ||||
1411 | } else { | ||||
1412 | push @sqlq, '?'; | ||||
1413 | push @sqlv, $v; | ||||
1414 | } | ||||
1415 | } | ||||
1416 | push @sql, '(' . join(', ', @sqlq) . ')'; | ||||
1417 | } elsif ($ref eq 'SCALAR') { | ||||
1418 | # literal SQL | ||||
1419 | push @sql, $$_; | ||||
1420 | } else { | ||||
1421 | # strings get case twiddled | ||||
1422 | 954 | 2.12ms | push @sql, $self->_sqlcase($_); # spent 2.12ms making 954 calls to SQL::Abstract::_sqlcase, avg 2µs/call | ||
1423 | } | ||||
1424 | } | ||||
1425 | |||||
1426 | my $sql = join ' ', @sql; | ||||
1427 | |||||
1428 | # this is pretty tricky | ||||
1429 | # if ask for an array, return ($stmt, @bind) | ||||
1430 | # otherwise, s/?/shift @sqlv/ to put it inline | ||||
1431 | 954 | 2.84ms | if (wantarray) { | ||
1432 | return ($sql, @sqlv); | ||||
1433 | } else { | ||||
1434 | 477 | 367µs | 1 while $sql =~ s/\?/my $d = shift(@sqlv); # spent 367µs making 477 calls to SQL::Abstract::CORE:subst, avg 769ns/call | ||
1435 | ref $d ? $d->[1] : $d/e; | ||||
1436 | return $sql; | ||||
1437 | } | ||||
1438 | } | ||||
1439 | |||||
1440 | |||||
1441 | sub DESTROY { 1 } | ||||
1442 | |||||
1443 | # spent 17.2ms (3.59+13.6) within SQL::Abstract::AUTOLOAD which was called 477 times, avg 36µs/call:
# 477 times (3.59ms+13.6ms) by SQL::Abstract::_where_unary_op at line 559, avg 36µs/call | ||||
1444 | # This allows us to check for a local, then _form, attr | ||||
1445 | 1431 | 5.68ms | my $self = shift; | ||
1446 | 477 | 1.86ms | my($name) = $AUTOLOAD =~ /.*::(.+)/; # spent 1.86ms making 477 calls to SQL::Abstract::CORE:match, avg 4µs/call | ||
1447 | 477 | 11.7ms | return $self->generate($name, @_); # spent 11.7ms making 477 calls to SQL::Abstract::generate, avg 25µs/call | ||
1448 | } | ||||
1449 | |||||
1450 | 1 | 12µs | 1; | ||
1451 | |||||
- - | |||||
1454 | __END__ | ||||
# spent 210ms within SQL::Abstract::CORE:match which was called 81254 times, avg 3µs/call:
# 64007 times (193ms+0s) by SQL::Abstract::_assert_pass_injection_guard at line 122, avg 3µs/call
# 9310 times (7.77ms+0s) by SQL::Abstract::_where_HASHREF at line 503, avg 834ns/call
# 3669 times (4.60ms+0s) by List::Util::first at line 541, avg 1µs/call
# 2973 times (1.32ms+0s) by List::Util::first or SQL::Abstract::_where_hashpair_HASHREF at line 729, avg 445ns/call
# 807 times (1.49ms+0s) by List::Util::first at line 518, avg 2µs/call
# 477 times (1.86ms+0s) by SQL::Abstract::AUTOLOAD at line 1446, avg 4µs/call
# 10 times (53µs+0s) by SQL::Abstract::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Abstract.pm:1135] at line 1110, avg 5µs/call
# once (5µs+0s) by base::import at line 21 | |||||
# spent 55µs within SQL::Abstract::CORE:qr which was called 21 times, avg 3µs/call:
# 5 times (26µs+0s) by SQL::Abstract::new at line 87, avg 5µs/call
# 5 times (10µs+0s) by SQL::Abstract::new at line 88, avg 2µs/call
# 5 times (9µs+0s) by SQL::Abstract::new at line 111, avg 2µs/call
# 4 times (4µs+0s) by base::import at line 33, avg 1µs/call
# 2 times (5µs+0s) by base::import at line 27, avg 3µs/call | |||||
# spent 71.0ms within SQL::Abstract::CORE:regcomp which was called 70837 times, avg 1µs/call:
# 64007 times (64.7ms+0s) by SQL::Abstract::_assert_pass_injection_guard at line 122, avg 1µs/call
# 3669 times (3.56ms+0s) by List::Util::first at line 541, avg 969ns/call
# 2349 times (1.97ms+0s) by List::Util::first at line 729, avg 839ns/call
# 807 times (769µs+0s) by List::Util::first at line 518, avg 953ns/call
# 5 times (28µs+0s) by SQL::Abstract::new at line 87, avg 6µs/call | |||||
# spent 17.1ms within SQL::Abstract::CORE:sort which was called 11461 times, avg 1µs/call:
# 9094 times (11.7ms+0s) by SQL::Abstract::_where_HASHREF at line 498, avg 1µs/call
# 845 times (1.92ms+0s) by SQL::Abstract::update at line 285, avg 2µs/call
# 624 times (177µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 710, avg 283ns/call
# 449 times (2.71ms+0s) by SQL::Abstract::_insert_HASHREF at line 170, avg 6µs/call
# 449 times (652µs+0s) by SQL::Abstract::_insert_values at line 217, avg 1µs/call | |||||
# spent 8.32ms within SQL::Abstract::CORE:subst which was called 6201 times, avg 1µs/call:
# 807 times (1.87ms+0s) by SQL::Abstract::_where_HASHREF at line 507, avg 2µs/call
# 807 times (1.76ms+0s) by SQL::Abstract::_where_unary_op at line 545, avg 2µs/call
# 807 times (912µs+0s) by SQL::Abstract::_where_HASHREF at line 508, avg 1µs/call
# 807 times (415µs+0s) by SQL::Abstract::_where_HASHREF at line 511, avg 514ns/call
# 624 times (1.07ms+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 717, avg 2µs/call
# 624 times (938µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 718, avg 2µs/call
# 624 times (621µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 719, avg 996ns/call
# 624 times (369µs+0s) by SQL::Abstract::_where_hashpair_HASHREF at line 724, avg 591ns/call
# 477 times (367µs+0s) by SQL::Abstract::generate at line 1434, avg 769ns/call |