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; |