line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
####################################################################### |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# DBI::SQL::Nano - a very tiny SQL engine |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Copyright (c) 2010 by Jens Rehsack < rehsack AT cpan.org > |
6
|
|
|
|
|
|
|
# Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org > |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# All rights reserved. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# You may freely distribute and/or modify this module under the terms |
11
|
|
|
|
|
|
|
# of either the GNU General Public License (GPL) or the Artistic License, |
12
|
|
|
|
|
|
|
# as specified in the Perl README file. |
13
|
|
|
|
|
|
|
# |
14
|
|
|
|
|
|
|
# See the pod at the bottom of this file for help information |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
####################################################################### |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
####################### |
19
|
|
|
|
|
|
|
package DBI::SQL::Nano; |
20
|
|
|
|
|
|
|
####################### |
21
|
54
|
|
|
54
|
|
364
|
use strict; |
|
54
|
|
|
|
|
106
|
|
|
54
|
|
|
|
|
1578
|
|
22
|
54
|
|
|
54
|
|
304
|
use warnings; |
|
54
|
|
|
|
|
132
|
|
|
54
|
|
|
|
|
1581
|
|
23
|
54
|
|
|
54
|
|
277
|
use vars qw( $VERSION $versions ); |
|
54
|
|
|
|
|
114
|
|
|
54
|
|
|
|
|
2482
|
|
24
|
|
|
|
|
|
|
|
25
|
54
|
|
|
54
|
|
295
|
use Carp qw(croak); |
|
54
|
|
|
|
|
106
|
|
|
54
|
|
|
|
|
8175
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
require DBI; # for looks_like_number() |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
BEGIN |
30
|
|
|
|
|
|
|
{ |
31
|
54
|
|
|
54
|
|
245
|
$VERSION = "1.015544"; |
32
|
|
|
|
|
|
|
|
33
|
54
|
|
|
|
|
201
|
$versions->{nano_version} = $VERSION; |
34
|
54
|
50
|
66
|
|
|
519
|
if ( $ENV{DBI_SQL_NANO} || !eval { require SQL::Statement; $SQL::Statement::VERSION ge '1.400' } ) |
|
30
|
|
|
|
|
4537
|
|
|
0
|
|
|
|
|
0
|
|
35
|
|
|
|
|
|
|
{ |
36
|
54
|
|
|
|
|
1400
|
@DBI::SQL::Nano::Statement::ISA = qw(DBI::SQL::Nano::Statement_); |
37
|
54
|
|
|
|
|
3236
|
@DBI::SQL::Nano::Table::ISA = qw(DBI::SQL::Nano::Table_); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
else |
40
|
|
|
|
|
|
|
{ |
41
|
0
|
|
|
|
|
0
|
@DBI::SQL::Nano::Statement::ISA = qw( SQL::Statement ); |
42
|
0
|
|
|
|
|
0
|
@DBI::SQL::Nano::Table::ISA = qw( SQL::Eval::Table); |
43
|
0
|
|
|
|
|
0
|
$versions->{statement_version} = $SQL::Statement::VERSION; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
################################### |
48
|
|
|
|
|
|
|
package DBI::SQL::Nano::Statement_; |
49
|
|
|
|
|
|
|
################################### |
50
|
|
|
|
|
|
|
|
51
|
54
|
|
|
54
|
|
337
|
use Carp qw(croak); |
|
54
|
|
|
|
|
118
|
|
|
54
|
|
|
|
|
2446
|
|
52
|
54
|
|
|
54
|
|
337
|
use Errno; |
|
54
|
|
|
|
|
114
|
|
|
54
|
|
|
|
|
253675
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
if ( eval { require Clone; } ) |
55
|
|
|
|
|
|
|
{ |
56
|
|
|
|
|
|
|
Clone->import("clone"); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
else |
59
|
|
|
|
|
|
|
{ |
60
|
|
|
|
|
|
|
require Storable; # in CORE since 5.7.3 |
61
|
|
|
|
|
|
|
*clone = \&Storable::dclone; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub new |
65
|
|
|
|
|
|
|
{ |
66
|
750
|
|
|
750
|
|
1975
|
my ( $class, $sql ) = @_; |
67
|
750
|
|
|
|
|
1423
|
my $self = {}; |
68
|
750
|
|
|
|
|
1410
|
bless $self, $class; |
69
|
750
|
|
|
|
|
2188
|
return $self->prepare($sql); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
##################################################################### |
73
|
|
|
|
|
|
|
# PREPARE |
74
|
|
|
|
|
|
|
##################################################################### |
75
|
|
|
|
|
|
|
sub prepare |
76
|
|
|
|
|
|
|
{ |
77
|
750
|
|
|
750
|
|
1697
|
my ( $self, $sql ) = @_; |
78
|
750
|
|
|
|
|
3415
|
$sql =~ s/\s+$//; |
79
|
750
|
|
|
|
|
1630
|
$sql =~ s/\s*;$//; |
80
|
750
|
|
|
|
|
1899
|
for ($sql) |
81
|
|
|
|
|
|
|
{ |
82
|
|
|
|
|
|
|
/^\s*CREATE\s+TABLE\s+(.*?)\s*\((.+)\)\s*$/is |
83
|
|
|
|
|
|
|
&& do |
84
|
750
|
100
|
|
|
|
2798
|
{ |
85
|
86
|
|
|
|
|
341
|
$self->{command} = 'CREATE'; |
86
|
86
|
|
|
|
|
312
|
$self->{table_name} = $1; |
87
|
|
|
|
|
|
|
defined $2 and $2 ne "" and |
88
|
86
|
50
|
33
|
|
|
837
|
$self->{column_names} = parse_coldef_list($2); |
89
|
86
|
50
|
|
|
|
328
|
$self->{column_names} or croak "Can't find columns"; |
90
|
|
|
|
|
|
|
}; |
91
|
|
|
|
|
|
|
/^\s*DROP\s+TABLE\s+(IF\s+EXISTS\s+)?(.*?)\s*$/is |
92
|
|
|
|
|
|
|
&& do |
93
|
750
|
100
|
|
|
|
3355
|
{ |
94
|
128
|
|
|
|
|
536
|
$self->{command} = 'DROP'; |
95
|
128
|
|
|
|
|
461
|
$self->{table_name} = $2; |
96
|
|
|
|
|
|
|
defined $1 and $1 ne "" and |
97
|
128
|
100
|
66
|
|
|
795
|
$self->{ignore_missing_table} = 1; |
98
|
|
|
|
|
|
|
}; |
99
|
|
|
|
|
|
|
/^\s*SELECT\s+(.*?)\s+FROM\s+(\S+)((.*))?/is |
100
|
|
|
|
|
|
|
&& do |
101
|
750
|
100
|
|
|
|
3116
|
{ |
102
|
160
|
|
|
|
|
632
|
$self->{command} = 'SELECT'; |
103
|
|
|
|
|
|
|
defined $1 and $1 ne "" and |
104
|
160
|
50
|
33
|
|
|
1417
|
$self->{column_names} = parse_comma_list($1); |
105
|
160
|
50
|
|
|
|
558
|
$self->{column_names} or croak "Can't find columns"; |
106
|
160
|
|
|
|
|
539
|
$self->{table_name} = $2; |
107
|
160
|
100
|
|
|
|
761
|
if ( my $clauses = $4 ) |
108
|
|
|
|
|
|
|
{ |
109
|
58
|
100
|
|
|
|
368
|
if ( $clauses =~ /^(.*)\s+ORDER\s+BY\s+(.*)$/is ) |
110
|
|
|
|
|
|
|
{ |
111
|
48
|
|
|
|
|
128
|
$clauses = $1; |
112
|
48
|
|
|
|
|
414
|
$self->{order_clause} = $self->parse_order_clause($2); |
113
|
|
|
|
|
|
|
} |
114
|
58
|
100
|
|
|
|
1333
|
$self->{where_clause} = $self->parse_where_clause($clauses) if ($clauses); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
}; |
117
|
|
|
|
|
|
|
/^\s*INSERT\s+(?:INTO\s+)?(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is |
118
|
|
|
|
|
|
|
&& do |
119
|
750
|
100
|
|
|
|
2963
|
{ |
120
|
214
|
|
|
|
|
754
|
$self->{command} = 'INSERT'; |
121
|
214
|
|
|
|
|
684
|
$self->{table_name} = $1; |
122
|
|
|
|
|
|
|
defined $2 and $2 ne "" and |
123
|
214
|
100
|
66
|
|
|
967
|
$self->{column_names} = parse_comma_list($2); |
124
|
|
|
|
|
|
|
defined $4 and $4 ne "" and |
125
|
214
|
50
|
33
|
|
|
2625
|
$self->{values} = $self->parse_values_list($4); |
126
|
214
|
50
|
|
|
|
729
|
$self->{values} or croak "Can't parse values"; |
127
|
|
|
|
|
|
|
}; |
128
|
|
|
|
|
|
|
/^\s*DELETE\s+FROM\s+(\S+)((.*))?/is |
129
|
|
|
|
|
|
|
&& do |
130
|
750
|
100
|
|
|
|
2526
|
{ |
131
|
68
|
|
|
|
|
224
|
$self->{command} = 'DELETE'; |
132
|
68
|
|
|
|
|
201
|
$self->{table_name} = $1; |
133
|
|
|
|
|
|
|
defined $3 and $3 ne "" and |
134
|
68
|
100
|
66
|
|
|
659
|
$self->{where_clause} = $self->parse_where_clause($3); |
135
|
|
|
|
|
|
|
}; |
136
|
|
|
|
|
|
|
/^\s*UPDATE\s+(\S+)\s+SET\s+(.+)(\s+WHERE\s+.+)/is |
137
|
|
|
|
|
|
|
&& do |
138
|
750
|
100
|
|
|
|
2678
|
{ |
139
|
46
|
|
|
|
|
177
|
$self->{command} = 'UPDATE'; |
140
|
46
|
|
|
|
|
175
|
$self->{table_name} = $1; |
141
|
46
|
50
|
33
|
|
|
597
|
defined $2 and $2 ne "" and |
142
|
|
|
|
|
|
|
$self->parse_set_clause($2); |
143
|
|
|
|
|
|
|
defined $3 and $3 ne "" and |
144
|
46
|
50
|
33
|
|
|
440
|
$self->{where_clause} = $self->parse_where_clause($3); |
145
|
|
|
|
|
|
|
}; |
146
|
|
|
|
|
|
|
} |
147
|
750
|
100
|
66
|
|
|
10625
|
croak "Couldn't parse" unless ( $self->{command} and $self->{table_name} ); |
148
|
702
|
|
|
|
|
2471
|
return $self; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub parse_order_clause |
152
|
|
|
|
|
|
|
{ |
153
|
48
|
|
|
48
|
|
189
|
my ( $self, $str ) = @_; |
154
|
48
|
|
|
|
|
207
|
my @clause = split /\s+/, $str; |
155
|
48
|
100
|
|
|
|
270
|
return { $clause[0] => 'ASC' } if ( @clause == 1 ); |
156
|
12
|
50
|
|
|
|
37
|
croak "Bad ORDER BY clause '$str'" if ( @clause > 2 ); |
157
|
12
|
|
50
|
|
|
36
|
$clause[1] ||= ''; |
158
|
12
|
50
|
33
|
|
|
131
|
return { $clause[0] => uc $clause[1] } |
159
|
|
|
|
|
|
|
if $clause[1] =~ /^ASC$/i |
160
|
|
|
|
|
|
|
or $clause[1] =~ /^DESC$/i; |
161
|
0
|
|
|
|
|
0
|
croak "Bad ORDER BY clause '$clause[1]'"; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub parse_coldef_list |
165
|
|
|
|
|
|
|
{ # check column definitions |
166
|
86
|
|
|
86
|
|
182
|
my @col_defs; |
167
|
86
|
|
|
|
|
443
|
for ( split ',', shift ) |
168
|
|
|
|
|
|
|
{ |
169
|
164
|
|
|
|
|
462
|
my $col = clean_parse_str($_); |
170
|
164
|
50
|
|
|
|
1597
|
if ( $col =~ /^(\S+?)\s+.+/ ) |
171
|
|
|
|
|
|
|
{ # doesn't check what it is |
172
|
164
|
|
|
|
|
378
|
$col = $1; # just checks if it exists |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
else |
175
|
|
|
|
|
|
|
{ |
176
|
0
|
|
|
|
|
0
|
croak "No column definition for '$_'"; |
177
|
|
|
|
|
|
|
} |
178
|
164
|
|
|
|
|
405
|
push @col_defs, $col; |
179
|
|
|
|
|
|
|
} |
180
|
86
|
|
|
|
|
280
|
return \@col_defs; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub parse_comma_list |
184
|
|
|
|
|
|
|
{ |
185
|
192
|
|
|
192
|
|
898
|
[ map { clean_parse_str($_) } split( ',', shift ) ]; |
|
284
|
|
|
|
|
697
|
|
186
|
|
|
|
|
|
|
} |
187
|
874
|
|
|
874
|
|
1599
|
sub clean_parse_str { local $_ = shift; s/\(//; s/\)//; s/^\s+//; s/\s+$//; $_; } |
|
874
|
|
|
|
|
1657
|
|
|
874
|
|
|
|
|
1404
|
|
|
874
|
|
|
|
|
1990
|
|
|
874
|
|
|
|
|
1880
|
|
|
874
|
|
|
|
|
3288
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub parse_values_list |
190
|
|
|
|
|
|
|
{ |
191
|
214
|
|
|
214
|
|
820
|
my ( $self, $str ) = @_; |
192
|
214
|
|
|
|
|
891
|
[ map { $self->parse_value( clean_parse_str($_) ) } split( ',', $str ) ]; |
|
426
|
|
|
|
|
1043
|
|
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub parse_set_clause |
196
|
|
|
|
|
|
|
{ |
197
|
46
|
|
|
46
|
|
101
|
my $self = shift; |
198
|
46
|
|
|
|
|
194
|
my @cols = split /,/, shift; |
199
|
46
|
|
|
|
|
107
|
my $set_clause; |
200
|
46
|
|
|
|
|
148
|
for my $col (@cols) |
201
|
|
|
|
|
|
|
{ |
202
|
46
|
|
|
|
|
332
|
my ( $col_name, $value ) = $col =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/s; |
203
|
46
|
|
|
|
|
125
|
push @{ $self->{column_names} }, $col_name; |
|
46
|
|
|
|
|
188
|
|
204
|
46
|
|
|
|
|
98
|
push @{ $self->{values} }, $self->parse_value($value); |
|
46
|
|
|
|
|
212
|
|
205
|
|
|
|
|
|
|
} |
206
|
46
|
50
|
33
|
|
|
342
|
croak "Can't parse set clause" unless ( $self->{column_names} and $self->{values} ); |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub parse_value |
210
|
|
|
|
|
|
|
{ |
211
|
652
|
|
|
652
|
|
1332
|
my ( $self, $str ) = @_; |
212
|
652
|
50
|
|
|
|
1390
|
return unless ( defined $str ); |
213
|
652
|
|
|
|
|
1371
|
$str =~ s/\s+$//; |
214
|
652
|
|
|
|
|
1215
|
$str =~ s/^\s+//; |
215
|
652
|
100
|
|
|
|
1574
|
if ( $str =~ /^\?$/ ) |
216
|
|
|
|
|
|
|
{ |
217
|
164
|
|
|
|
|
252
|
push @{ $self->{params} }, '?'; |
|
164
|
|
|
|
|
449
|
|
218
|
|
|
|
|
|
|
return { |
219
|
164
|
|
|
|
|
869
|
value => '?', |
220
|
|
|
|
|
|
|
type => 'placeholder' |
221
|
|
|
|
|
|
|
}; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
return { |
224
|
488
|
100
|
|
|
|
1115
|
value => undef, |
225
|
|
|
|
|
|
|
type => 'NULL' |
226
|
|
|
|
|
|
|
} if ( $str =~ /^NULL$/i ); |
227
|
|
|
|
|
|
|
return { |
228
|
476
|
100
|
|
|
|
2240
|
value => $1, |
229
|
|
|
|
|
|
|
type => 'string' |
230
|
|
|
|
|
|
|
} if ( $str =~ /^'(.+)'$/s ); |
231
|
|
|
|
|
|
|
return { |
232
|
300
|
100
|
|
|
|
1375
|
value => $str, |
233
|
|
|
|
|
|
|
type => 'number' |
234
|
|
|
|
|
|
|
} if ( DBI::looks_like_number($str) ); |
235
|
|
|
|
|
|
|
return { |
236
|
110
|
|
|
|
|
542
|
value => $str, |
237
|
|
|
|
|
|
|
type => 'column' |
238
|
|
|
|
|
|
|
}; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub parse_where_clause |
242
|
|
|
|
|
|
|
{ |
243
|
90
|
|
|
90
|
|
298
|
my ( $self, $str ) = @_; |
244
|
90
|
|
|
|
|
333
|
$str =~ s/\s+$//; |
245
|
90
|
50
|
|
|
|
397
|
if ( $str =~ /^\s*WHERE\s+(.*)/i ) |
246
|
|
|
|
|
|
|
{ |
247
|
90
|
|
|
|
|
231
|
$str = $1; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
else |
250
|
|
|
|
|
|
|
{ |
251
|
0
|
|
|
|
|
0
|
croak "Couldn't find WHERE clause in '$str'"; |
252
|
|
|
|
|
|
|
} |
253
|
90
|
|
|
|
|
317
|
my ($neg) = $str =~ s/^\s*(NOT)\s+//is; |
254
|
90
|
|
|
|
|
180
|
my $opexp = '=|<>|<=|>=|<|>|LIKE|CLIKE|IS'; |
255
|
90
|
|
|
|
|
1670
|
my ( $val1, $op, $val2 ) = $str =~ /^(.+?)\s*($opexp)\s*(.+)\s*$/iso; |
256
|
90
|
50
|
33
|
|
|
628
|
croak "Couldn't parse WHERE expression '$str'" unless ( defined $val1 and defined $op and defined $val2 ); |
|
|
|
33
|
|
|
|
|
257
|
|
|
|
|
|
|
return { |
258
|
90
|
|
|
|
|
275
|
arg1 => $self->parse_value($val1), |
259
|
|
|
|
|
|
|
arg2 => $self->parse_value($val2), |
260
|
|
|
|
|
|
|
op => $op, |
261
|
|
|
|
|
|
|
neg => $neg, |
262
|
|
|
|
|
|
|
}; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
##################################################################### |
266
|
|
|
|
|
|
|
# EXECUTE |
267
|
|
|
|
|
|
|
##################################################################### |
268
|
|
|
|
|
|
|
sub execute |
269
|
|
|
|
|
|
|
{ |
270
|
502
|
|
|
502
|
|
1235
|
my ( $self, $data, $params ) = @_; |
271
|
502
|
|
|
|
|
1077
|
my $num_placeholders = $self->params; |
272
|
502
|
|
100
|
|
|
1944
|
my $num_params = scalar @$params || 0; |
273
|
502
|
50
|
|
|
|
1339
|
croak "Number of params '$num_params' does not match number of placeholders '$num_placeholders'" |
274
|
|
|
|
|
|
|
unless ( $num_placeholders == $num_params ); |
275
|
502
|
100
|
|
|
|
1465
|
if ( scalar @$params ) |
276
|
|
|
|
|
|
|
{ |
277
|
64
|
|
|
|
|
151
|
for my $i ( 0 .. $#{ $self->{values} } ) |
|
64
|
|
|
|
|
262
|
|
278
|
|
|
|
|
|
|
{ |
279
|
120
|
50
|
|
|
|
371
|
if ( $self->{values}->[$i]->{type} eq 'placeholder' ) |
280
|
|
|
|
|
|
|
{ |
281
|
120
|
|
|
|
|
313
|
$self->{values}->[$i]->{value} = shift @$params; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
64
|
50
|
|
|
|
241
|
if ( $self->{where_clause} ) |
285
|
|
|
|
|
|
|
{ |
286
|
0
|
0
|
|
|
|
0
|
if ( $self->{where_clause}->{arg1}->{type} eq 'placeholder' ) |
287
|
|
|
|
|
|
|
{ |
288
|
0
|
|
|
|
|
0
|
$self->{where_clause}->{arg1}->{value} = shift @$params; |
289
|
|
|
|
|
|
|
} |
290
|
0
|
0
|
|
|
|
0
|
if ( $self->{where_clause}->{arg2}->{type} eq 'placeholder' ) |
291
|
|
|
|
|
|
|
{ |
292
|
0
|
|
|
|
|
0
|
$self->{where_clause}->{arg2}->{value} = shift @$params; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
502
|
|
|
|
|
1064
|
my $command = $self->{command}; |
297
|
502
|
|
|
|
|
3030
|
( $self->{'NUM_OF_ROWS'}, $self->{'NUM_OF_FIELDS'}, $self->{'data'}, ) = $self->$command( $data, $params ); |
298
|
470
|
|
66
|
|
|
3030
|
$self->{NAME} ||= $self->{column_names}; |
299
|
470
|
|
100
|
|
|
3922
|
return $self->{'NUM_OF_ROWS'} || '0E0'; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
my $enoentstr = "Cannot open .*\(" . Errno::ENOENT . "\)"; |
303
|
|
|
|
|
|
|
my $enoentrx = qr/$enoentstr/; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub DROP ($$$) |
306
|
|
|
|
|
|
|
{ |
307
|
120
|
|
|
120
|
|
333
|
my ( $self, $data, $params ) = @_; |
308
|
|
|
|
|
|
|
|
309
|
120
|
|
|
|
|
256
|
my $table; |
310
|
|
|
|
|
|
|
my @err; |
311
|
120
|
|
|
|
|
218
|
eval { |
312
|
120
|
|
|
0
|
|
870
|
local $SIG{__WARN__} = sub { push @err, @_ }; |
|
0
|
|
|
|
|
0
|
|
313
|
120
|
|
|
|
|
522
|
($table) = $self->open_tables( $data, 0, 1 ); |
314
|
|
|
|
|
|
|
}; |
315
|
120
|
100
|
66
|
|
|
3855
|
if ( $self->{ignore_missing_table} and ( $@ or @err ) and grep { $_ =~ $enoentrx } ( @err, $@ ) ) |
|
40
|
|
100
|
|
|
526
|
|
|
|
|
66
|
|
|
|
|
316
|
|
|
|
|
|
|
{ |
317
|
40
|
|
|
|
|
122
|
$@ = ''; |
318
|
40
|
|
|
|
|
230
|
return ( -1, 0 ); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
80
|
100
|
33
|
|
|
1162
|
croak( $@ || $err[0] ) if ( $@ || @err ); |
|
|
|
66
|
|
|
|
|
322
|
72
|
50
|
|
|
|
254
|
return ( -1, 0 ) unless $table; |
323
|
|
|
|
|
|
|
|
324
|
72
|
|
|
|
|
441
|
$table->drop($data); |
325
|
72
|
|
|
|
|
414
|
( -1, 0 ); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub CREATE ($$$) |
329
|
|
|
|
|
|
|
{ |
330
|
66
|
|
|
66
|
|
205
|
my ( $self, $data, $params ) = @_; |
331
|
66
|
|
|
|
|
283
|
my $table = $self->open_tables( $data, 1, 1 ); |
332
|
66
|
|
|
|
|
424
|
$table->push_names( $data, $self->{column_names} ); |
333
|
66
|
|
|
|
|
721
|
( 0, 0 ); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub INSERT ($$$) |
337
|
|
|
|
|
|
|
{ |
338
|
142
|
|
|
142
|
|
365
|
my ( $self, $data, $params ) = @_; |
339
|
142
|
|
|
|
|
452
|
my $table = $self->open_tables( $data, 0, 1 ); |
340
|
134
|
|
|
|
|
841
|
$self->verify_columns($table); |
341
|
134
|
|
|
|
|
289
|
my $all_columns = $table->{col_names}; |
342
|
134
|
50
|
|
|
|
1204
|
$table->seek( $data, 0, 2 ) unless ( $table->can('insert_one_row') ); |
343
|
134
|
|
|
|
|
305
|
my ($array) = []; |
344
|
134
|
|
|
|
|
295
|
my ( $val, $col, $i ); |
345
|
134
|
50
|
|
|
|
411
|
$self->{column_names} = $table->col_names() unless ( $self->{column_names} ); |
346
|
134
|
50
|
|
|
|
398
|
my $cNum = scalar( @{ $self->{column_names} } ) if ( $self->{column_names} ); |
|
134
|
|
|
|
|
332
|
|
347
|
134
|
|
|
|
|
239
|
my $param_num = 0; |
348
|
|
|
|
|
|
|
|
349
|
134
|
50
|
|
|
|
398
|
$cNum or |
350
|
|
|
|
|
|
|
croak "Bad col names in INSERT"; |
351
|
|
|
|
|
|
|
|
352
|
134
|
|
|
|
|
262
|
my $maxCol = $#$all_columns; |
353
|
|
|
|
|
|
|
|
354
|
134
|
|
|
|
|
516
|
for ( $i = 0; $i < $cNum; $i++ ) |
355
|
|
|
|
|
|
|
{ |
356
|
268
|
|
|
|
|
520
|
$col = $self->{column_names}->[$i]; |
357
|
268
|
|
|
|
|
847
|
$array->[ $self->column_nums( $table, $col ) ] = $self->row_values($i); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# Extend row to put values in ALL fields |
361
|
134
|
50
|
|
|
|
398
|
$#$array < $maxCol and $array->[$maxCol] = undef; |
362
|
|
|
|
|
|
|
|
363
|
134
|
100
|
|
|
|
1032
|
$table->can('insert_new_row') ? $table->insert_new_row( $data, $array ) : $table->push_row( $data, $array ); |
364
|
|
|
|
|
|
|
|
365
|
134
|
|
|
|
|
660
|
return ( 1, 0 ); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub DELETE ($$$) |
369
|
|
|
|
|
|
|
{ |
370
|
36
|
|
|
36
|
|
116
|
my ( $self, $data, $params ) = @_; |
371
|
36
|
|
|
|
|
143
|
my $table = $self->open_tables( $data, 0, 1 ); |
372
|
28
|
|
|
|
|
115
|
$self->verify_columns($table); |
373
|
28
|
|
|
|
|
61
|
my ($affected) = 0; |
374
|
28
|
|
|
|
|
53
|
my ( @rows, $array ); |
375
|
28
|
|
|
|
|
149
|
my $can_dor = $table->can('delete_one_row'); |
376
|
28
|
|
|
|
|
128
|
while ( $array = $table->fetch_row($data) ) |
377
|
|
|
|
|
|
|
{ |
378
|
102
|
100
|
|
|
|
317
|
if ( $self->eval_where( $table, $array ) ) |
379
|
|
|
|
|
|
|
{ |
380
|
60
|
|
|
|
|
91
|
++$affected; |
381
|
60
|
100
|
|
|
|
136
|
if ( $self->{fetched_from_key} ) |
382
|
|
|
|
|
|
|
{ |
383
|
8
|
|
|
|
|
24
|
$array = $self->{fetched_value}; |
384
|
8
|
|
|
|
|
41
|
$table->delete_one_row( $data, $array ); |
385
|
8
|
|
|
|
|
59
|
return ( $affected, 0 ); |
386
|
|
|
|
|
|
|
} |
387
|
52
|
100
|
|
|
|
196
|
push( @rows, $array ) if ($can_dor); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
else |
390
|
|
|
|
|
|
|
{ |
391
|
42
|
100
|
|
|
|
134
|
push( @rows, $array ) unless ($can_dor); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
} |
394
|
20
|
100
|
|
|
|
67
|
if ($can_dor) |
395
|
|
|
|
|
|
|
{ |
396
|
16
|
|
|
|
|
42
|
foreach $array (@rows) |
397
|
|
|
|
|
|
|
{ |
398
|
48
|
|
|
|
|
156
|
$table->delete_one_row( $data, $array ); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
else |
402
|
|
|
|
|
|
|
{ |
403
|
4
|
|
|
|
|
28
|
$table->seek( $data, 0, 0 ); |
404
|
4
|
|
|
|
|
8
|
foreach $array (@rows) |
405
|
|
|
|
|
|
|
{ |
406
|
2
|
|
|
|
|
7
|
$table->push_row( $data, $array ); |
407
|
|
|
|
|
|
|
} |
408
|
4
|
|
|
|
|
10
|
$table->truncate($data); |
409
|
|
|
|
|
|
|
} |
410
|
20
|
|
|
|
|
124
|
return ( $affected, 0 ); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub _anycmp($$;$) |
414
|
|
|
|
|
|
|
{ |
415
|
64
|
|
|
64
|
|
151
|
my ( $a, $b, $case_fold ) = @_; |
416
|
|
|
|
|
|
|
|
417
|
64
|
50
|
33
|
|
|
447
|
if ( !defined($a) || !defined($b) ) |
|
|
50
|
33
|
|
|
|
|
418
|
|
|
|
|
|
|
{ |
419
|
0
|
|
|
|
|
0
|
return defined($a) - defined($b); |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
elsif ( DBI::looks_like_number($a) && DBI::looks_like_number($b) ) |
422
|
|
|
|
|
|
|
{ |
423
|
64
|
|
|
|
|
163
|
return $a <=> $b; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
else |
426
|
|
|
|
|
|
|
{ |
427
|
0
|
0
|
0
|
|
|
0
|
return $case_fold ? lc($a) cmp lc($b) || $a cmp $b : $a cmp $b; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub SELECT ($$$) |
432
|
|
|
|
|
|
|
{ |
433
|
104
|
|
|
104
|
|
322
|
my ( $self, $data, $params ) = @_; |
434
|
104
|
|
|
|
|
415
|
my $table = $self->open_tables( $data, 0, 0 ); |
435
|
96
|
|
|
|
|
619
|
$self->verify_columns($table); |
436
|
96
|
|
|
|
|
251
|
my $tname = $self->{table_name}; |
437
|
96
|
|
|
|
|
224
|
my ($affected) = 0; |
438
|
96
|
|
|
|
|
225
|
my ( @rows, %cols, $array, $val, $col, $i ); |
439
|
96
|
|
|
|
|
472
|
while ( $array = $table->fetch_row($data) ) |
440
|
|
|
|
|
|
|
{ |
441
|
202
|
50
|
|
|
|
1038
|
if ( $self->eval_where( $table, $array ) ) |
442
|
|
|
|
|
|
|
{ |
443
|
202
|
50
|
|
|
|
510
|
$array = $self->{fetched_value} if ( $self->{fetched_from_key} ); |
444
|
202
|
100
|
|
|
|
520
|
unless ( keys %cols ) |
445
|
|
|
|
|
|
|
{ |
446
|
96
|
|
|
|
|
269
|
my $col_nums = $self->column_nums($table); |
447
|
96
|
|
|
|
|
238
|
%cols = reverse %{$col_nums}; |
|
96
|
|
|
|
|
494
|
|
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
202
|
|
|
|
|
396
|
my $rowhash; |
451
|
202
|
|
|
|
|
725
|
for ( sort keys %cols ) |
452
|
|
|
|
|
|
|
{ |
453
|
378
|
|
|
|
|
1096
|
$rowhash->{ $cols{$_} } = $array->[$_]; |
454
|
|
|
|
|
|
|
} |
455
|
202
|
|
|
|
|
357
|
my @newarray; |
456
|
202
|
|
|
|
|
394
|
for ( $i = 0; $i < @{ $self->{column_names} }; $i++ ) |
|
580
|
|
|
|
|
1277
|
|
457
|
|
|
|
|
|
|
{ |
458
|
378
|
|
|
|
|
623
|
$col = $self->{column_names}->[$i]; |
459
|
378
|
|
|
|
|
818
|
push @newarray, $rowhash->{$col}; |
460
|
|
|
|
|
|
|
} |
461
|
202
|
|
|
|
|
407
|
push( @rows, \@newarray ); |
462
|
0
|
|
|
|
|
0
|
return ( scalar(@rows), scalar @{ $self->{column_names} }, \@rows ) |
463
|
202
|
50
|
|
|
|
888
|
if ( $self->{fetched_from_key} ); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
} |
466
|
96
|
100
|
|
|
|
443
|
if ( $self->{order_clause} ) |
467
|
|
|
|
|
|
|
{ |
468
|
32
|
|
|
|
|
66
|
my ( $sort_col, $desc ) = each %{ $self->{order_clause} }; |
|
32
|
|
|
|
|
146
|
|
469
|
32
|
|
|
|
|
138
|
my @sortCols = ( $self->column_nums( $table, $sort_col, 1 ) ); |
470
|
32
|
100
|
|
|
|
138
|
$sortCols[1] = uc $desc eq 'DESC' ? 1 : 0; |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
@rows = sort { |
473
|
32
|
|
|
|
|
183
|
my ( $result, $colNum, $desc ); |
|
64
|
|
|
|
|
114
|
|
474
|
64
|
|
|
|
|
92
|
my $i = 0; |
475
|
|
|
|
|
|
|
do |
476
|
64
|
|
33
|
|
|
89
|
{ |
477
|
64
|
|
|
|
|
108
|
$colNum = $sortCols[ $i++ ]; |
478
|
64
|
|
|
|
|
100
|
$desc = $sortCols[ $i++ ]; |
479
|
64
|
|
|
|
|
175
|
$result = _anycmp( $a->[$colNum], $b->[$colNum] ); |
480
|
64
|
100
|
|
|
|
273
|
$result = -$result if ($desc); |
481
|
|
|
|
|
|
|
} while ( !$result && $i < @sortCols ); |
482
|
|
|
|
|
|
|
$result; |
483
|
|
|
|
|
|
|
} @rows; |
484
|
|
|
|
|
|
|
} |
485
|
96
|
|
|
|
|
235
|
( scalar(@rows), scalar @{ $self->{column_names} }, \@rows ); |
|
96
|
|
|
|
|
632
|
|
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
sub UPDATE ($$$) |
489
|
|
|
|
|
|
|
{ |
490
|
34
|
|
|
34
|
|
112
|
my ( $self, $data, $params ) = @_; |
491
|
34
|
|
|
|
|
141
|
my $table = $self->open_tables( $data, 0, 1 ); |
492
|
34
|
|
|
|
|
167
|
$self->verify_columns($table); |
493
|
34
|
50
|
|
|
|
122
|
return undef unless $table; |
494
|
34
|
|
|
|
|
69
|
my $affected = 0; |
495
|
34
|
|
|
|
|
176
|
my $can_usr = $table->can('update_specific_row'); |
496
|
34
|
|
|
|
|
145
|
my $can_uor = $table->can('update_one_row'); |
497
|
34
|
|
66
|
|
|
126
|
my $can_rwu = $can_usr || $can_uor; |
498
|
34
|
|
|
|
|
90
|
my ( @rows, $array, $f_array, $val, $col, $i ); |
499
|
|
|
|
|
|
|
|
500
|
34
|
|
|
|
|
186
|
while ( $array = $table->fetch_row($data) ) |
501
|
|
|
|
|
|
|
{ |
502
|
60
|
100
|
|
|
|
195
|
if ( $self->eval_where( $table, $array ) ) |
503
|
|
|
|
|
|
|
{ |
504
|
58
|
100
|
66
|
|
|
233
|
$array = $self->{fetched_value} if ( $self->{fetched_from_key} and $can_rwu ); |
505
|
58
|
100
|
|
|
|
1718
|
my $orig_ary = clone($array) if ($can_usr); |
506
|
58
|
|
|
|
|
222
|
for ( $i = 0; $i < @{ $self->{column_names} }; $i++ ) |
|
116
|
|
|
|
|
373
|
|
507
|
|
|
|
|
|
|
{ |
508
|
58
|
|
|
|
|
142
|
$col = $self->{column_names}->[$i]; |
509
|
58
|
|
|
|
|
184
|
$array->[ $self->column_nums( $table, $col ) ] = $self->row_values($i); |
510
|
|
|
|
|
|
|
} |
511
|
58
|
|
|
|
|
114
|
$affected++; |
512
|
58
|
100
|
|
|
|
159
|
if ( $self->{fetched_value} ) |
513
|
|
|
|
|
|
|
{ |
514
|
8
|
50
|
|
|
|
26
|
if ($can_usr) |
|
|
0
|
|
|
|
|
|
515
|
|
|
|
|
|
|
{ |
516
|
8
|
|
|
|
|
53
|
$table->update_specific_row( $data, $array, $orig_ary ); |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
elsif ($can_uor) |
519
|
|
|
|
|
|
|
{ |
520
|
0
|
|
|
|
|
0
|
$table->update_one_row( $data, $array ); |
521
|
|
|
|
|
|
|
} |
522
|
8
|
|
|
|
|
63
|
return ( $affected, 0 ); |
523
|
|
|
|
|
|
|
} |
524
|
50
|
100
|
|
|
|
269
|
push( @rows, $can_usr ? [ $array, $orig_ary ] : $array ); |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
else |
527
|
|
|
|
|
|
|
{ |
528
|
2
|
50
|
|
|
|
10
|
push( @rows, $array ) unless ($can_rwu); |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
} |
531
|
26
|
100
|
|
|
|
97
|
if ($can_rwu) |
532
|
|
|
|
|
|
|
{ |
533
|
24
|
|
|
|
|
71
|
foreach my $array (@rows) |
534
|
|
|
|
|
|
|
{ |
535
|
48
|
50
|
|
|
|
134
|
if ($can_usr) |
|
|
0
|
|
|
|
|
|
536
|
|
|
|
|
|
|
{ |
537
|
48
|
|
|
|
|
177
|
$table->update_specific_row( $data, @$array ); |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
elsif ($can_uor) |
540
|
|
|
|
|
|
|
{ |
541
|
0
|
|
|
|
|
0
|
$table->update_one_row( $data, $array ); |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
else |
546
|
|
|
|
|
|
|
{ |
547
|
2
|
|
|
|
|
10
|
$table->seek( $data, 0, 0 ); |
548
|
2
|
|
|
|
|
5
|
foreach my $array (@rows) |
549
|
|
|
|
|
|
|
{ |
550
|
4
|
|
|
|
|
12
|
$table->push_row( $data, $array ); |
551
|
|
|
|
|
|
|
} |
552
|
2
|
|
|
|
|
9
|
$table->truncate($data); |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
26
|
|
|
|
|
177
|
return ( $affected, 0 ); |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
sub verify_columns |
559
|
|
|
|
|
|
|
{ |
560
|
292
|
|
|
292
|
|
750
|
my ( $self, $table ) = @_; |
561
|
292
|
|
|
|
|
528
|
my @cols = @{ $self->{column_names} }; |
|
292
|
|
|
|
|
1013
|
|
562
|
292
|
100
|
|
|
|
904
|
if ( $self->{where_clause} ) |
563
|
|
|
|
|
|
|
{ |
564
|
54
|
50
|
|
|
|
203
|
if ( my $col = $self->{where_clause}->{arg1} ) |
565
|
|
|
|
|
|
|
{ |
566
|
54
|
50
|
|
|
|
247
|
push @cols, $col->{value} if $col->{type} eq 'column'; |
567
|
|
|
|
|
|
|
} |
568
|
54
|
50
|
|
|
|
186
|
if ( my $col = $self->{where_clause}->{arg2} ) |
569
|
|
|
|
|
|
|
{ |
570
|
54
|
50
|
|
|
|
207
|
push @cols, $col->{value} if $col->{type} eq 'column'; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
} |
573
|
292
|
|
|
|
|
888
|
for (@cols) |
574
|
|
|
|
|
|
|
{ |
575
|
590
|
|
|
|
|
1510
|
$self->column_nums( $table, $_ ); |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub column_nums |
580
|
|
|
|
|
|
|
{ |
581
|
1044
|
|
|
1044
|
|
2134
|
my ( $self, $table, $stmt_col_name, $find_in_stmt ) = @_; |
582
|
1044
|
|
|
|
|
1340
|
my %dbd_nums = %{ $table->col_nums() }; |
|
1044
|
|
|
|
|
2034
|
|
583
|
1044
|
|
|
|
|
1649
|
my @dbd_cols = @{ $table->col_names() }; |
|
1044
|
|
|
|
|
1913
|
|
584
|
1044
|
|
|
|
|
1486
|
my %stmt_nums; |
585
|
1044
|
100
|
100
|
|
|
3231
|
if ( $stmt_col_name and !$find_in_stmt ) |
586
|
|
|
|
|
|
|
{ |
587
|
916
|
|
|
|
|
2654
|
while ( my ( $k, $v ) = each %dbd_nums ) |
588
|
|
|
|
|
|
|
{ |
589
|
1373
|
100
|
|
|
|
5621
|
return $v if uc $k eq uc $stmt_col_name; |
590
|
|
|
|
|
|
|
} |
591
|
0
|
|
|
|
|
0
|
croak "No such column '$stmt_col_name'"; |
592
|
|
|
|
|
|
|
} |
593
|
128
|
100
|
66
|
|
|
556
|
if ( $stmt_col_name and $find_in_stmt ) |
594
|
|
|
|
|
|
|
{ |
595
|
32
|
|
|
|
|
101
|
for my $i ( 0 .. @{ $self->{column_names} } ) |
|
32
|
|
|
|
|
125
|
|
596
|
|
|
|
|
|
|
{ |
597
|
32
|
50
|
|
|
|
226
|
return $i if uc $stmt_col_name eq uc $self->{column_names}->[$i]; |
598
|
|
|
|
|
|
|
} |
599
|
0
|
|
|
|
|
0
|
croak "No such column '$stmt_col_name'"; |
600
|
|
|
|
|
|
|
} |
601
|
96
|
|
|
|
|
379
|
for my $i ( 0 .. $#dbd_cols ) |
602
|
|
|
|
|
|
|
{ |
603
|
180
|
|
|
|
|
285
|
for my $stmt_col ( @{ $self->{column_names} } ) |
|
180
|
|
|
|
|
426
|
|
604
|
|
|
|
|
|
|
{ |
605
|
344
|
100
|
|
|
|
1040
|
$stmt_nums{$stmt_col} = $i if uc $dbd_cols[$i] eq uc $stmt_col; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
} |
608
|
96
|
|
|
|
|
439
|
return \%stmt_nums; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub eval_where |
612
|
|
|
|
|
|
|
{ |
613
|
364
|
|
|
364
|
|
743
|
my ( $self, $table, $rowary ) = @_; |
614
|
364
|
|
100
|
|
|
1138
|
my $where = $self->{"where_clause"} || return 1; |
615
|
130
|
|
|
|
|
311
|
my $col_nums = $table->col_nums(); |
616
|
130
|
|
|
|
|
187
|
my %cols = reverse %{$col_nums}; |
|
130
|
|
|
|
|
463
|
|
617
|
130
|
|
|
|
|
201
|
my $rowhash; |
618
|
130
|
|
|
|
|
490
|
for ( sort keys %cols ) |
619
|
|
|
|
|
|
|
{ |
620
|
260
|
|
|
|
|
2004
|
$rowhash->{ uc $cols{$_} } = $rowary->[$_]; |
621
|
|
|
|
|
|
|
} |
622
|
130
|
|
|
|
|
509
|
return $self->process_predicate( $where, $table, $rowhash ); |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub process_predicate |
626
|
|
|
|
|
|
|
{ |
627
|
130
|
|
|
130
|
|
302
|
my ( $self, $pred, $table, $rowhash ) = @_; |
628
|
130
|
|
|
|
|
220
|
my $val1 = $pred->{arg1}; |
629
|
130
|
50
|
|
|
|
1325
|
if ( $val1->{type} eq 'column' ) |
630
|
|
|
|
|
|
|
{ |
631
|
130
|
|
|
|
|
348
|
$val1 = $rowhash->{ uc $val1->{value} }; |
632
|
|
|
|
|
|
|
} |
633
|
|
|
|
|
|
|
else |
634
|
|
|
|
|
|
|
{ |
635
|
0
|
|
|
|
|
0
|
$val1 = $val1->{value}; |
636
|
|
|
|
|
|
|
} |
637
|
130
|
|
|
|
|
210
|
my $val2 = $pred->{arg2}; |
638
|
130
|
50
|
|
|
|
252
|
if ( $val2->{type} eq 'column' ) |
639
|
|
|
|
|
|
|
{ |
640
|
0
|
|
|
|
|
0
|
$val2 = $rowhash->{ uc $val2->{value} }; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
else |
643
|
|
|
|
|
|
|
{ |
644
|
130
|
|
|
|
|
205
|
$val2 = $val2->{value}; |
645
|
|
|
|
|
|
|
} |
646
|
130
|
|
|
|
|
206
|
my $op = $pred->{op}; |
647
|
130
|
|
|
|
|
215
|
my $neg = $pred->{neg}; |
648
|
130
|
100
|
33
|
|
|
881
|
if ( $op eq '=' and !$neg and $table->can('fetch_one_row') ) |
|
|
|
66
|
|
|
|
|
649
|
|
|
|
|
|
|
{ |
650
|
120
|
|
|
|
|
389
|
my $key_col = $table->fetch_one_row( 1, 1 ); |
651
|
120
|
100
|
|
|
|
793
|
if ( $pred->{arg1}->{value} =~ /^$key_col$/i ) |
652
|
|
|
|
|
|
|
{ |
653
|
16
|
|
|
|
|
54
|
$self->{fetched_from_key} = 1; |
654
|
16
|
|
|
|
|
55
|
$self->{fetched_value} = $table->fetch_one_row( 0, $pred->{arg2}->{value} ); |
655
|
16
|
|
|
|
|
86
|
return 1; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
} |
658
|
114
|
|
100
|
|
|
358
|
my $match = $self->is_matched( $val1, $op, $val2 ) || 0; |
659
|
114
|
0
|
|
|
|
241
|
if ($neg) { $match = $match ? 0 : 1; } |
|
0
|
50
|
|
|
|
0
|
|
660
|
114
|
|
|
|
|
484
|
return $match; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub is_matched |
664
|
|
|
|
|
|
|
{ |
665
|
114
|
|
|
114
|
|
257
|
my ( $self, $val1, $op, $val2 ) = @_; |
666
|
114
|
50
|
|
|
|
252
|
if ( $op eq 'IS' ) |
667
|
|
|
|
|
|
|
{ |
668
|
0
|
0
|
0
|
|
|
0
|
return 1 if ( !defined $val1 or $val1 eq '' ); |
669
|
0
|
|
|
|
|
0
|
return 0; |
670
|
|
|
|
|
|
|
} |
671
|
114
|
50
|
|
|
|
236
|
$val1 = '' unless ( defined $val1 ); |
672
|
114
|
50
|
|
|
|
238
|
$val2 = '' unless ( defined $val2 ); |
673
|
114
|
50
|
|
|
|
251
|
if ( $op =~ /LIKE|CLIKE/i ) |
674
|
|
|
|
|
|
|
{ |
675
|
0
|
|
|
|
|
0
|
$val2 = quotemeta($val2); |
676
|
0
|
|
|
|
|
0
|
$val2 =~ s/\\%/.*/g; |
677
|
0
|
|
|
|
|
0
|
$val2 =~ s/_/./g; |
678
|
|
|
|
|
|
|
} |
679
|
114
|
50
|
|
|
|
228
|
if ( $op eq 'LIKE' ) { return $val1 =~ /^$val2$/s; } |
|
0
|
|
|
|
|
0
|
|
680
|
114
|
50
|
|
|
|
236
|
if ( $op eq 'CLIKE' ) { return $val1 =~ /^$val2$/si; } |
|
0
|
|
|
|
|
0
|
|
681
|
114
|
100
|
66
|
|
|
385
|
if ( DBI::looks_like_number($val1) && DBI::looks_like_number($val2) ) |
682
|
|
|
|
|
|
|
{ |
683
|
2
|
50
|
|
|
|
6
|
if ( $op eq '<' ) { return $val1 < $val2; } |
|
0
|
|
|
|
|
0
|
|
684
|
2
|
50
|
|
|
|
5
|
if ( $op eq '>' ) { return $val1 > $val2; } |
|
0
|
|
|
|
|
0
|
|
685
|
2
|
50
|
|
|
|
5
|
if ( $op eq '=' ) { return $val1 == $val2; } |
|
2
|
|
|
|
|
9
|
|
686
|
0
|
0
|
|
|
|
0
|
if ( $op eq '<>' ) { return $val1 != $val2; } |
|
0
|
|
|
|
|
0
|
|
687
|
0
|
0
|
|
|
|
0
|
if ( $op eq '<=' ) { return $val1 <= $val2; } |
|
0
|
|
|
|
|
0
|
|
688
|
0
|
0
|
|
|
|
0
|
if ( $op eq '>=' ) { return $val1 >= $val2; } |
|
0
|
|
|
|
|
0
|
|
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
else |
691
|
|
|
|
|
|
|
{ |
692
|
112
|
50
|
|
|
|
250
|
if ( $op eq '<' ) { return $val1 lt $val2; } |
|
0
|
|
|
|
|
0
|
|
693
|
112
|
50
|
|
|
|
240
|
if ( $op eq '>' ) { return $val1 gt $val2; } |
|
0
|
|
|
|
|
0
|
|
694
|
112
|
50
|
|
|
|
232
|
if ( $op eq '=' ) { return $val1 eq $val2; } |
|
112
|
|
|
|
|
410
|
|
695
|
0
|
0
|
|
|
|
0
|
if ( $op eq '<>' ) { return $val1 ne $val2; } |
|
0
|
|
|
|
|
0
|
|
696
|
0
|
0
|
|
|
|
0
|
if ( $op eq '<=' ) { return $val1 ge $val2; } |
|
0
|
|
|
|
|
0
|
|
697
|
0
|
0
|
|
|
|
0
|
if ( $op eq '>=' ) { return $val1 le $val2; } |
|
0
|
|
|
|
|
0
|
|
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
sub params |
702
|
|
|
|
|
|
|
{ |
703
|
1706
|
|
|
1706
|
|
3079
|
my ( $self, $val_num ) = @_; |
704
|
1706
|
100
|
|
|
|
3778
|
if ( !$self->{"params"} ) { return 0; } |
|
1490
|
|
|
|
|
4459
|
|
705
|
216
|
50
|
|
|
|
467
|
if ( defined $val_num ) |
706
|
|
|
|
|
|
|
{ |
707
|
0
|
|
|
|
|
0
|
return $self->{"params"}->[$val_num]; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
|
710
|
216
|
50
|
|
|
|
467
|
return wantarray ? @{ $self->{"params"} } : scalar @{ $self->{"params"} }; |
|
0
|
|
|
|
|
0
|
|
|
216
|
|
|
|
|
755
|
|
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub open_tables |
714
|
|
|
|
|
|
|
{ |
715
|
502
|
|
|
502
|
|
1298
|
my ( $self, $data, $createMode, $lockMode ) = @_; |
716
|
502
|
|
|
|
|
1077
|
my $table_name = $self->{table_name}; |
717
|
502
|
|
|
|
|
727
|
my $table; |
718
|
502
|
|
|
|
|
1015
|
eval { $table = $self->open_table( $data, $table_name, $createMode, $lockMode ) }; |
|
502
|
|
|
|
|
2133
|
|
719
|
502
|
100
|
|
|
|
6399
|
if ($@) |
720
|
|
|
|
|
|
|
{ |
721
|
72
|
|
|
|
|
197
|
chomp $@; |
722
|
72
|
|
|
|
|
12074
|
croak $@; |
723
|
|
|
|
|
|
|
} |
724
|
430
|
50
|
|
|
|
1356
|
croak "Couldn't open table '$table_name'" unless $table; |
725
|
430
|
100
|
100
|
|
|
1979
|
if ( !$self->{column_names} or $self->{column_names}->[0] eq '*' ) |
726
|
|
|
|
|
|
|
{ |
727
|
260
|
|
|
|
|
1117
|
$self->{column_names} = $table->col_names(); |
728
|
|
|
|
|
|
|
} |
729
|
430
|
|
|
|
|
1373
|
return $table; |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
sub row_values |
733
|
|
|
|
|
|
|
{ |
734
|
326
|
|
|
326
|
|
646
|
my ( $self, $val_num ) = @_; |
735
|
326
|
50
|
|
|
|
741
|
if ( !$self->{"values"} ) { return 0; } |
|
0
|
|
|
|
|
0
|
|
736
|
326
|
50
|
|
|
|
686
|
if ( defined $val_num ) |
737
|
|
|
|
|
|
|
{ |
738
|
326
|
|
|
|
|
1086
|
return $self->{"values"}->[$val_num]->{value}; |
739
|
|
|
|
|
|
|
} |
740
|
0
|
0
|
|
|
|
0
|
if (wantarray) |
741
|
|
|
|
|
|
|
{ |
742
|
0
|
|
|
|
|
0
|
return map { $_->{"value"} } @{ $self->{"values"} }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
else |
745
|
|
|
|
|
|
|
{ |
746
|
0
|
|
|
|
|
0
|
return scalar @{ $self->{"values"} }; |
|
0
|
|
|
|
|
0
|
|
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
sub column_names |
751
|
|
|
|
|
|
|
{ |
752
|
1422
|
|
|
1422
|
|
2774
|
my ($self) = @_; |
753
|
1422
|
|
|
|
|
2029
|
my @col_names; |
754
|
1422
|
100
|
100
|
|
|
4705
|
if ( $self->{column_names} and $self->{column_names}->[0] ne '*' ) |
755
|
|
|
|
|
|
|
{ |
756
|
470
|
|
|
|
|
755
|
@col_names = @{ $self->{column_names} }; |
|
470
|
|
|
|
|
1350
|
|
757
|
|
|
|
|
|
|
} |
758
|
1422
|
|
|
|
|
3599
|
return @col_names; |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
############################### |
762
|
|
|
|
|
|
|
package DBI::SQL::Nano::Table_; |
763
|
|
|
|
|
|
|
############################### |
764
|
|
|
|
|
|
|
|
765
|
54
|
|
|
54
|
|
606
|
use Carp qw(croak); |
|
54
|
|
|
|
|
128
|
|
|
54
|
|
|
|
|
30147
|
|
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
sub new ($$) |
768
|
|
|
|
|
|
|
{ |
769
|
430
|
|
|
430
|
|
1180
|
my ( $proto, $attr ) = @_; |
770
|
430
|
|
|
|
|
1883
|
my ($self) = {%$attr}; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
defined( $self->{col_names} ) and "ARRAY" eq ref( $self->{col_names} ) |
773
|
430
|
50
|
33
|
|
|
2757
|
or croak("attribute 'col_names' must be defined as an array"); |
774
|
430
|
50
|
|
|
|
1975
|
exists( $self->{col_nums} ) or $self->{col_nums} = _map_colnums( $self->{col_names} ); |
775
|
|
|
|
|
|
|
defined( $self->{col_nums} ) and "HASH" eq ref( $self->{col_nums} ) |
776
|
430
|
50
|
33
|
|
|
2224
|
or croak("attribute 'col_nums' must be defined as a hash"); |
777
|
|
|
|
|
|
|
|
778
|
430
|
|
33
|
|
|
1712
|
bless( $self, ( ref($proto) || $proto ) ); |
779
|
430
|
|
|
|
|
2284
|
return $self; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
sub _map_colnums |
783
|
|
|
|
|
|
|
{ |
784
|
430
|
|
|
430
|
|
811
|
my $col_names = $_[0]; |
785
|
430
|
|
|
|
|
679
|
my %col_nums; |
786
|
430
|
|
|
|
|
1425
|
for my $i ( 0 .. $#$col_names ) |
787
|
|
|
|
|
|
|
{ |
788
|
668
|
50
|
|
|
|
1541
|
next unless $col_names->[$i]; |
789
|
668
|
|
|
|
|
2106
|
$col_nums{ $col_names->[$i] } = $i; |
790
|
|
|
|
|
|
|
} |
791
|
430
|
|
|
|
|
1289
|
return \%col_nums; |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
|
794
|
0
|
|
|
0
|
|
0
|
sub row() { return $_[0]->{row}; } |
795
|
0
|
|
|
0
|
|
0
|
sub column($) { return $_[0]->{row}->[ $_[0]->column_num( $_[1] ) ]; } |
796
|
0
|
|
|
0
|
|
0
|
sub column_num($) { $_[0]->{col_nums}->{ $_[1] }; } |
797
|
1174
|
|
|
1174
|
|
3429
|
sub col_nums() { $_[0]->{col_nums} } |
798
|
1304
|
|
|
1304
|
|
3079
|
sub col_names() { $_[0]->{col_names}; } |
799
|
|
|
|
|
|
|
|
800
|
0
|
|
|
0
|
|
|
sub drop ($$) { croak "Abstract method " . ref( $_[0] ) . "::drop called" } |
801
|
0
|
|
|
0
|
|
|
sub fetch_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::fetch_row called" } |
802
|
0
|
|
|
0
|
|
|
sub push_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_row called" } |
803
|
0
|
|
|
0
|
|
|
sub push_names ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_names called" } |
804
|
0
|
|
|
0
|
|
|
sub truncate ($$) { croak "Abstract method " . ref( $_[0] ) . "::truncate called" } |
805
|
0
|
|
|
0
|
|
|
sub seek ($$$$) { croak "Abstract method " . ref( $_[0] ) . "::seek called" } |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
1; |
808
|
|
|
|
|
|
|
__END__ |