line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SQL::DB::Expr; |
2
|
6
|
|
|
6
|
|
36209
|
use strict; |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
183
|
|
3
|
6
|
|
|
6
|
|
23
|
use warnings; |
|
6
|
|
|
|
|
6
|
|
|
6
|
|
|
|
|
138
|
|
4
|
6
|
|
|
6
|
|
2919
|
use DBI qw/looks_like_number :sql_types/; |
|
6
|
|
|
|
|
28409
|
|
|
6
|
|
|
|
|
2356
|
|
5
|
6
|
|
|
6
|
|
6116
|
use Moo; |
|
6
|
|
|
|
|
18558
|
|
|
6
|
|
|
|
|
93
|
|
6
|
6
|
|
|
6
|
|
4724
|
use Carp qw/ carp croak confess/; |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
418
|
|
7
|
6
|
|
|
|
|
68
|
use Sub::Exporter -setup => { |
8
|
|
|
|
|
|
|
exports => [ |
9
|
|
|
|
|
|
|
qw/ |
10
|
|
|
|
|
|
|
AND |
11
|
|
|
|
|
|
|
OR |
12
|
|
|
|
|
|
|
_sql |
13
|
|
|
|
|
|
|
_quote |
14
|
|
|
|
|
|
|
_bval |
15
|
|
|
|
|
|
|
_expr_binary |
16
|
|
|
|
|
|
|
_expr_join |
17
|
|
|
|
|
|
|
_query |
18
|
|
|
|
|
|
|
/ |
19
|
|
|
|
|
|
|
], |
20
|
|
|
|
|
|
|
groups => { default => [qw/ /], }, |
21
|
6
|
|
|
6
|
|
5168
|
}; |
|
6
|
|
|
|
|
55645
|
|
22
|
|
|
|
|
|
|
use overload |
23
|
6
|
|
|
|
|
48
|
'""' => '_as_string', |
24
|
|
|
|
|
|
|
'!' => '_expr_not', |
25
|
|
|
|
|
|
|
'==' => '_expr_eq', |
26
|
|
|
|
|
|
|
'eq' => '_expr_eq', |
27
|
|
|
|
|
|
|
'!=' => '_expr_ne', |
28
|
|
|
|
|
|
|
'ne' => '_expr_ne', |
29
|
|
|
|
|
|
|
'&' => '_expr_bitand', |
30
|
|
|
|
|
|
|
'|' => '_expr_bitor', |
31
|
|
|
|
|
|
|
'<' => '_expr_lt', |
32
|
|
|
|
|
|
|
'>' => '_expr_gt', |
33
|
|
|
|
|
|
|
'<=' => '_expr_lte', |
34
|
|
|
|
|
|
|
'>=' => '_expr_gte', |
35
|
|
|
|
|
|
|
'+' => '_expr_add', |
36
|
|
|
|
|
|
|
'-' => '_expr_sub', |
37
|
|
|
|
|
|
|
'*' => '_expr_mult', |
38
|
|
|
|
|
|
|
'/' => '_expr_divide', |
39
|
|
|
|
|
|
|
'.' => '_expr_addstr', |
40
|
|
|
|
|
|
|
'.=' => '_expr_addstr', |
41
|
|
|
|
|
|
|
fallback => 1, |
42
|
6
|
|
|
6
|
|
2683
|
; |
|
6
|
|
|
|
|
12
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
our $VERSION = '0.971.2'; |
45
|
|
|
|
|
|
|
our $tcount = {}; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# ######################################################################## |
48
|
|
|
|
|
|
|
# FUNCTIONS |
49
|
|
|
|
|
|
|
# ######################################################################## |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub AND { |
52
|
15
|
|
|
15
|
1
|
353
|
SQL::DB::Expr->new( |
53
|
|
|
|
|
|
|
_txt => [' AND '], |
54
|
|
|
|
|
|
|
_logic => 1 |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub OR { |
59
|
11
|
|
|
11
|
1
|
259
|
SQL::DB::Expr->new( |
60
|
|
|
|
|
|
|
_txt => [' OR '], |
61
|
|
|
|
|
|
|
_logic => 1 |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub _sql { |
66
|
3
|
|
|
3
|
|
148
|
my $val = shift; |
67
|
|
|
|
|
|
|
|
68
|
3
|
50
|
|
|
|
13
|
return $val if ( ref $val ) =~ m/^SQL::DB::Expr/; |
69
|
|
|
|
|
|
|
|
70
|
3
|
|
|
|
|
75
|
return SQL::DB::Expr::SQL->new( val => $val ); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _quote { |
74
|
16
|
|
|
16
|
|
190
|
my $val = shift; |
75
|
|
|
|
|
|
|
|
76
|
16
|
100
|
|
|
|
79
|
return $val if ( ref $val ) =~ m/^SQL::DB::Expr/; |
77
|
|
|
|
|
|
|
|
78
|
9
|
|
|
|
|
211
|
return SQL::DB::Expr::Quote->new( val => $val ); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _bval { |
82
|
117
|
|
|
117
|
|
794
|
my ( $val, $type ) = @_; |
83
|
|
|
|
|
|
|
|
84
|
117
|
100
|
|
|
|
541
|
return $val if ( ref $val ) =~ m/^SQL::DB::Expr/; |
85
|
|
|
|
|
|
|
|
86
|
64
|
|
|
|
|
1420
|
return SQL::DB::Expr::BindValue->new( val => $val, type => $type ); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _expr_join { |
90
|
28
|
|
|
28
|
|
257
|
my $sep = shift; |
91
|
28
|
|
|
|
|
44
|
my $last = pop @_; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my $e = SQL::DB::Expr->new( |
94
|
|
|
|
|
|
|
_txt => [ |
95
|
|
|
|
|
|
|
( |
96
|
|
|
|
|
|
|
map { |
97
|
34
|
100
|
|
|
|
67
|
eval { $_->isa('SQL::DB::Expr') } |
|
34
|
|
|
|
|
244
|
|
98
|
|
|
|
|
|
|
? ( $_->_txts, $sep ) |
99
|
|
|
|
|
|
|
: ( $_, $sep ) |
100
|
|
|
|
|
|
|
} @_ |
101
|
|
|
|
|
|
|
), |
102
|
28
|
100
|
|
|
|
54
|
eval { $last->isa('SQL::DB::Expr') } ? $last->_txts : $last |
|
28
|
|
|
|
|
568
|
|
103
|
|
|
|
|
|
|
] |
104
|
|
|
|
|
|
|
); |
105
|
28
|
|
|
|
|
224
|
return $e; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub _query { |
109
|
17
|
50
|
33
|
17
|
|
66
|
return $_[0] if ( @_ == 1 and eval { $_[0]->isa('SQL::DB::Expr') } ); |
|
0
|
|
|
|
|
0
|
|
110
|
17
|
|
|
|
|
404
|
my $e = SQL::DB::Expr->new; |
111
|
|
|
|
|
|
|
|
112
|
17
|
|
|
|
|
63
|
eval { |
113
|
17
|
|
|
|
|
94
|
while ( my ( $keyword, $item ) = splice( @_, 0, 2 ) ) |
114
|
|
|
|
|
|
|
{ |
115
|
42
|
100
|
|
|
|
80
|
if ( ref $keyword ) { |
116
|
5
|
|
|
|
|
10
|
$e .= $keyword . "\n"; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
else { |
119
|
37
|
|
|
|
|
116
|
( my $tmp = uc($keyword) ) =~ s/_/ /g; |
120
|
37
|
|
|
|
|
115
|
$e .= $tmp . "\n"; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
42
|
100
|
|
|
|
103
|
next unless defined $item; |
124
|
37
|
100
|
|
|
|
154
|
if ( ref $item eq 'SQL::DB::Expr' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
125
|
10
|
|
|
|
|
26
|
$e .= ' ' . $item . "\n"; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
elsif ( ref $item eq 'ARRAY' ) { |
128
|
11
|
50
|
|
|
|
27
|
my @new = map { ref $_ ? $_ : _bval($_) } @$item; |
|
25
|
|
|
|
|
75
|
|
129
|
11
|
|
|
|
|
37
|
$e .= ' ' . _expr_join( ",\n ", @new ) . "\n"; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
elsif ( ref $item eq 'SCALAR' ) { |
132
|
1
|
|
|
|
|
5
|
$e .= ' ' . $$item . "\n"; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
else { |
135
|
15
|
|
|
|
|
165
|
$e .= ' ' . $item . "\n"; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
37
|
|
|
|
|
104
|
$e->_multi(0); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
}; |
141
|
|
|
|
|
|
|
|
142
|
17
|
50
|
|
|
|
44
|
confess "Bad Query: $@" if $@; |
143
|
17
|
|
|
|
|
47
|
return $e; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# ######################################################################## |
147
|
|
|
|
|
|
|
# OBJECT INTERFACE |
148
|
|
|
|
|
|
|
# ######################################################################## |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
has '_txt' => ( |
151
|
|
|
|
|
|
|
is => 'rw', |
152
|
|
|
|
|
|
|
isa => |
153
|
|
|
|
|
|
|
sub { confess "Must be ARRAY ref: $_[0]" unless ref $_[0] eq 'ARRAY' }, |
154
|
|
|
|
|
|
|
default => sub { [] }, |
155
|
|
|
|
|
|
|
); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
has '_alias' => ( is => 'rw', ); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
has '_type' => ( is => 'rw', ); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
has '_multi' => ( |
162
|
|
|
|
|
|
|
is => 'rw', |
163
|
|
|
|
|
|
|
default => sub { 0 }, |
164
|
|
|
|
|
|
|
); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
has '_logic' => ( |
167
|
|
|
|
|
|
|
is => 'rw', |
168
|
|
|
|
|
|
|
default => sub { 0 }, |
169
|
|
|
|
|
|
|
); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub BUILD { |
172
|
409
|
|
|
409
|
1
|
4979
|
my $self = shift; |
173
|
|
|
|
|
|
|
|
174
|
409
|
100
|
|
|
|
9183
|
if ( my $name = $self->_alias ) { |
175
|
6
|
|
100
|
|
|
45
|
$tcount->{$name} ||= []; |
176
|
6
|
|
|
|
|
13
|
my $i = 0; |
177
|
6
|
|
|
|
|
27
|
while ( $tcount->{$name}->[$i] ) { |
178
|
2
|
|
|
|
|
8
|
$i++; |
179
|
|
|
|
|
|
|
} |
180
|
6
|
|
|
|
|
15
|
$tcount->{$name}->[$i] = 1; |
181
|
6
|
|
|
|
|
27
|
$self->_alias( $name . $i ); |
182
|
6
|
|
|
|
|
131
|
$self->_txt( [ $name . ' AS ' . $name . $i ] ); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub _txts { |
187
|
558
|
|
|
558
|
|
1278
|
return @{ shift->_txt }; |
|
558
|
|
|
|
|
12974
|
|
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub _clone { |
191
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
192
|
0
|
|
|
|
|
0
|
bless {%$self}, ref $self; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub _as_string { |
196
|
100
|
|
|
100
|
|
32568
|
my $self = shift; |
197
|
|
|
|
|
|
|
|
198
|
100
|
50
|
|
|
|
188
|
return join( '', map { defined $_ ? $_ : '*UNDEF*' } $self->_txts ); |
|
467
|
|
|
|
|
1454
|
|
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub _as_pretty { |
202
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
203
|
0
|
|
|
|
|
0
|
my $dbh = shift; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
0
|
my $sql; |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
0
|
foreach my $token ( $self->_txts ) { |
208
|
0
|
0
|
|
|
|
0
|
if ( ref $token eq 'SQL::DB::Expr::Quote' ) { |
|
|
0
|
|
|
|
|
|
209
|
0
|
|
|
|
|
0
|
$sql .= $dbh->quote( $token->val ); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
elsif ( ref $token eq 'SQL::DB::Expr::BindValue' ) { |
212
|
0
|
|
|
|
|
0
|
my $val = $token->val; |
213
|
0
|
|
|
|
|
0
|
my $type = $token->type; |
214
|
|
|
|
|
|
|
|
215
|
0
|
0
|
|
|
|
0
|
if ( !defined $val ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
216
|
0
|
|
|
|
|
0
|
$sql .= $dbh->quote(undef); |
217
|
0
|
|
|
|
|
0
|
next; |
218
|
|
|
|
|
|
|
} |
219
|
5
|
|
|
5
|
|
10631
|
elsif ( $val =~ /[\P{IsPrint}]/ ) { |
|
5
|
|
|
|
|
49
|
|
|
5
|
|
|
|
|
66
|
|
220
|
0
|
|
|
|
|
0
|
$sql .= '/*BINARY DATA*/'; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
elsif ( looks_like_number($val) ) { |
223
|
0
|
|
|
|
|
0
|
$sql .= $val; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
else { |
226
|
0
|
|
|
|
|
0
|
( my $x = $val ) =~ s/\n.*/\.\.\./s; |
227
|
0
|
|
|
|
|
0
|
$sql .= $dbh->quote($val); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
else { |
231
|
0
|
|
|
|
|
0
|
$sql .= $token; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
0
|
|
|
|
|
0
|
return $sql . ';'; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
my %type_map = ( |
239
|
|
|
|
|
|
|
biginteger => { TYPE => SQL_BIGINT }, |
240
|
|
|
|
|
|
|
bigint => { TYPE => SQL_BIGINT }, |
241
|
|
|
|
|
|
|
binary => { TYPE => SQL_BINARY }, |
242
|
|
|
|
|
|
|
'binary varying' => { TYPE => SQL_VARBINARY }, |
243
|
|
|
|
|
|
|
bin => { TYPE => SQL_BINARY }, |
244
|
|
|
|
|
|
|
bit => { TYPE => SQL_BIT }, |
245
|
|
|
|
|
|
|
blob => { TYPE => SQL_BLOB }, |
246
|
|
|
|
|
|
|
character => { TYPE => SQL_CHAR }, |
247
|
|
|
|
|
|
|
'character varying' => { TYPE => SQL_VARCHAR }, |
248
|
|
|
|
|
|
|
char => { TYPE => SQL_CHAR }, |
249
|
|
|
|
|
|
|
clob => { TYPE => SQL_CLOB }, |
250
|
|
|
|
|
|
|
datetime => { TYPE => SQL_DATETIME }, |
251
|
|
|
|
|
|
|
date => { TYPE => SQL_DATE }, |
252
|
|
|
|
|
|
|
decimal => { TYPE => SQL_DECIMAL }, |
253
|
|
|
|
|
|
|
double => { TYPE => SQL_DOUBLE }, |
254
|
|
|
|
|
|
|
float => { TYPE => SQL_FLOAT }, |
255
|
|
|
|
|
|
|
integer => { TYPE => SQL_INTEGER }, |
256
|
|
|
|
|
|
|
interval => { TYPE => SQL_INTERVAL }, |
257
|
|
|
|
|
|
|
int => { TYPE => SQL_INTEGER }, |
258
|
|
|
|
|
|
|
numeric => { TYPE => SQL_NUMERIC }, |
259
|
|
|
|
|
|
|
real => { TYPE => SQL_REAL }, |
260
|
|
|
|
|
|
|
smallinteger => { TYPE => SQL_SMALLINT }, |
261
|
|
|
|
|
|
|
smallint => { TYPE => SQL_SMALLINT }, |
262
|
|
|
|
|
|
|
text => { TYPE => SQL_VARCHAR }, |
263
|
|
|
|
|
|
|
timestamp => { TYPE => SQL_TIMESTAMP }, |
264
|
|
|
|
|
|
|
varbin => { TYPE => SQL_VARBINARY }, |
265
|
|
|
|
|
|
|
varchar => { TYPE => SQL_VARCHAR }, |
266
|
|
|
|
|
|
|
); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub _sql_values_types { |
269
|
17
|
|
|
17
|
|
27
|
my $self = shift; |
270
|
17
|
|
|
|
|
23
|
my $dbh = shift; |
271
|
|
|
|
|
|
|
|
272
|
17
|
|
|
|
|
27
|
my $sql; |
273
|
|
|
|
|
|
|
my @values; |
274
|
0
|
|
|
|
|
0
|
my @types; |
275
|
|
|
|
|
|
|
|
276
|
17
|
|
|
|
|
47
|
foreach my $token ( $self->_txts ) { |
277
|
|
|
|
|
|
|
|
278
|
228
|
100
|
|
|
|
704
|
if ( ref $token eq 'SQL::DB::Expr::Quote' ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
279
|
5
|
|
|
|
|
52
|
$sql .= $dbh->quote( $token->val ); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
elsif ( ref $token eq 'SQL::DB::Expr::BindValue' ) { |
282
|
13
|
|
|
|
|
40
|
my $val = $token->val; |
283
|
13
|
|
|
|
|
43
|
my $type = $token->type; |
284
|
|
|
|
|
|
|
|
285
|
13
|
50
|
|
|
|
40
|
if ( !defined $val ) { |
|
|
100
|
|
|
|
|
|
286
|
0
|
|
|
|
|
0
|
$sql .= $dbh->quote(undef); |
287
|
0
|
|
|
|
|
0
|
next; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
elsif ( defined $type ) { |
290
|
12
|
|
|
|
|
25
|
push( @values, $val ); |
291
|
12
|
50
|
|
|
|
38
|
if ( $type_map{$type} ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
292
|
12
|
|
|
|
|
31
|
push( @types, $type_map{$type} ); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
elsif ( $type eq 'bytea' ) { |
295
|
0
|
|
|
|
|
0
|
push( @types, { pg_type => eval 'DBD::Pg::PG_BYTEA' } ); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
elsif ( $type eq 'inet' ) { |
298
|
0
|
|
|
|
|
0
|
push( @types, { pg_type => eval 'DBD::Pg::PG_INET' } ); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
elsif ( $type eq 'cidr' ) { |
301
|
0
|
|
|
|
|
0
|
push( @types, { pg_type => eval 'DBD::Pg::PG_CIDR' } ); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
elsif ( $type eq 'boolean' ) { |
304
|
0
|
|
|
|
|
0
|
push( @types, { pg_type => eval 'DBD::Pg::PG_BOOL' } ); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else { |
307
|
0
|
|
|
|
|
0
|
warn "No mapping for type $type"; |
308
|
0
|
|
|
|
|
0
|
push( @types, undef ); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
12
|
|
|
|
|
27
|
$sql .= '?'; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# leave it undefined |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
else { |
316
|
1
|
|
|
|
|
10
|
$sql .= $dbh->quote($val); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
elsif ( !defined $token ) { |
320
|
0
|
|
|
|
|
0
|
warn 'undefined token received! SQL so far:' . $sql; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
else { |
323
|
210
|
|
|
|
|
250
|
$sql .= $token; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
17
|
|
|
|
|
94
|
return ( $sql, \@values, \@types ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# A true internal function - don't use outside this package |
331
|
|
|
|
|
|
|
sub _push { |
332
|
339
|
|
|
339
|
|
1463
|
my $self = shift; |
333
|
339
|
|
|
|
|
332
|
push( @{ $self->_txt }, @_ ); |
|
339
|
|
|
|
|
7714
|
|
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# A true internal function - don't use outside this package |
337
|
|
|
|
|
|
|
sub _unshift { |
338
|
59
|
|
|
59
|
|
75
|
my $self = shift; |
339
|
59
|
|
|
|
|
62
|
unshift( @{ $self->_txt }, @_ ); |
|
59
|
|
|
|
|
1365
|
|
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub _expr_addstr { |
343
|
475
|
|
|
475
|
|
4126
|
my ( $e1, $e2, $swap ) = @_; |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# The argument is undef |
346
|
475
|
50
|
|
|
|
1010
|
if ( !defined $e2 ) { |
347
|
0
|
|
|
|
|
0
|
Carp::carp('Use of uninitialized value in concatenation (. or .=)'); |
348
|
0
|
|
|
|
|
0
|
return $e1; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
475
|
|
|
|
|
610
|
my $res; |
352
|
|
|
|
|
|
|
|
353
|
475
|
|
100
|
|
|
919
|
my $multi = $e1->_multi + ( eval { $e2->_multi } || 0 ); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# $e2 . $e1 (or $e2 .= $e1) |
356
|
475
|
100
|
|
|
|
1264
|
if ($swap) { |
|
|
100
|
|
|
|
|
|
357
|
40
|
50
|
|
|
|
51
|
if ( eval { $e2->isa(__PACKAGE__) } ) { |
|
40
|
|
|
|
|
243
|
|
358
|
0
|
|
|
|
|
0
|
$res = __PACKAGE__->new( |
359
|
|
|
|
|
|
|
_txt => [ $e2->_txts, $e1->_txts ], |
360
|
|
|
|
|
|
|
_multi => $multi, |
361
|
|
|
|
|
|
|
_logic => $e1->_logic, |
362
|
|
|
|
|
|
|
); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
else { |
365
|
40
|
|
|
|
|
106
|
$res = __PACKAGE__->new( |
366
|
|
|
|
|
|
|
_txt => [ $e2, $e1->_txts ], |
367
|
|
|
|
|
|
|
_multi => $multi, |
368
|
|
|
|
|
|
|
_logic => $e1->_logic, |
369
|
|
|
|
|
|
|
); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# $e1 . $e2 |
374
|
|
|
|
|
|
|
elsif ( defined $swap ) { |
375
|
|
|
|
|
|
|
|
376
|
135
|
|
|
|
|
146
|
my $logic = 0; |
377
|
135
|
|
|
|
|
144
|
my $multi = 0; |
378
|
135
|
100
|
|
|
|
148
|
if ( eval { $e2->_logic } ) { |
|
135
|
50
|
|
|
|
1100
|
|
379
|
24
|
100
|
|
|
|
57
|
if ( $e1->_multi ) { |
380
|
10
|
|
|
|
|
32
|
$e1->_unshift('('); |
381
|
10
|
|
|
|
|
85
|
$e1->_push(')'); |
382
|
|
|
|
|
|
|
} |
383
|
24
|
|
|
|
|
82
|
$logic = 1; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
elsif ( $e1->_logic ) { |
386
|
0
|
0
|
|
|
|
0
|
if ( eval { $e2->_multi } ) { |
|
0
|
|
|
|
|
0
|
|
387
|
0
|
|
|
|
|
0
|
$e2->_unshift('('); |
388
|
0
|
|
|
|
|
0
|
$e2->_push(')'); |
389
|
|
|
|
|
|
|
} |
390
|
0
|
|
|
|
|
0
|
$multi = 0; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
135
|
100
|
|
|
|
196
|
if ( eval { $e2->isa(__PACKAGE__) } ) { |
|
135
|
|
|
|
|
734
|
|
394
|
46
|
|
|
|
|
99
|
$res = __PACKAGE__->new( |
395
|
|
|
|
|
|
|
_txt => [ $e1->_txts, $e2->_txts ], |
396
|
|
|
|
|
|
|
_multi => $multi, |
397
|
|
|
|
|
|
|
_logic => $logic, |
398
|
|
|
|
|
|
|
); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
else { |
401
|
89
|
|
|
|
|
209
|
$res = __PACKAGE__->new( |
402
|
|
|
|
|
|
|
_txt => [ $e1->_txts, $e2 ], |
403
|
|
|
|
|
|
|
_multi => $multi, |
404
|
|
|
|
|
|
|
_logic => $logic, |
405
|
|
|
|
|
|
|
); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# $e1 .= $e2 |
410
|
|
|
|
|
|
|
else { |
411
|
300
|
|
|
|
|
345
|
my $logic = 0; |
412
|
300
|
|
|
|
|
304
|
my $multi = 0; |
413
|
300
|
100
|
|
|
|
312
|
if ( eval { $e2->_logic } ) { |
|
300
|
100
|
|
|
|
1933
|
|
414
|
2
|
50
|
|
|
|
9
|
if ( $e1->_multi ) { |
415
|
2
|
|
|
|
|
7
|
$e1->_unshift('('); |
416
|
2
|
|
|
|
|
26
|
$e1->_push(')'); |
417
|
|
|
|
|
|
|
} |
418
|
2
|
|
|
|
|
20
|
$logic = 1; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
elsif ( $e1->_logic ) { |
421
|
26
|
100
|
|
|
|
35
|
if ( eval { $e2->_multi } ) { |
|
26
|
|
|
|
|
77
|
|
422
|
11
|
|
|
|
|
25
|
$e2->_unshift('('); |
423
|
11
|
|
|
|
|
88
|
$e2->_push(')'); |
424
|
|
|
|
|
|
|
} |
425
|
26
|
|
|
|
|
87
|
$multi = 1; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
300
|
100
|
|
|
|
372
|
if ( eval { $e2->isa(__PACKAGE__) } ) { |
|
300
|
|
|
|
|
1386
|
|
429
|
179
|
|
|
|
|
356
|
$e1->_push( $e2->_txts ); |
430
|
179
|
|
|
|
|
1415
|
$e1->_multi($multi); |
431
|
179
|
|
|
|
|
315
|
$e1->_logic($logic); |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
else { |
434
|
121
|
|
|
|
|
240
|
$e1->_push($e2); |
435
|
121
|
|
|
|
|
868
|
$e1->_multi($multi); |
436
|
121
|
|
|
|
|
180
|
$e1->_logic($logic); |
437
|
|
|
|
|
|
|
} |
438
|
300
|
|
|
|
|
417
|
$res = $e1; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
475
|
|
|
|
|
1912
|
return $res; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub _expr_not { |
445
|
20
|
|
|
20
|
|
37
|
my $e1 = shift; |
446
|
20
|
|
|
|
|
470
|
my $expr = SQL::DB::Expr->new . $e1; |
447
|
|
|
|
|
|
|
|
448
|
20
|
100
|
|
|
|
56
|
if ( $e1->_multi > 0 ) { |
449
|
16
|
|
|
|
|
55
|
$expr->_unshift('('); |
450
|
16
|
|
|
|
|
174
|
$expr->_push(')'); |
451
|
|
|
|
|
|
|
} |
452
|
20
|
|
|
|
|
162
|
$expr->_unshift('NOT '); |
453
|
20
|
|
|
|
|
146
|
$expr->_multi(0); |
454
|
20
|
|
|
|
|
96
|
return $expr; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub _expr_binary { |
458
|
64
|
|
|
64
|
|
128
|
my ( $op, $e1, $e2, $swap, $_multi ) = @_; |
459
|
|
|
|
|
|
|
|
460
|
64
|
|
|
|
|
1452
|
my $e = SQL::DB::Expr->new; |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# TODO add ( ) bracketing for multi expressions? |
463
|
64
|
100
|
|
|
|
289
|
if ($swap) { |
464
|
6
|
|
|
|
|
18
|
$e .= _bval( $e2, $e1->_type ); |
465
|
6
|
|
|
|
|
21
|
$e .= ( ' ' . $op . ' ' ) . $e1; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
else { |
468
|
58
|
|
|
|
|
218
|
$e .= $e1 . ( ' ' . $op . ' ' ); |
469
|
58
|
|
|
|
|
152
|
$e .= _bval( $e2, $e1->_type ); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
64
|
|
|
|
|
119
|
$e->_multi(1); |
473
|
64
|
|
|
|
|
340
|
return $e; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
37
|
|
|
37
|
|
155
|
sub _expr_eq { _expr_binary( '=', @_ ) } |
477
|
|
|
|
|
|
|
|
478
|
6
|
|
|
6
|
|
95
|
sub _expr_ne { _expr_binary( '!=', @_ ) } |
479
|
|
|
|
|
|
|
|
480
|
0
|
|
|
0
|
|
0
|
sub _expr_bitand { _expr_binary( '&', @_ ) } |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
0
|
|
0
|
sub _expr_bitor { _expr_binary( '|', @_ ) } |
483
|
|
|
|
|
|
|
|
484
|
4
|
|
|
4
|
|
9
|
sub _expr_lt { _expr_binary( '<', @_ ) } |
485
|
|
|
|
|
|
|
|
486
|
3
|
|
|
3
|
|
9
|
sub _expr_gt { _expr_binary( '>', @_ ) } |
487
|
|
|
|
|
|
|
|
488
|
3
|
|
|
3
|
|
7
|
sub _expr_lte { _expr_binary( '<=', @_ ) } |
489
|
|
|
|
|
|
|
|
490
|
3
|
|
|
3
|
|
8
|
sub _expr_gte { _expr_binary( '>=', @_ ) } |
491
|
|
|
|
|
|
|
|
492
|
2
|
|
|
2
|
|
6
|
sub _expr_add { _expr_binary( '+', @_ ) } |
493
|
|
|
|
|
|
|
|
494
|
3
|
|
|
3
|
|
8
|
sub _expr_sub { _expr_binary( '-', @_ ) } |
495
|
|
|
|
|
|
|
|
496
|
1
|
|
|
1
|
|
4
|
sub _expr_mult { _expr_binary( '*', @_ ) } |
497
|
|
|
|
|
|
|
|
498
|
2
|
|
|
2
|
|
6
|
sub _expr_divide { _expr_binary( '/', @_ ) } |
499
|
|
|
|
|
|
|
|
500
|
2
|
|
|
2
|
1
|
6
|
sub is_null { $_[0] . ' IS NULL' } |
501
|
|
|
|
|
|
|
|
502
|
1
|
|
|
1
|
1
|
3
|
sub is_not_null { $_[0] . ' IS NOT NULL' } |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
sub in { |
505
|
5
|
|
|
5
|
1
|
10
|
my $e1 = shift; |
506
|
5
|
50
|
33
|
|
|
29
|
if ( @_ >= 2 && $_[0] =~ m/^select/i ) { |
507
|
0
|
|
|
|
|
0
|
return $e1 . " IN (\n" . _query(@_) . ')'; |
508
|
|
|
|
|
|
|
} |
509
|
5
|
50
|
|
|
|
11
|
my @list = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_; |
|
10
|
|
|
|
|
34
|
|
510
|
|
|
|
|
|
|
return |
511
|
10
|
|
|
|
|
123
|
$e1 . ' IN (' |
512
|
5
|
|
|
|
|
13
|
. _expr_join( ', ', map { _bval( $_, $e1->_type ) } @list ) . ')'; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub not_in { |
516
|
4
|
|
|
4
|
1
|
6
|
my $e1 = shift; |
517
|
4
|
50
|
33
|
|
|
21
|
if ( @_ >= 2 && $_[0] =~ m/^select/i ) { |
518
|
0
|
|
|
|
|
0
|
return $e1 . " NOT IN (\n" . _query(@_) . ')'; |
519
|
|
|
|
|
|
|
} |
520
|
4
|
50
|
|
|
|
8
|
my @list = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_; |
|
8
|
|
|
|
|
26
|
|
521
|
|
|
|
|
|
|
return |
522
|
8
|
|
|
|
|
94
|
$e1 |
523
|
|
|
|
|
|
|
. ' NOT IN (' |
524
|
4
|
|
|
|
|
10
|
. _expr_join( ', ', map { _bval( $_, $e1->_type ) } @list ) . ')'; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
sub between { |
528
|
6
|
|
|
6
|
1
|
9
|
my $e1 = shift; |
529
|
6
|
50
|
|
|
|
23
|
croak 'between($a,$b)' unless @_ == 2; |
530
|
|
|
|
|
|
|
|
531
|
6
|
|
|
|
|
16
|
my $e = SQL::DB::Expr->new( |
532
|
|
|
|
|
|
|
_txt => [ |
533
|
|
|
|
|
|
|
$e1->_txts, |
534
|
|
|
|
|
|
|
' BETWEEN ', |
535
|
|
|
|
|
|
|
_bval( $_[0], $e1->_type ), |
536
|
|
|
|
|
|
|
' AND ', |
537
|
|
|
|
|
|
|
_bval( $_[1], $e1->_type ) |
538
|
|
|
|
|
|
|
], |
539
|
|
|
|
|
|
|
); |
540
|
6
|
|
|
|
|
49
|
return $e; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub not_between { |
544
|
4
|
|
|
4
|
1
|
7
|
my $e1 = shift; |
545
|
4
|
50
|
|
|
|
10
|
croak 'not_between($a,$b)' unless @_ == 2; |
546
|
|
|
|
|
|
|
|
547
|
4
|
|
|
|
|
10
|
my $e = SQL::DB::Expr->new( |
548
|
|
|
|
|
|
|
_txt => [ |
549
|
|
|
|
|
|
|
$e1->_txts, |
550
|
|
|
|
|
|
|
' NOT BETWEEN ', |
551
|
|
|
|
|
|
|
_bval( $_[0], $e1->_type ), |
552
|
|
|
|
|
|
|
' AND ', |
553
|
|
|
|
|
|
|
_bval( $_[1], $e1->_type ) |
554
|
|
|
|
|
|
|
], |
555
|
|
|
|
|
|
|
); |
556
|
4
|
|
|
|
|
33
|
return $e; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub as { |
560
|
2
|
|
|
2
|
1
|
5
|
my $e1 = shift; |
561
|
2
|
|
33
|
|
|
8
|
my $as = shift || croak 'as($value)'; |
562
|
|
|
|
|
|
|
|
563
|
2
|
100
|
|
|
|
24
|
if ( $e1->_multi > 0 ) { |
564
|
1
|
|
|
|
|
28
|
my $expr = SQL::DB::Expr->new( _txt => ['('] ); |
565
|
1
|
|
|
|
|
7
|
$expr .= $e1; |
566
|
1
|
|
|
|
|
5
|
$expr .= ') AS "' . $as . '"'; |
567
|
1
|
|
|
|
|
9
|
return $expr; |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
1
|
|
|
|
|
3
|
return $e1 . ' AS "' . $as . '"'; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
sub like { |
574
|
5
|
|
|
5
|
1
|
87
|
my $e1 = shift; |
575
|
5
|
|
33
|
|
|
24
|
my $like = shift || croak 'like($value)'; |
576
|
5
|
|
|
|
|
12
|
my $expr = $e1 . ' LIKE '; |
577
|
5
|
|
|
|
|
17
|
$expr .= _bval( $like, $e1->_type ); |
578
|
5
|
|
|
|
|
12
|
$expr->_multi(0); |
579
|
5
|
|
|
|
|
26
|
return $expr; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
sub asc { |
583
|
0
|
|
|
0
|
1
|
0
|
my $e1 = shift; |
584
|
0
|
|
|
|
|
0
|
return $e1 . ' ASC'; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub desc { |
588
|
0
|
|
|
0
|
1
|
0
|
my $e1 = shift; |
589
|
0
|
|
|
|
|
0
|
return $e1 . ' DESC'; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
DESTROY { |
593
|
408
|
|
|
408
|
|
5697
|
my $self = shift; |
594
|
408
|
100
|
|
|
|
2391
|
if ( my $alias = $self->_alias ) { |
595
|
6
|
|
|
|
|
47
|
$alias =~ m/^(.*?)(\d+)$/; |
596
|
6
|
|
|
|
|
120
|
delete $tcount->{$1}->[$2]; |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
package SQL::DB::Expr::SQL; |
601
|
6
|
|
|
6
|
|
105830
|
use strict; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
211
|
|
602
|
6
|
|
|
6
|
|
24
|
use warnings; |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
181
|
|
603
|
6
|
|
|
6
|
|
23
|
use Moo; |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
59
|
|
604
|
|
|
|
|
|
|
use overload '""' => sub { |
605
|
13
|
|
|
13
|
|
1836
|
my $self = shift; |
606
|
13
|
|
|
|
|
60
|
$self->val; |
607
|
|
|
|
|
|
|
}, |
608
|
6
|
|
|
6
|
|
1772
|
fallback => 1; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
63
|
|
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
has val => ( |
611
|
|
|
|
|
|
|
is => 'ro', |
612
|
|
|
|
|
|
|
required => 1, |
613
|
|
|
|
|
|
|
); |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
package SQL::DB::Expr::Quote; |
616
|
6
|
|
|
6
|
|
510
|
use strict; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
153
|
|
617
|
6
|
|
|
6
|
|
23
|
use warnings; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
153
|
|
618
|
6
|
|
|
6
|
|
26
|
use Moo; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
26
|
|
619
|
|
|
|
|
|
|
use overload '""' => sub { |
620
|
14
|
|
|
14
|
|
1410
|
my $self = shift; |
621
|
14
|
50
|
|
|
|
88
|
return 'q{' . ( defined $self->val ? $self->val : 'undef' ) . '}'; |
622
|
|
|
|
|
|
|
}, |
623
|
6
|
|
|
6
|
|
1530
|
fallback => 1; |
|
6
|
|
|
|
|
59
|
|
|
6
|
|
|
|
|
43
|
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
has val => ( |
626
|
|
|
|
|
|
|
is => 'ro', |
627
|
|
|
|
|
|
|
required => 1, |
628
|
|
|
|
|
|
|
); |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
package SQL::DB::Expr::BindValue; |
631
|
6
|
|
|
6
|
|
473
|
use strict; |
|
6
|
|
|
|
|
24
|
|
|
6
|
|
|
|
|
147
|
|
632
|
6
|
|
|
6
|
|
20
|
use warnings; |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
115
|
|
633
|
6
|
|
|
6
|
|
21
|
use Moo; |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
21
|
|
634
|
6
|
|
|
6
|
|
1423
|
use Carp qw/confess/; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
745
|
|
635
|
|
|
|
|
|
|
use overload '""' => sub { |
636
|
63
|
|
|
63
|
|
2027
|
my $self = shift; |
637
|
|
|
|
|
|
|
return |
638
|
63
|
50
|
|
|
|
479
|
'bv{' |
|
|
100
|
|
|
|
|
|
639
|
|
|
|
|
|
|
. ( defined $self->val ? $self->val : 'undef' ) . '}::' |
640
|
|
|
|
|
|
|
. ( defined $self->type ? $self->type : '(none)' ); |
641
|
|
|
|
|
|
|
}, |
642
|
6
|
|
|
6
|
|
32
|
fallback => 1; |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
45
|
|
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
has val => ( |
645
|
|
|
|
|
|
|
is => 'ro', |
646
|
|
|
|
|
|
|
required => 1, |
647
|
|
|
|
|
|
|
); |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
has type => ( is => 'rw', ); |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
1; |