| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package # hide from PAUSE |
|
2
|
|
|
|
|
|
|
DBIx::DBO::DBD; |
|
3
|
|
|
|
|
|
|
|
|
4
|
11
|
|
|
11
|
|
68
|
use strict; |
|
|
11
|
|
|
|
|
27
|
|
|
|
11
|
|
|
|
|
11158
|
|
|
5
|
11
|
|
|
11
|
|
79
|
use warnings; |
|
|
11
|
|
|
|
|
22
|
|
|
|
11
|
|
|
|
|
1232
|
|
|
6
|
11
|
|
|
11
|
|
59
|
use Carp 'croak'; |
|
|
11
|
|
|
|
|
22
|
|
|
|
11
|
|
|
|
|
7101
|
|
|
7
|
11
|
|
|
11
|
|
77
|
use Scalar::Util 'blessed'; |
|
|
11
|
|
|
|
|
20
|
|
|
|
11
|
|
|
|
|
881
|
|
|
8
|
11
|
|
|
11
|
|
64
|
use constant PLACEHOLDER => "\x{b1}\x{a4}\x{221e}"; |
|
|
11
|
|
|
|
|
20
|
|
|
|
11
|
|
|
|
|
65280
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our @CARP_NOT = qw(DBIx::DBO DBIx::DBO::DBD DBIx::DBO::Table DBIx::DBO::Query DBIx::DBO::Row); |
|
11
|
|
|
|
|
|
|
*DBIx::DBO::CARP_NOT = \@CARP_NOT; |
|
12
|
|
|
|
|
|
|
*DBIx::DBO::Table::CARP_NOT = \@CARP_NOT; |
|
13
|
|
|
|
|
|
|
*DBIx::DBO::Query::CARP_NOT = \@CARP_NOT; |
|
14
|
|
|
|
|
|
|
*DBIx::DBO::Row::CARP_NOT = \@CARP_NOT; |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $placeholder = PLACEHOLDER; |
|
17
|
|
|
|
|
|
|
$placeholder = qr/\Q$placeholder/; |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub _isa { |
|
20
|
2068
|
|
|
2068
|
|
4097
|
my($me, @class) = @_; |
|
21
|
2068
|
100
|
|
|
|
9826
|
if (blessed $me) { |
|
22
|
820
|
|
100
|
|
|
8934
|
$me->isa($_) and return 1 for @class; |
|
23
|
|
|
|
|
|
|
} |
|
24
|
|
|
|
|
|
|
} |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _init_dbo { |
|
27
|
13
|
|
|
13
|
|
30
|
my($class, $me) = @_; |
|
28
|
13
|
|
|
|
|
75
|
return $me; |
|
29
|
|
|
|
|
|
|
} |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub _get_table_schema { |
|
32
|
0
|
|
|
0
|
|
0
|
my($class, $me, $schema, $table) = @_; |
|
33
|
|
|
|
|
|
|
|
|
34
|
0
|
|
|
|
|
0
|
my $q_schema = $schema; |
|
35
|
0
|
|
|
|
|
0
|
my $q_table = $table; |
|
36
|
0
|
0
|
|
|
|
0
|
$q_schema =~ s/([\\_%])/\\$1/g if defined $q_schema; |
|
37
|
0
|
|
|
|
|
0
|
$q_table =~ s/([\\_%])/\\$1/g; |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# First try just these types |
|
40
|
0
|
|
|
|
|
0
|
my $info = $me->rdbh->table_info(undef, $q_schema, $q_table, |
|
41
|
|
|
|
|
|
|
'TABLE,VIEW,GLOBAL TEMPORARY,LOCAL TEMPORARY,SYSTEM TABLE')->fetchall_arrayref; |
|
42
|
|
|
|
|
|
|
# Then if we found nothing, try any type |
|
43
|
0
|
0
|
0
|
|
|
0
|
$info = $me->rdbh->table_info(undef, $q_schema, $q_table)->fetchall_arrayref if $info and @$info == 0; |
|
44
|
0
|
0
|
0
|
|
|
0
|
croak 'Invalid table: '.$class->_qi($me, $schema, $table) unless $info and @$info == 1 and $info->[0][2] eq $table; |
|
|
|
|
0
|
|
|
|
|
|
45
|
0
|
|
|
|
|
0
|
return $info->[0][1]; |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _get_column_info { |
|
49
|
3
|
|
|
3
|
|
8
|
my($class, $me, $schema, $table) = @_; |
|
50
|
|
|
|
|
|
|
|
|
51
|
3
|
|
|
|
|
13
|
my $cols = $me->rdbh->column_info(undef, $schema, $table, '%'); |
|
52
|
3
|
|
100
|
|
|
10808
|
$cols = $cols && $cols->fetchall_arrayref({}) || []; |
|
53
|
3
|
100
|
|
|
|
408
|
croak 'Invalid table: '.$class->_qi($me, $schema, $table) unless @$cols; |
|
54
|
|
|
|
|
|
|
|
|
55
|
2
|
|
|
|
|
5
|
return map { $_->{COLUMN_NAME} => $_->{ORDINAL_POSITION} } @$cols; |
|
|
5
|
|
|
|
|
31
|
|
|
56
|
|
|
|
|
|
|
} |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub _get_table_info { |
|
59
|
3
|
|
|
3
|
|
12
|
my($class, $me, $schema, $table) = @_; |
|
60
|
|
|
|
|
|
|
|
|
61
|
3
|
|
|
|
|
81
|
my %h; |
|
62
|
3
|
|
|
|
|
27
|
$h{Column_Idx} = { $class->_get_column_info($me, $schema, $table) }; |
|
63
|
2
|
|
|
|
|
5
|
$h{Columns} = [ sort { $h{Column_Idx}{$a} <=> $h{Column_Idx}{$b} } keys %{$h{Column_Idx}} ]; |
|
|
4
|
|
|
|
|
15
|
|
|
|
2
|
|
|
|
|
14
|
|
|
64
|
|
|
|
|
|
|
|
|
65
|
2
|
|
|
|
|
6
|
$h{PrimaryKeys} = []; |
|
66
|
2
|
|
|
|
|
25
|
$class->_set_table_key_info($me, $schema, $table, \%h); |
|
67
|
|
|
|
|
|
|
|
|
68
|
2
|
50
|
|
|
|
227
|
return $me->{TableInfo}{defined $schema ? $schema : ''}{$table} = \%h; |
|
69
|
|
|
|
|
|
|
} |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub _set_table_key_info { |
|
72
|
2
|
|
|
2
|
|
4
|
my($class, $me, $schema, $table, $h) = @_; |
|
73
|
|
|
|
|
|
|
|
|
74
|
2
|
50
|
|
|
|
8
|
if (my $sth = $me->rdbh->primary_key_info(undef, $schema, $table)) { |
|
75
|
2
|
|
|
|
|
1424
|
$h->{PrimaryKeys}[$_->{KEY_SEQ} - 1] = $_->{COLUMN_NAME} for @{$sth->fetchall_arrayref({})}; |
|
|
2
|
|
|
|
|
9
|
|
|
76
|
|
|
|
|
|
|
} |
|
77
|
|
|
|
|
|
|
} |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub _unquote_table { |
|
80
|
18
|
|
|
18
|
|
38
|
my($class, $me, $table) = @_; |
|
81
|
|
|
|
|
|
|
# TODO: Better splitting of: schema.table or `schema`.`table` or "schema"."table"@"catalog" or ... |
|
82
|
18
|
50
|
|
|
|
167
|
$table =~ /^(?:("|)(.+)\1\.|)("|)(.+)\3$/ or croak "Invalid table: \"$table\""; |
|
83
|
18
|
|
|
|
|
134
|
return ($2, $4); |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub _selectrow_array { |
|
87
|
3
|
|
|
3
|
|
9
|
my($class, $me, $sql, $attr, @bind) = @_; |
|
88
|
3
|
|
|
|
|
11
|
$class->_sql($me, $sql, @bind); |
|
89
|
3
|
|
|
|
|
12
|
$me->rdbh->selectrow_array($sql, $attr, @bind); |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _selectrow_arrayref { |
|
93
|
4
|
|
|
4
|
|
13
|
my($class, $me, $sql, $attr, @bind) = @_; |
|
94
|
4
|
|
|
|
|
16
|
$class->_sql($me, $sql, @bind); |
|
95
|
4
|
|
|
|
|
13
|
$me->rdbh->selectrow_arrayref($sql, $attr, @bind); |
|
96
|
|
|
|
|
|
|
} |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub _selectrow_hashref { |
|
99
|
1
|
|
|
1
|
|
3
|
my($class, $me, $sql, $attr, @bind) = @_; |
|
100
|
1
|
|
|
|
|
4
|
$class->_sql($me, $sql, @bind); |
|
101
|
1
|
|
|
|
|
3
|
$me->rdbh->selectrow_hashref($sql, $attr, @bind); |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub _selectall_arrayref { |
|
105
|
4
|
|
|
4
|
|
12
|
my($class, $me, $sql, $attr, @bind) = @_; |
|
106
|
4
|
|
|
|
|
16
|
$class->_sql($me, $sql, @bind); |
|
107
|
4
|
|
|
|
|
94
|
$me->rdbh->selectall_arrayref($sql, $attr, @bind); |
|
108
|
|
|
|
|
|
|
} |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub _selectall_hashref { |
|
111
|
1
|
|
|
1
|
|
5
|
my($class, $me, $sql, $key, $attr, @bind) = @_; |
|
112
|
1
|
|
|
|
|
5
|
$class->_sql($me, $sql, @bind); |
|
113
|
1
|
|
|
|
|
5
|
$me->rdbh->selectall_hashref($sql, $key, $attr, @bind); |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub _qi { |
|
117
|
206
|
|
|
206
|
|
592
|
my($class, $me, @id) = @_; |
|
118
|
206
|
100
|
|
|
|
779
|
return $me->rdbh->quote_identifier(@id) if $me->config('QuoteIdentifier'); |
|
119
|
|
|
|
|
|
|
# Strip off any null/undef elements (ie schema) |
|
120
|
2
|
|
100
|
|
|
41
|
shift(@id) while @id and not (defined $id[0] and length $id[0]); |
|
|
|
|
100
|
|
|
|
|
|
121
|
2
|
|
|
|
|
20
|
return join '.', @id; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub _sql { |
|
125
|
86
|
|
|
86
|
|
153
|
my $class = shift; |
|
126
|
86
|
|
|
|
|
185
|
my $me = shift; |
|
127
|
86
|
50
|
|
|
|
259
|
if (my $hook = $me->config('HookSQL')) { |
|
128
|
86
|
|
|
|
|
318
|
$hook->($me, @_); |
|
129
|
|
|
|
|
|
|
} |
|
130
|
86
|
50
|
|
|
|
291
|
my $dbg = $me->config('DebugSQL') or return; |
|
131
|
0
|
|
|
|
|
0
|
my($sql, @bind) = @_; |
|
132
|
|
|
|
|
|
|
|
|
133
|
0
|
0
|
|
|
|
0
|
require Carp::Heavy if eval "$Carp::VERSION < 1.12"; |
|
134
|
0
|
|
|
|
|
0
|
my $loc = Carp::short_error_loc(); |
|
135
|
0
|
|
|
|
|
0
|
my %i = Carp::caller_info($loc); |
|
136
|
0
|
|
|
|
|
0
|
my $trace; |
|
137
|
0
|
0
|
|
|
|
0
|
if ($dbg > 1) { |
|
138
|
0
|
|
|
|
|
0
|
$trace = "\t$i{sub_name} called at $i{file} line $i{line}\n"; |
|
139
|
0
|
|
|
|
|
0
|
$trace .= "\t$i{sub_name} called at $i{file} line $i{line}\n" while %i = Carp::caller_info(++$loc); |
|
140
|
|
|
|
|
|
|
} else { |
|
141
|
0
|
|
|
|
|
0
|
$trace = "\t$i{sub} called at $i{file} line $i{line}\n"; |
|
142
|
|
|
|
|
|
|
} |
|
143
|
0
|
|
|
|
|
0
|
warn $sql."\n(".join(', ', map $me->rdbh->quote($_), @bind).")\n".$trace; |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _do { |
|
147
|
20
|
|
|
20
|
|
58
|
my($class, $me, $sql, $attr, @bind) = @_; |
|
148
|
20
|
|
|
|
|
82
|
$class->_sql($me, $sql, @bind); |
|
149
|
20
|
|
|
|
|
81
|
$me->dbh->do($sql, $attr, @bind); |
|
150
|
|
|
|
|
|
|
} |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub _build_sql_select { |
|
153
|
44
|
|
|
44
|
|
89
|
my($class, $me) = @_; |
|
154
|
44
|
|
|
|
|
385
|
my $sql = 'SELECT '.$class->_build_show($me); |
|
155
|
44
|
|
|
|
|
196
|
$sql .= ' FROM '.$class->_build_from($me); |
|
156
|
44
|
|
|
|
|
74
|
my $clause; |
|
157
|
44
|
100
|
|
|
|
164
|
$sql .= ' WHERE '.$clause if $clause = $class->_build_where($me); |
|
158
|
44
|
100
|
|
|
|
177
|
$sql .= ' GROUP BY '.$clause if $clause = $class->_build_group($me); |
|
159
|
44
|
100
|
|
|
|
160
|
$sql .= ' HAVING '.$clause if $clause = $class->_build_having($me); |
|
160
|
44
|
100
|
|
|
|
148
|
$sql .= ' ORDER BY '.$clause if $clause = $class->_build_order($me); |
|
161
|
44
|
100
|
|
|
|
194
|
$sql .= ' '.$clause if $clause = $class->_build_limit($me); |
|
162
|
44
|
|
|
|
|
173
|
return $sql; |
|
163
|
|
|
|
|
|
|
} |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _bind_params_select { |
|
166
|
50
|
|
|
50
|
|
93
|
my($class, $me) = @_; |
|
167
|
50
|
|
|
|
|
177
|
my $h = $me->_build_data; |
|
168
|
269
|
|
|
|
|
1563
|
map { |
|
169
|
50
|
100
|
|
|
|
98
|
exists $h->{$_} ? @{$h->{$_}} : () |
|
|
300
|
|
|
|
|
554
|
|
|
170
|
|
|
|
|
|
|
} qw(Show_Bind From_Bind Where_Bind Group_Bind Having_Bind Order_Bind); |
|
171
|
|
|
|
|
|
|
} |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub _build_sql_update { |
|
174
|
6
|
|
|
6
|
|
16
|
my($class, $me, @arg) = @_; |
|
175
|
6
|
50
|
|
|
|
22
|
croak 'Update is not valid with a GROUP BY clause' if $class->_build_group($me); |
|
176
|
6
|
50
|
|
|
|
121
|
croak 'Update is not valid with a HAVING clause' if $class->_build_having($me); |
|
177
|
6
|
|
|
|
|
23
|
my $sql = 'UPDATE '.$class->_build_from($me); |
|
178
|
6
|
|
|
|
|
31
|
$sql .= ' SET '.$class->_build_set($me, @arg); |
|
179
|
6
|
|
|
|
|
13
|
my $clause; |
|
180
|
6
|
100
|
|
|
|
22
|
$sql .= ' WHERE '.$clause if $clause = $class->_build_where($me); |
|
181
|
6
|
50
|
|
|
|
21
|
$sql .= ' ORDER BY '.$clause if $clause = $class->_build_order($me); |
|
182
|
6
|
50
|
|
|
|
25
|
$sql .= ' '.$clause if $clause = $class->_build_limit($me); |
|
183
|
6
|
|
|
|
|
21
|
$sql; |
|
184
|
|
|
|
|
|
|
} |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub _bind_params_update { |
|
187
|
6
|
|
|
6
|
|
11
|
my($class, $me) = @_; |
|
188
|
6
|
|
|
|
|
20
|
my $h = $me->_build_data; |
|
189
|
21
|
|
|
|
|
58
|
map { |
|
190
|
6
|
100
|
|
|
|
13
|
exists $h->{$_} ? @{$h->{$_}} : () |
|
|
24
|
|
|
|
|
46
|
|
|
191
|
|
|
|
|
|
|
} qw(From_Bind Set_Bind Where_Bind Order_Bind); |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _build_sql_delete { |
|
195
|
1
|
|
|
1
|
|
2
|
my($class, $me) = @_; |
|
196
|
1
|
50
|
|
|
|
6
|
croak 'Delete is not valid with a GROUP BY clause' if $class->_build_group($me); |
|
197
|
1
|
|
|
|
|
5
|
my $sql = 'DELETE FROM '.$class->_build_from($me); |
|
198
|
1
|
|
|
|
|
3
|
my $clause; |
|
199
|
1
|
50
|
|
|
|
5
|
$sql .= ' WHERE '.$clause if $clause = $class->_build_where($me); |
|
200
|
1
|
50
|
|
|
|
4
|
$sql .= ' ORDER BY '.$clause if $clause = $class->_build_order($me); |
|
201
|
1
|
50
|
|
|
|
5
|
$sql .= ' '.$clause if $clause = $class->_build_limit($me); |
|
202
|
1
|
|
|
|
|
4
|
$sql; |
|
203
|
|
|
|
|
|
|
} |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub _bind_params_delete { |
|
206
|
1
|
|
|
1
|
|
4
|
my($class, $me) = @_; |
|
207
|
1
|
|
|
|
|
6
|
my $h = $me->_build_data; |
|
208
|
2
|
|
|
|
|
20
|
map { |
|
209
|
1
|
100
|
|
|
|
4
|
exists $h->{$_} ? @{$h->{$_}} : () |
|
|
3
|
|
|
|
|
9
|
|
|
210
|
|
|
|
|
|
|
} qw(From_Bind Where_Bind Order_Bind); |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub _build_table { |
|
214
|
28
|
|
|
28
|
|
44
|
my($class, $me, $t) = @_; |
|
215
|
28
|
|
|
|
|
121
|
my $from = $t->_from($me->{build_data}); |
|
216
|
28
|
|
|
|
|
371
|
my $alias = $me->_table_alias($t); |
|
217
|
28
|
100
|
|
|
|
102
|
$alias = defined $alias ? ' '.$class->_qi($me, $alias) : ''; |
|
218
|
28
|
|
|
|
|
319
|
return $from.$alias; |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub _build_show { |
|
222
|
44
|
|
|
44
|
|
267
|
my($class, $me) = @_; |
|
223
|
44
|
|
|
|
|
191
|
my $h = $me->_build_data; |
|
224
|
44
|
100
|
|
|
|
199
|
return $h->{show} if defined $h->{show}; |
|
225
|
23
|
100
|
|
|
|
59
|
my $distinct = $h->{Show_Distinct} ? 'DISTINCT ' : ''; |
|
226
|
23
|
|
|
|
|
36
|
undef @{$h->{Show_Bind}}; |
|
|
23
|
|
|
|
|
68
|
|
|
227
|
23
|
100
|
|
|
|
35
|
return $h->{show} = $distinct.'*' unless @{$h->{Showing}}; |
|
|
23
|
|
|
|
|
98
|
|
|
228
|
14
|
|
|
|
|
25
|
my @flds; |
|
229
|
14
|
|
|
|
|
24
|
for my $fld (@{$h->{Showing}}) { |
|
|
14
|
|
|
|
|
42
|
|
|
230
|
26
|
100
|
|
|
|
162
|
if (_isa($fld, 'DBIx::DBO::Table', 'DBIx::DBO::Query')) { |
|
231
|
8
|
|
66
|
|
|
34
|
push @flds, $class->_qi($me, $me->_table_alias($fld) || $fld->{Name}).'.*'; |
|
232
|
|
|
|
|
|
|
} else { |
|
233
|
18
|
50
|
|
|
|
55
|
$h->{_subqueries}{$fld->[0][0]} = $fld->[0][0]->sql if _isa($fld->[0][0], 'DBIx::DBO::Query'); |
|
234
|
18
|
|
|
|
|
80
|
push @flds, $class->_build_val($me, $h->{Show_Bind}, @$fld); |
|
235
|
|
|
|
|
|
|
} |
|
236
|
|
|
|
|
|
|
} |
|
237
|
14
|
|
|
|
|
154
|
return $h->{show} = $distinct.join(', ', @flds); |
|
238
|
|
|
|
|
|
|
} |
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub _build_from { |
|
241
|
84
|
|
|
84
|
|
129
|
my($class, $me) = @_; |
|
242
|
84
|
|
|
|
|
240
|
my $h = $me->_build_data; |
|
243
|
84
|
100
|
|
|
|
414
|
return $h->{from} if defined $h->{from}; |
|
244
|
22
|
|
|
|
|
31
|
undef @{$h->{From_Bind}}; |
|
|
22
|
|
|
|
|
63
|
|
|
245
|
22
|
|
|
|
|
80
|
my @tables = $me->tables; |
|
246
|
22
|
|
|
|
|
119
|
$h->{from} = $class->_build_table($me, $tables[0]); |
|
247
|
22
|
|
|
|
|
82
|
for (my $i = 1; $i < @tables; $i++) { |
|
248
|
6
|
|
|
|
|
29
|
$h->{from} .= $h->{Join}[$i].$class->_build_table($me, $tables[$i]); |
|
249
|
6
|
100
|
|
|
|
42
|
$h->{from} .= ' ON '.join(' AND ', $class->_build_where_chunk($me, $h->{From_Bind}, 'OR', $h->{Join_On}[$i])) |
|
250
|
|
|
|
|
|
|
if $h->{Join_On}[$i]; |
|
251
|
|
|
|
|
|
|
} |
|
252
|
22
|
|
|
|
|
82
|
return $h->{from}; |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub _parse_col_val { |
|
256
|
69
|
|
|
69
|
|
243
|
my($class, $me, $col, %c) = @_; |
|
257
|
69
|
100
|
|
|
|
201
|
unless (defined $c{Aliases}) { |
|
258
|
54
|
|
|
|
|
559
|
(my $method = (caller(1))[3]) =~ s/.*:://; |
|
259
|
54
|
|
|
|
|
217
|
$c{Aliases} = $class->_alias_preference($me, $method); |
|
260
|
|
|
|
|
|
|
} |
|
261
|
69
|
100
|
|
|
|
272
|
return $class->_parse_val($me, $col, Check => 'Column', %c) if ref $col; |
|
262
|
39
|
|
|
|
|
135
|
return [ $class->_parse_col($me, $col, $c{Aliases}) ]; |
|
263
|
|
|
|
|
|
|
} |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# In some cases column aliases can be used, but this differs by DB and where in the statement it's used. |
|
266
|
|
|
|
|
|
|
# The $method is the method we were called from: (join_on|column|where|having|_del_where|order_by|group_by) |
|
267
|
|
|
|
|
|
|
# This method provides a way for DBs to override the default which is always 1 except for join_on. |
|
268
|
|
|
|
|
|
|
# Return values: 0 = Don't use aliases, 1 = Check aliases then columns, 2 = Check columns then aliases |
|
269
|
|
|
|
|
|
|
sub _alias_preference { |
|
270
|
|
|
|
|
|
|
# my($class, $me, $method) = @_; |
|
271
|
55
|
100
|
|
55
|
|
210
|
return $_[2] eq 'join_on' ? 0 : 1; |
|
272
|
|
|
|
|
|
|
} |
|
273
|
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub _valid_col { |
|
275
|
61
|
|
|
61
|
|
109
|
my($class, $me, $col) = @_; |
|
276
|
|
|
|
|
|
|
# Check if the object is an alias |
|
277
|
61
|
100
|
|
|
|
258
|
return $col if $col->[0] == $me; |
|
278
|
|
|
|
|
|
|
# TODO: Sub-queries |
|
279
|
|
|
|
|
|
|
# Check if the column is from one of our tables |
|
280
|
51
|
|
|
|
|
182
|
for my $tbl ($me->tables) { |
|
281
|
62
|
100
|
|
|
|
332
|
return $col if $col->[0] == $tbl; |
|
282
|
|
|
|
|
|
|
} |
|
283
|
1
|
|
|
|
|
126
|
croak 'Invalid column, the column is from a table not included in this query'; |
|
284
|
|
|
|
|
|
|
} |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub _parse_col { |
|
287
|
101
|
|
|
101
|
|
976
|
my($class, $me, $col, $_check_aliases) = @_; |
|
288
|
101
|
100
|
|
|
|
258
|
if (ref $col) { |
|
289
|
14
|
50
|
|
|
|
36
|
return $class->_valid_col($me, $col) if _isa($col, 'DBIx::DBO::Column'); |
|
290
|
0
|
|
|
|
|
0
|
croak 'Invalid column: '.$col; |
|
291
|
|
|
|
|
|
|
} |
|
292
|
|
|
|
|
|
|
# If $_check_aliases is not defined dont accept an alias |
|
293
|
87
|
|
100
|
|
|
486
|
$me->_inner_col($col, $_check_aliases || 0); |
|
294
|
|
|
|
|
|
|
} |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub _build_col { |
|
297
|
147
|
|
|
147
|
|
305
|
my($class, $me, $col) = @_; |
|
298
|
147
|
|
|
|
|
585
|
$class->_qi($me, $me->_table_alias($col->[0]), $col->[1]); |
|
299
|
|
|
|
|
|
|
} |
|
300
|
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub _parse_val { |
|
302
|
133
|
|
|
133
|
|
365
|
my($class, $me, $fld, %c) = @_; |
|
303
|
133
|
100
|
|
|
|
407
|
$c{Check} = '' unless defined $c{Check}; |
|
304
|
|
|
|
|
|
|
|
|
305
|
133
|
|
|
|
|
243
|
my $func; |
|
306
|
|
|
|
|
|
|
my $opt; |
|
307
|
133
|
100
|
|
|
|
515
|
if (ref $fld eq 'SCALAR') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
308
|
15
|
0
|
|
|
|
39
|
croak 'Invalid '.($c{Check} eq 'Column' ? 'column' : 'field').' reference (scalar ref to undef)' |
|
|
|
50
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
unless defined $$fld; |
|
310
|
15
|
|
|
|
|
23
|
$func = $$fld; |
|
311
|
15
|
|
|
|
|
31
|
$fld = []; |
|
312
|
|
|
|
|
|
|
} elsif (ref $fld eq 'HASH') { |
|
313
|
18
|
100
|
|
|
|
76
|
$func = $fld->{FUNC} if exists $fld->{FUNC}; |
|
314
|
18
|
100
|
|
|
|
119
|
$opt->{AS} = $fld->{AS} if exists $fld->{AS}; |
|
315
|
18
|
100
|
|
|
|
63
|
if (exists $fld->{ORDER}) { |
|
316
|
2
|
50
|
|
|
|
17
|
croak 'Invalid ORDER, must be ASC or DESC' if $fld->{ORDER} !~ /^(A|DE)SC$/i; |
|
317
|
2
|
|
|
|
|
7
|
$opt->{ORDER} = uc $fld->{ORDER}; |
|
318
|
|
|
|
|
|
|
} |
|
319
|
18
|
100
|
|
|
|
64
|
$opt->{COLLATE} = $fld->{COLLATE} if exists $fld->{COLLATE}; |
|
320
|
18
|
100
|
|
|
|
50
|
if (exists $fld->{COL}) { |
|
321
|
11
|
50
|
|
|
|
34
|
croak 'Invalid HASH containing both COL and VAL' if exists $fld->{VAL}; |
|
322
|
11
|
100
|
|
|
|
53
|
my @cols = ref $fld->{COL} eq 'ARRAY' ? @{$fld->{COL}} : $fld->{COL}; |
|
|
1
|
|
|
|
|
3
|
|
|
323
|
11
|
|
|
|
|
72
|
$fld = [ map $class->_parse_col($me, $_, $c{Aliases}), @cols ]; |
|
324
|
|
|
|
|
|
|
} else { |
|
325
|
7
|
100
|
|
|
|
26
|
$fld = exists $fld->{VAL} ? $fld->{VAL} : []; |
|
326
|
|
|
|
|
|
|
} |
|
327
|
|
|
|
|
|
|
} elsif (_isa($fld, 'DBIx::DBO::Column')) { |
|
328
|
15
|
|
|
|
|
63
|
return [ $class->_valid_col($me, $fld) ]; |
|
329
|
|
|
|
|
|
|
} |
|
330
|
118
|
100
|
|
|
|
386
|
$fld = [$fld] unless ref $fld eq 'ARRAY'; |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# Swap placeholders |
|
333
|
118
|
|
|
|
|
231
|
my $with = @$fld; |
|
334
|
118
|
100
|
66
|
|
|
467
|
if (defined $func) { |
|
|
|
50
|
|
|
|
|
|
|
335
|
27
|
|
|
|
|
103
|
my $need = $class->_substitute_placeholders($me, $func); |
|
336
|
27
|
100
|
|
|
|
202
|
croak "The number of params ($with) does not match the number of placeholders ($need)" if $need != $with; |
|
337
|
|
|
|
|
|
|
} elsif ($with != 1 and $c{Check} ne 'Auto') { |
|
338
|
0
|
0
|
|
|
|
0
|
croak 'Invalid '.($c{Check} eq 'Column' ? 'column' : 'field')." reference (passed $with params instead of 1)"; |
|
339
|
|
|
|
|
|
|
} |
|
340
|
117
|
|
|
|
|
675
|
return ($fld, $func, $opt); |
|
341
|
|
|
|
|
|
|
} |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub _substitute_placeholders { |
|
344
|
27
|
|
|
27
|
|
41
|
my($class, $me) = @_; |
|
345
|
27
|
|
|
|
|
38
|
my $num_placeholders = 0; |
|
346
|
27
|
100
|
|
|
|
199
|
$_[2] =~ s/((?
|
|
|
20
|
|
|
|
|
169
|
|
|
347
|
27
|
|
|
|
|
66
|
return $num_placeholders; |
|
348
|
|
|
|
|
|
|
} |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub _build_val { |
|
351
|
226
|
|
|
226
|
|
469
|
my($class, $me, $bind, $fld, $func, $opt) = @_; |
|
352
|
226
|
|
|
|
|
309
|
my $extra = ''; |
|
353
|
226
|
100
|
|
|
|
531
|
$extra .= ' COLLATE '.$me->rdbh->quote($opt->{COLLATE}) if exists $opt->{COLLATE}; |
|
354
|
226
|
100
|
|
|
|
565
|
$extra .= ' AS '.$class->_qi($me, $opt->{AS}) if exists $opt->{AS}; |
|
355
|
226
|
100
|
|
|
|
645
|
$extra .= " $opt->{ORDER}" if exists $opt->{ORDER}; |
|
356
|
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
my @ary = map { |
|
358
|
226
|
100
|
|
|
|
392
|
if (!ref $_) { |
|
|
214
|
100
|
|
|
|
543
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
359
|
115
|
|
|
|
|
202
|
push @$bind, $_; |
|
360
|
115
|
|
|
|
|
289
|
'?'; |
|
361
|
|
|
|
|
|
|
} elsif (_isa($_, 'DBIx::DBO::Column')) { |
|
362
|
97
|
|
|
|
|
265
|
$class->_build_col($me, $_); |
|
363
|
|
|
|
|
|
|
} elsif (ref $_ eq 'SCALAR') { |
|
364
|
2
|
|
|
|
|
6
|
$$_; |
|
365
|
|
|
|
|
|
|
} elsif (_isa($_, 'DBIx::DBO::Query')) { |
|
366
|
0
|
|
|
|
|
0
|
$_->_from($me->{build_data}); |
|
367
|
|
|
|
|
|
|
} else { |
|
368
|
0
|
|
|
|
|
0
|
croak 'Invalid field: '.$_; |
|
369
|
|
|
|
|
|
|
} |
|
370
|
|
|
|
|
|
|
} @$fld; |
|
371
|
226
|
100
|
|
|
|
3109
|
unless (defined $func) { |
|
372
|
173
|
50
|
|
|
|
353
|
die "Number of placeholders and values don't match!" if @ary != 1; |
|
373
|
173
|
|
|
|
|
1050
|
return $ary[0].$extra; |
|
374
|
|
|
|
|
|
|
} |
|
375
|
|
|
|
|
|
|
# Add one value to @ary to make sure the number of placeholders & values match |
|
376
|
53
|
|
|
|
|
90
|
push @ary, 'Error'; |
|
377
|
53
|
|
|
|
|
197
|
$func =~ s/$placeholder/shift @ary/ego; |
|
|
41
|
|
|
|
|
92
|
|
|
378
|
|
|
|
|
|
|
# At this point all the values should have been used and @ary must only have 1 item! |
|
379
|
53
|
50
|
|
|
|
154
|
die "Number of placeholders and values don't match!" if @ary != 1; |
|
380
|
53
|
|
|
|
|
301
|
return $func.$extra; |
|
381
|
|
|
|
|
|
|
} |
|
382
|
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# Construct the WHERE clause |
|
384
|
|
|
|
|
|
|
sub _build_where { |
|
385
|
51
|
|
|
51
|
|
78
|
my($class, $me) = @_; |
|
386
|
51
|
|
|
|
|
173
|
my $h = $me->_build_data; |
|
387
|
51
|
100
|
|
|
|
204
|
return $h->{where} if defined $h->{where}; |
|
388
|
36
|
|
|
|
|
51
|
undef @{$h->{Where_Bind}}; |
|
|
36
|
|
|
|
|
105
|
|
|
389
|
36
|
|
|
|
|
49
|
my @where; |
|
390
|
36
|
100
|
|
|
|
129
|
push @where, $class->_build_quick_where($me, $h->{Where_Bind}, @{$h->{Quick_Where}}) if exists $h->{Quick_Where}; |
|
|
16
|
|
|
|
|
84
|
|
|
391
|
36
|
100
|
|
|
|
206
|
push @where, $class->_build_where_chunk($me, $h->{Where_Bind}, 'OR', $h->{Where_Data}) if exists $h->{Where_Data}; |
|
392
|
36
|
|
|
|
|
221
|
return $h->{where} = join ' AND ', @where; |
|
393
|
|
|
|
|
|
|
} |
|
394
|
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# Construct the WHERE contents of one set of parentheses |
|
396
|
|
|
|
|
|
|
sub _build_where_chunk { |
|
397
|
39
|
|
|
39
|
|
86
|
my($class, $me, $bind, $ag, $whs) = @_; |
|
398
|
39
|
|
|
|
|
48
|
my @str; |
|
399
|
|
|
|
|
|
|
# Make a copy so we can hack at it |
|
400
|
39
|
|
|
|
|
124
|
my @whs = @$whs; |
|
401
|
39
|
|
|
|
|
224
|
while (my $wh = shift @whs) { |
|
402
|
61
|
|
|
|
|
87
|
my @ary; |
|
403
|
61
|
100
|
|
|
|
142
|
if (ref $wh->[0]) { |
|
404
|
9
|
100
|
|
|
|
43
|
@ary = $class->_build_where_chunk($me, $bind, $ag eq 'OR' ? 'AND' : 'OR', $wh); |
|
405
|
|
|
|
|
|
|
} else { |
|
406
|
52
|
|
|
|
|
189
|
@ary = $class->_build_where_piece($me, $bind, @$wh); |
|
407
|
52
|
|
|
|
|
137
|
my($op, $fld, $fld_func, $fld_opt, $val, $val_func, $val_opt, $force) = @$wh; |
|
408
|
|
|
|
|
|
|
# Group AND/OR'ed for same fld if $force or $op requires it |
|
409
|
52
|
100
|
100
|
|
|
176
|
if ($ag eq ($force || _op_ag($op))) { |
|
410
|
18
|
|
|
|
|
64
|
for (my $i = $#whs; $i >= 0; $i--) { |
|
411
|
|
|
|
|
|
|
# Right now this starts with the last @whs and works backwards |
|
412
|
|
|
|
|
|
|
# It splices when the ag is the correct AND/OR and the funcs match and all flds match |
|
413
|
19
|
100
|
100
|
|
|
124
|
next if ref $whs[$i][0] or $ag ne ($whs[$i][7] || _op_ag($whs[$i][0])); |
|
|
|
|
100
|
|
|
|
|
|
414
|
11
|
|
|
11
|
|
112
|
no warnings 'uninitialized'; |
|
|
11
|
|
|
|
|
24
|
|
|
|
11
|
|
|
|
|
4434
|
|
|
415
|
8
|
50
|
|
|
|
30
|
next if $whs[$i][2] ne $fld_func; |
|
416
|
11
|
|
|
11
|
|
61
|
use warnings 'uninitialized'; |
|
|
11
|
|
|
|
|
2114
|
|
|
|
11
|
|
|
|
|
48021
|
|
|
417
|
|
|
|
|
|
|
# next unless $fld_func ~~ $whs[$i][2]; |
|
418
|
8
|
|
|
|
|
14
|
my $l = $whs[$i][1]; |
|
419
|
8
|
50
|
|
|
|
74
|
next if ((ref $l eq 'ARRAY' ? "@$l" : $l) ne (ref $fld eq 'ARRAY' ? "@$fld" : $fld)); |
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# next unless $fld ~~ $whs[$i][1]; |
|
421
|
6
|
|
|
|
|
11
|
push @ary, $class->_build_where_piece($me, $bind, @{splice @whs, $i, 1}); |
|
|
6
|
|
|
|
|
24
|
|
|
422
|
|
|
|
|
|
|
} |
|
423
|
|
|
|
|
|
|
} |
|
424
|
|
|
|
|
|
|
} |
|
425
|
61
|
100
|
|
|
|
318
|
push @str, @ary == 1 ? $ary[0] : '('.join(' '.$ag.' ', @ary).')'; |
|
426
|
|
|
|
|
|
|
} |
|
427
|
39
|
|
|
|
|
120
|
return @str; |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
sub _op_ag { |
|
431
|
65
|
100
|
100
|
65
|
|
652
|
return 'OR' if $_[0] eq '=' or $_[0] eq 'IS' or $_[0] eq '<=>' or $_[0] eq 'IN' or $_[0] eq 'BETWEEN'; |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
432
|
37
|
100
|
100
|
|
|
348
|
return 'AND' if $_[0] eq '<>' or $_[0] eq 'IS NOT' or $_[0] eq 'NOT IN' or $_[0] eq 'NOT BETWEEN'; |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
433
|
|
|
|
|
|
|
} |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# Construct one WHERE expression |
|
436
|
|
|
|
|
|
|
sub _build_where_piece { |
|
437
|
58
|
|
|
58
|
|
127
|
my($class, $me, $bind, $op, $fld, $fld_func, $fld_opt, $val, $val_func, $val_opt) = @_; |
|
438
|
58
|
|
|
|
|
218
|
$class->_build_val($me, $bind, $fld, $fld_func, $fld_opt)." $op ".$class->_build_val($me, $bind, $val, $val_func, $val_opt); |
|
439
|
|
|
|
|
|
|
} |
|
440
|
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# Construct one WHERE expression (simple) |
|
442
|
|
|
|
|
|
|
sub _build_quick_where { |
|
443
|
28
|
50
|
|
28
|
|
167
|
croak 'Wrong number of arguments' unless @_ & 1; |
|
444
|
28
|
|
|
|
|
82
|
my($class, $me, $bind) = splice @_, 0, 3; |
|
445
|
28
|
|
|
|
|
40
|
my @where; |
|
446
|
28
|
|
|
|
|
117
|
while (my($col, $val) = splice @_, 0, 2) { |
|
447
|
|
|
|
|
|
|
# FIXME: What about aliases in quick_where? |
|
448
|
26
|
|
|
|
|
97
|
push @where, $class->_build_col($me, $class->_parse_col($me, $col)) . do { |
|
449
|
25
|
100
|
100
|
|
|
1273
|
if (ref $val eq 'SCALAR' and $$val =~ /^\s*(?:NOT\s+)NULL\s*$/is) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
450
|
2
|
|
|
|
|
15
|
' IS '; |
|
451
|
|
|
|
|
|
|
} elsif (ref $val eq 'ARRAY') { |
|
452
|
2
|
50
|
|
|
|
12
|
croak 'Invalid value argument, IN requires at least 1 value' unless @$val; |
|
453
|
2
|
|
|
|
|
14
|
$val = { FUNC => '('.join(',', ('?') x @$val).')', VAL => $val }; |
|
454
|
2
|
|
|
|
|
13
|
' IN '; |
|
455
|
|
|
|
|
|
|
} elsif (defined $val) { |
|
456
|
20
|
|
|
|
|
86
|
' = '; |
|
457
|
|
|
|
|
|
|
} else { |
|
458
|
1
|
|
|
|
|
6
|
$val = \'NULL'; |
|
459
|
1
|
|
|
|
|
7
|
' IS '; |
|
460
|
|
|
|
|
|
|
} |
|
461
|
|
|
|
|
|
|
} . $class->_build_val($me, $bind, $class->_parse_val($me, $val)); |
|
462
|
|
|
|
|
|
|
} |
|
463
|
27
|
|
|
|
|
128
|
return join ' AND ', @where; |
|
464
|
|
|
|
|
|
|
} |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub _parse_set { |
|
467
|
6
|
50
|
|
6
|
|
29
|
croak 'Wrong number of arguments' if @_ & 1; |
|
468
|
6
|
|
|
|
|
19
|
my($class, $me, @arg) = @_; |
|
469
|
6
|
|
|
|
|
9
|
my @update; |
|
470
|
|
|
|
|
|
|
my %remove_duplicates; |
|
471
|
6
|
|
|
|
|
20
|
while (@arg) { |
|
472
|
8
|
|
|
|
|
35
|
my @val = $class->_parse_val($me, pop @arg); |
|
473
|
8
|
|
|
|
|
31
|
my $col = $class->_parse_col($me, pop @arg); |
|
474
|
8
|
100
|
|
|
|
70
|
unshift @update, $col, \@val unless $remove_duplicates{$col}++; |
|
475
|
|
|
|
|
|
|
} |
|
476
|
6
|
|
|
|
|
29
|
return @update; |
|
477
|
|
|
|
|
|
|
} |
|
478
|
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub _build_set { |
|
480
|
6
|
|
|
6
|
|
16
|
my($class, $me, @arg) = @_; |
|
481
|
6
|
|
|
|
|
16
|
my $h = $me->_build_data; |
|
482
|
6
|
|
|
|
|
17
|
undef @{$h->{Set_Bind}}; |
|
|
6
|
|
|
|
|
23
|
|
|
483
|
6
|
|
|
|
|
16
|
my @set; |
|
484
|
6
|
|
|
|
|
17
|
while (@arg) { |
|
485
|
7
|
|
|
|
|
25
|
push @set, $class->_build_col($me, shift @arg).' = '.$class->_build_val($me, $h->{Set_Bind}, @{shift @arg}); |
|
|
7
|
|
|
|
|
204
|
|
|
486
|
|
|
|
|
|
|
} |
|
487
|
6
|
|
|
|
|
32
|
return join ', ', @set; |
|
488
|
|
|
|
|
|
|
} |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub _build_group { |
|
491
|
51
|
|
|
51
|
|
91
|
my($class, $me) = @_; |
|
492
|
51
|
|
|
|
|
151
|
my $h = $me->_build_data; |
|
493
|
51
|
100
|
|
|
|
241
|
return $h->{group} if defined $h->{group}; |
|
494
|
20
|
|
|
|
|
38
|
undef @{$h->{Group_Bind}}; |
|
|
20
|
|
|
|
|
60
|
|
|
495
|
20
|
|
|
|
|
33
|
return $h->{group} = join ', ', map $class->_build_val($me, $h->{Group_Bind}, @$_), @{$h->{GroupBy}}; |
|
|
20
|
|
|
|
|
115
|
|
|
496
|
|
|
|
|
|
|
} |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
# Construct the HAVING clause |
|
499
|
|
|
|
|
|
|
sub _build_having { |
|
500
|
50
|
|
|
50
|
|
90
|
my($class, $me) = @_; |
|
501
|
50
|
|
|
|
|
130
|
my $h = $me->_build_data; |
|
502
|
50
|
100
|
|
|
|
202
|
return $h->{having} if defined $h->{having}; |
|
503
|
26
|
|
|
|
|
44
|
undef @{$h->{Having_Bind}}; |
|
|
26
|
|
|
|
|
58
|
|
|
504
|
26
|
|
|
|
|
43
|
my @having; |
|
505
|
26
|
100
|
|
|
|
83
|
push @having, $class->_build_where_chunk($me, $h->{Having_Bind}, 'OR', $h->{Having_Data}) if exists $h->{Having_Data}; |
|
506
|
26
|
|
|
|
|
130
|
return $h->{having} = join ' AND ', @having; |
|
507
|
|
|
|
|
|
|
} |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub _build_order { |
|
510
|
51
|
|
|
51
|
|
72
|
my($class, $me) = @_; |
|
511
|
51
|
|
|
|
|
154
|
my $h = $me->_build_data; |
|
512
|
51
|
100
|
|
|
|
258
|
return $h->{order} if defined $h->{order}; |
|
513
|
24
|
|
|
|
|
28
|
undef @{$h->{Order_Bind}}; |
|
|
24
|
|
|
|
|
54
|
|
|
514
|
24
|
|
|
|
|
39
|
return $h->{order} = join ', ', map $class->_build_val($me, $h->{Order_Bind}, @$_), @{$h->{OrderBy}}; |
|
|
24
|
|
|
|
|
129
|
|
|
515
|
|
|
|
|
|
|
} |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub _build_limit { |
|
518
|
51
|
|
|
51
|
|
97
|
my($class, $me) = @_; |
|
519
|
51
|
|
|
|
|
150
|
my $h = $me->_build_data; |
|
520
|
51
|
100
|
|
|
|
200
|
return $h->{limit} if defined $h->{limit}; |
|
521
|
27
|
100
|
|
|
|
155
|
return $h->{limit} = '' unless defined $h->{LimitOffset}; |
|
522
|
7
|
|
|
|
|
23
|
$h->{limit} = 'LIMIT '.$h->{LimitOffset}[0]; |
|
523
|
7
|
100
|
|
|
|
33
|
$h->{limit} .= ' OFFSET '.$h->{LimitOffset}[1] if $h->{LimitOffset}[1]; |
|
524
|
7
|
|
|
|
|
32
|
return $h->{limit}; |
|
525
|
|
|
|
|
|
|
} |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
sub _get_config { |
|
528
|
751
|
|
|
751
|
|
1568
|
my($class, $opt, @confs) = @_; |
|
529
|
751
|
|
100
|
|
|
5999
|
defined $_->{$opt} and return $_->{$opt} for @confs; |
|
530
|
307
|
|
|
|
|
1445
|
return; |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub _set_config { |
|
534
|
123
|
|
|
123
|
|
290
|
my($class, $ref, $opt, $val) = @_; |
|
535
|
123
|
50
|
66
|
|
|
501
|
croak "Invalid value for the 'OnRowUpdate' setting" |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
536
|
|
|
|
|
|
|
if $opt eq 'OnRowUpdate' and $val and $val ne 'empty' and $val ne 'simple' and $val ne 'reload'; |
|
537
|
123
|
100
|
100
|
|
|
839
|
croak "Invalid value for the 'UseHandle' setting" |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
538
|
|
|
|
|
|
|
if $opt eq 'UseHandle' and $val and $val ne 'read-only' and $val ne 'read-write'; |
|
539
|
122
|
|
|
|
|
241
|
my $old = $ref->{$opt}; |
|
540
|
122
|
|
|
|
|
261
|
$ref->{$opt} = $val; |
|
541
|
122
|
|
|
|
|
462
|
return $old; |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
# Query methods |
|
546
|
|
|
|
|
|
|
sub _rows { |
|
547
|
1
|
|
|
1
|
|
3
|
my($class, $me) = @_; |
|
548
|
1
|
50
|
33
|
|
|
4
|
$me->_sth and ($me->{sth}{Executed} or $me->run) |
|
|
|
|
33
|
|
|
|
|
|
549
|
|
|
|
|
|
|
or croak $me->rdbh->errstr; |
|
550
|
1
|
|
|
|
|
7
|
my $rows = $me->_sth->rows; |
|
551
|
1
|
50
|
|
|
|
7
|
$me->{Row_Count} = $rows == -1 ? undef : $rows; |
|
552
|
|
|
|
|
|
|
} |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub _calc_found_rows { |
|
555
|
1
|
|
|
1
|
|
2
|
my($class, $me) = @_; |
|
556
|
1
|
|
|
|
|
4
|
local $me->{build_data}{limit} = ''; |
|
557
|
1
|
|
|
|
|
4
|
$me->{Found_Rows} = $me->count_rows; |
|
558
|
|
|
|
|
|
|
} |
|
559
|
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# Table methods |
|
562
|
0
|
|
|
0
|
|
0
|
sub _save_last_insert_id { |
|
563
|
|
|
|
|
|
|
#my($class, $me, $sth) = @_; |
|
564
|
|
|
|
|
|
|
# Should be provided in a DBD specific method |
|
565
|
|
|
|
|
|
|
# It is called after insert and must return the autogenerated ID |
|
566
|
|
|
|
|
|
|
#return $sth->{Database}->last_insert_id(undef, @$me{qw(Schema Name)}, undef); |
|
567
|
|
|
|
|
|
|
} |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
sub _fast_bulk_insert { |
|
570
|
0
|
|
|
0
|
|
0
|
my($class, $me, $sql, $cols, %opt) = @_; |
|
571
|
|
|
|
|
|
|
|
|
572
|
0
|
|
|
|
|
0
|
my @vals; |
|
573
|
|
|
|
|
|
|
my @bind; |
|
574
|
0
|
0
|
|
|
|
0
|
if (ref $opt{rows}[0] eq 'ARRAY') { |
|
575
|
0
|
|
|
|
|
0
|
for my $row (@{$opt{rows}}) { |
|
|
0
|
|
|
|
|
0
|
|
|
576
|
0
|
|
|
|
|
0
|
push @vals, '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row).')'; |
|
577
|
|
|
|
|
|
|
} |
|
578
|
|
|
|
|
|
|
} else { |
|
579
|
0
|
|
|
|
|
0
|
for my $row (@{$opt{rows}}) { |
|
|
0
|
|
|
|
|
0
|
|
|
580
|
0
|
|
|
|
|
0
|
push @vals, '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row{@$cols}).')'; |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
} |
|
583
|
|
|
|
|
|
|
|
|
584
|
0
|
|
|
|
|
0
|
$sql .= join(",\n", @vals); |
|
585
|
0
|
|
|
|
|
0
|
$class->_do($me, $sql, undef, @bind); |
|
586
|
|
|
|
|
|
|
} |
|
587
|
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
sub _safe_bulk_insert { |
|
589
|
4
|
|
|
4
|
|
13
|
my($class, $me, $sql, $cols, %opt) = @_; |
|
590
|
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
# TODO: Wrap in a transaction |
|
592
|
4
|
|
|
|
|
7
|
my $rv; |
|
593
|
|
|
|
|
|
|
my $sth; |
|
594
|
4
|
|
|
|
|
9
|
my $prev_vals = ''; |
|
595
|
4
|
100
|
|
|
|
16
|
if (ref $opt{rows}[0] eq 'ARRAY') { |
|
596
|
2
|
|
|
|
|
3
|
for my $row (@{$opt{rows}}) { |
|
|
2
|
|
|
|
|
5
|
|
|
597
|
8
|
|
|
|
|
11
|
my @bind; |
|
598
|
8
|
|
|
|
|
36
|
my $vals = '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row).')'; |
|
599
|
8
|
|
|
|
|
34
|
$class->_sql($me, $sql.$vals, @bind); |
|
600
|
8
|
100
|
|
|
|
23
|
if ($prev_vals ne $vals) { |
|
601
|
2
|
50
|
|
|
|
9
|
$sth = $me->dbh->prepare($sql.$vals) or return undef; |
|
602
|
2
|
|
|
|
|
176
|
$prev_vals = $vals; |
|
603
|
|
|
|
|
|
|
} |
|
604
|
8
|
50
|
|
|
|
954
|
$rv += $sth->execute(@bind) or return undef; |
|
605
|
|
|
|
|
|
|
} |
|
606
|
|
|
|
|
|
|
} else { |
|
607
|
2
|
|
|
|
|
5
|
for my $row (@{$opt{rows}}) { |
|
|
2
|
|
|
|
|
5
|
|
|
608
|
8
|
|
|
|
|
12
|
my @bind; |
|
609
|
8
|
|
|
|
|
48
|
my $vals = '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row{@$cols}).')'; |
|
610
|
8
|
|
|
|
|
42
|
$class->_sql($me, $sql.$vals, @bind); |
|
611
|
8
|
100
|
|
|
|
31
|
if ($prev_vals ne $vals) { |
|
612
|
2
|
50
|
|
|
|
9
|
$sth = $me->dbh->prepare($sql.$vals) or return undef; |
|
613
|
2
|
|
|
|
|
125
|
$prev_vals = $vals; |
|
614
|
|
|
|
|
|
|
} |
|
615
|
8
|
50
|
|
|
|
1113
|
$rv += $sth->execute(@bind) or return undef; |
|
616
|
|
|
|
|
|
|
} |
|
617
|
|
|
|
|
|
|
} |
|
618
|
|
|
|
|
|
|
|
|
619
|
4
|
|
50
|
|
|
96
|
return $rv || '0E0'; |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
*_bulk_insert = \&_safe_bulk_insert; |
|
622
|
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
# Row methods |
|
625
|
|
|
|
|
|
|
sub _reset_row_on_update { |
|
626
|
4
|
|
|
4
|
|
14
|
my($class, $me, @update) = @_; |
|
627
|
4
|
|
50
|
|
|
15
|
my $on_row_update = $me->config('OnRowUpdate') || 'simple'; |
|
628
|
|
|
|
|
|
|
|
|
629
|
4
|
50
|
|
|
|
13
|
if ($on_row_update ne 'empty') { |
|
630
|
|
|
|
|
|
|
# Set the row values if they are simple expressions |
|
631
|
4
|
|
|
|
|
7
|
my @cant_update; |
|
632
|
4
|
|
|
|
|
21
|
for (my $i = 0; $i < @update; $i += 2) { |
|
633
|
|
|
|
|
|
|
# Keep a list of columns we can't update, and skip them |
|
634
|
|
|
|
|
|
|
next if $cant_update[ $me->_column_idx($update[0]) ] = ( |
|
635
|
5
|
100
|
66
|
|
|
25
|
defined $update[1][1] or @{$update[1][0]} != 1 or ( |
|
636
|
|
|
|
|
|
|
ref $update[1][0][0] and ( |
|
637
|
|
|
|
|
|
|
not _isa($update[1][0][0], 'DBIx::DBO::Column') |
|
638
|
|
|
|
|
|
|
or $cant_update[ $me->_column_idx($update[1][0][0]) ] |
|
639
|
|
|
|
|
|
|
) |
|
640
|
|
|
|
|
|
|
) |
|
641
|
|
|
|
|
|
|
); |
|
642
|
4
|
|
|
|
|
14
|
my($col, $val) = splice @update, $i, 2; |
|
643
|
4
|
|
|
|
|
11
|
$val = $val->[0][0]; |
|
644
|
4
|
50
|
|
|
|
10
|
$val = $$me->{array}[ $me->_column_idx($val) ] if ref $val; |
|
645
|
4
|
|
|
|
|
17
|
$$me->{array}[ $me->_column_idx($col) ] = $val; |
|
646
|
4
|
|
|
|
|
15
|
$i -= 2; |
|
647
|
|
|
|
|
|
|
} |
|
648
|
|
|
|
|
|
|
# If we were able to update all the columns then return |
|
649
|
4
|
100
|
|
|
|
21
|
grep $_, @cant_update or return; |
|
650
|
|
|
|
|
|
|
|
|
651
|
1
|
50
|
|
|
|
6
|
if ($on_row_update eq 'reload') { |
|
652
|
|
|
|
|
|
|
# Attempt reload |
|
653
|
1
|
|
|
|
|
3
|
my @cols = map $$me->{build_data}{Quick_Where}[$_ << 1], 0 .. $#{$$me->{build_data}{Quick_Where}} >> 1; |
|
|
1
|
|
|
|
|
8
|
|
|
654
|
1
|
|
|
|
|
6
|
my @cidx = map $me->_column_idx($_), @cols; |
|
655
|
1
|
50
|
|
|
|
6
|
unless (grep $cant_update[$_], @cidx) { |
|
656
|
1
|
|
|
|
|
2
|
my %bd = %{$$me->{build_data}}; |
|
|
1
|
|
|
|
|
14
|
|
|
657
|
1
|
|
|
|
|
4
|
delete $bd{Where_Data}; |
|
658
|
1
|
|
|
|
|
2
|
delete $bd{where}; |
|
659
|
1
|
|
|
|
|
3
|
$bd{Quick_Where} = [map { $cols[$_] => $$me->{array}[ $cidx[$_] ] } 0 .. $#cols]; |
|
|
1
|
|
|
|
|
4
|
|
|
660
|
1
|
|
|
|
|
2
|
my($sql, @bind) = do { |
|
661
|
1
|
|
|
|
|
3
|
local $$me->{build_data} = \%bd; |
|
662
|
1
|
|
|
|
|
5
|
($class->_build_sql_select($me), $class->_bind_params_select($me)); |
|
663
|
|
|
|
|
|
|
}; |
|
664
|
1
|
|
|
|
|
5
|
return $me->_load($sql, @bind); |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
} |
|
667
|
|
|
|
|
|
|
} |
|
668
|
|
|
|
|
|
|
# If we can't update or reload then empty the Row |
|
669
|
0
|
|
|
|
|
0
|
undef $$me->{array}; |
|
670
|
0
|
|
|
|
|
0
|
$$me->{hash} = {}; |
|
671
|
|
|
|
|
|
|
} |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
sub _build_data_matching_this_row { |
|
674
|
5
|
|
|
5
|
|
13
|
my($class, $me) = @_; |
|
675
|
|
|
|
|
|
|
# Identify the row by the PrimaryKeys if any, otherwise by all Columns |
|
676
|
5
|
|
|
|
|
20
|
my @quick_where; |
|
677
|
5
|
|
|
|
|
7
|
for my $tbl (@{$$me->{Tables}}) { |
|
|
5
|
|
|
|
|
14
|
|
|
678
|
5
|
50
|
|
|
|
10
|
for my $col (map $tbl ** $_, @{$tbl->{ @{$tbl->{PrimaryKeys}} ? 'PrimaryKeys' : 'Columns' }}) { |
|
|
5
|
|
|
|
|
7
|
|
|
|
5
|
|
|
|
|
36
|
|
|
679
|
5
|
|
|
|
|
21
|
my $i = $me->_column_idx($col); |
|
680
|
5
|
50
|
|
|
|
23
|
defined $i or croak 'The '.$class->_qi($me, $tbl->{Name}, $col->[1]).' field needed to identify this row, was not included in this query'; |
|
681
|
5
|
|
|
|
|
25
|
push @quick_where, $col => $$me->{array}[$i]; |
|
682
|
|
|
|
|
|
|
} |
|
683
|
|
|
|
|
|
|
} |
|
684
|
5
|
|
|
|
|
33
|
my %h = ( |
|
685
|
|
|
|
|
|
|
Showing => $$me->{build_data}{Showing}, |
|
686
|
|
|
|
|
|
|
from => $$me->{build_data}{from}, |
|
687
|
|
|
|
|
|
|
Quick_Where => \@quick_where |
|
688
|
|
|
|
|
|
|
); |
|
689
|
5
|
100
|
|
|
|
17
|
$h{From_Bind} = $$me->{build_data}{From_Bind} if exists $$me->{build_data}{From_Bind}; |
|
690
|
5
|
|
|
|
|
23
|
return \%h; |
|
691
|
|
|
|
|
|
|
} |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
# require the DBD module if it exists |
|
695
|
|
|
|
|
|
|
my %inheritance; |
|
696
|
|
|
|
|
|
|
sub _require_dbd_class { |
|
697
|
22
|
|
|
22
|
|
64
|
my($class, $dbd) = @_; |
|
698
|
22
|
|
|
|
|
65
|
my $dbd_class = $class.'::'.$dbd; |
|
699
|
|
|
|
|
|
|
|
|
700
|
22
|
|
|
|
|
49
|
my $rv; |
|
701
|
|
|
|
|
|
|
my @warn; |
|
702
|
|
|
|
|
|
|
{ |
|
703
|
22
|
|
|
1
|
|
36
|
local $SIG{__WARN__} = sub { push @warn, join '', @_ }; |
|
|
22
|
|
|
|
|
214
|
|
|
|
1
|
|
|
|
|
7
|
|
|
704
|
22
|
|
|
|
|
1677
|
$rv = eval "require $dbd_class"; |
|
705
|
|
|
|
|
|
|
} |
|
706
|
22
|
100
|
|
|
|
117
|
if ($rv) { |
|
707
|
12
|
50
|
|
|
|
44
|
warn @warn if @warn; |
|
708
|
|
|
|
|
|
|
} else { |
|
709
|
10
|
|
|
|
|
69
|
(my $file = $dbd_class.'.pm') =~ s'::'/'g; |
|
710
|
10
|
100
|
|
|
|
226
|
if ($@ !~ / \Q$file\E in \@INC /) { |
|
711
|
1
|
|
|
|
|
7
|
(my $err = $@) =~ s/\n.*$//; # Remove the last line |
|
712
|
1
|
|
|
|
|
2
|
chomp @warn; |
|
713
|
1
|
|
|
|
|
3
|
chomp $err; |
|
714
|
1
|
|
|
|
|
3400
|
croak join "\n", @warn, $err, "Can't load $dbd driver"; |
|
715
|
|
|
|
|
|
|
} |
|
716
|
|
|
|
|
|
|
|
|
717
|
9
|
|
|
|
|
26
|
$@ = ''; |
|
718
|
9
|
|
|
|
|
25
|
delete $INC{$file}; |
|
719
|
9
|
|
|
|
|
71
|
$INC{$file} = 1; |
|
720
|
|
|
|
|
|
|
} |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
# Set the derived DBD class' inheritance |
|
723
|
21
|
100
|
|
|
|
99
|
unless (exists $inheritance{$class}{$dbd}) { |
|
724
|
11
|
|
|
11
|
|
94
|
no strict 'refs'; |
|
|
11
|
|
|
|
|
26
|
|
|
|
11
|
|
|
|
|
3225
|
|
|
725
|
10
|
50
|
|
|
|
149
|
unless (@{$dbd_class.'::ISA'}) { |
|
|
10
|
|
|
|
|
89
|
|
|
726
|
10
|
|
|
|
|
21
|
my @isa = map $_->_require_dbd_class($dbd), grep $_->isa(__PACKAGE__), @{$class.'::ISA'}; |
|
|
10
|
|
|
|
|
71
|
|
|
727
|
10
|
|
|
|
|
23
|
@{$dbd_class.'::ISA'} = ($class, @isa); |
|
|
10
|
|
|
|
|
173
|
|
|
728
|
10
|
100
|
|
|
|
137
|
if (@isa) { |
|
729
|
1
|
|
|
|
|
7
|
mro::set_mro($dbd_class, 'c3'); |
|
730
|
1
|
50
|
|
|
|
6
|
Class::C3::initialize() if $] < 5.009_005; |
|
731
|
|
|
|
|
|
|
} |
|
732
|
|
|
|
|
|
|
} |
|
733
|
10
|
|
|
|
|
29
|
push @CARP_NOT, $dbd_class; |
|
734
|
10
|
|
|
|
|
29
|
$inheritance{$class}{$dbd} = $dbd_class; |
|
735
|
|
|
|
|
|
|
} |
|
736
|
|
|
|
|
|
|
|
|
737
|
21
|
|
|
|
|
116
|
return $inheritance{$class}{$dbd}; |
|
738
|
|
|
|
|
|
|
} |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
1; |