line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Search::Query::Dialect::SQL; |
2
|
2
|
|
|
2
|
|
9
|
use Moo; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
14
|
|
3
|
|
|
|
|
|
|
extends 'Search::Query::Dialect'; |
4
|
2
|
|
|
2
|
|
646
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
130
|
|
5
|
2
|
|
|
2
|
|
8
|
use Data::Dump qw( dump ); |
|
2
|
|
|
|
|
13
|
|
|
2
|
|
|
|
|
95
|
|
6
|
2
|
|
|
2
|
|
813
|
use Search::Query::Field::SQL; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
63
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
12
|
use namespace::autoclean; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
8
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
has 'wildcard' => ( is => 'rw', default => sub {'%'} ); |
11
|
|
|
|
|
|
|
has 'quote_fields' => ( is => 'rw', default => sub {''} ); |
12
|
|
|
|
|
|
|
has 'fuzzify' => ( is => 'rw' ); |
13
|
|
|
|
|
|
|
has 'fuzzify2' => ( is => 'rw' ); |
14
|
|
|
|
|
|
|
has 'like' => ( is => 'rw', default => sub {'ILIKE'}, ); |
15
|
|
|
|
|
|
|
has 'quote_char' => ( is => 'rw', default => sub {q/'/}, ); |
16
|
|
|
|
|
|
|
has 'fuzzy_space' => ( is => 'rw', default => sub {' '}, ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.305'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 NAME |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Search::Query::Dialect::SQL - SQL query dialect |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 SYNOPSIS |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my $query = Search::Query->parser( dialect => 'SQL' )->parse('foo'); |
27
|
|
|
|
|
|
|
print $query; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 DESCRIPTION |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Search::Query::Dialect::SQL is a query dialect for Query |
32
|
|
|
|
|
|
|
objects returned by a Search::Query::Parser instance. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
The SQL dialect class stringifies queries to work as SQL WHERE |
35
|
|
|
|
|
|
|
clauses. This behavior is similar to Search::QueryParser::SQL. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 METHODS |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
This class is a subclass of Search::Query::Dialect. Only new or overridden |
40
|
|
|
|
|
|
|
methods are documented here. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=cut |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head2 BUILD |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Called by new(). The new() constructor can accept the following params, which |
47
|
|
|
|
|
|
|
are also standard attribute accessors: |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=over |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=item wildcard |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Default value is C<%>. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=item quote_fields |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Default value is "". Set to (for example) C<`> to quote each field name |
58
|
|
|
|
|
|
|
in stringify() as some SQL variants require that syntax (e.g. mysql). |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=item default_field |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Override the default field set in Search::Query::Parser. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=item fuzzify |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Append wildcard() to all terms. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=item fuzzify2 |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Prepend and append wildcard() to all terms. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item like |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
The SQL reserved word for wildcard comparison. Default value is C. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=item quote_char |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The string to use for quoting strings. Default is C<'>. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item fuzzy_space |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
The string to use to pad fuzzified terms. Default is a single space C< >. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=back |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub BUILD { |
89
|
43
|
|
|
43
|
1
|
336
|
my $self = shift; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
#carp dump $self; |
92
|
43
|
50
|
|
|
|
234
|
if ( !defined $self->parser->fields ) { |
93
|
0
|
|
|
|
|
0
|
croak "You must set fields in the Search::Query::Parser"; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
$self->{default_field} ||= $self->parser->default_field |
96
|
43
|
|
100
|
|
|
334
|
|| [ sort keys %{ $self->parser->fields } ]; |
|
|
|
66
|
|
|
|
|
97
|
43
|
100
|
66
|
|
|
269
|
if ( $self->{default_field} and !ref( $self->{default_field} ) ) { |
98
|
22
|
|
|
|
|
68
|
$self->{default_field} = [ $self->{default_field} ]; |
99
|
|
|
|
|
|
|
} |
100
|
43
|
|
|
|
|
1166
|
return $self; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 stringify |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Returns the Query object as a normalized string. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
my %op_map = ( |
110
|
|
|
|
|
|
|
'+' => 'AND', |
111
|
|
|
|
|
|
|
'' => 'OR', |
112
|
|
|
|
|
|
|
'-' => 'AND', # operator is munged |
113
|
|
|
|
|
|
|
); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub stringify { |
116
|
34
|
|
|
34
|
1
|
60
|
my $self = shift; |
117
|
34
|
|
66
|
|
|
169
|
my $tree = shift || $self; |
118
|
|
|
|
|
|
|
|
119
|
34
|
|
|
|
|
59
|
my @q; |
120
|
34
|
|
|
|
|
75
|
foreach my $prefix ( '+', '', '-' ) { |
121
|
102
|
|
|
|
|
133
|
my @clauses; |
122
|
102
|
|
|
|
|
186
|
my $joiner = $op_map{$prefix}; |
123
|
102
|
100
|
|
|
|
293
|
next unless exists $tree->{$prefix}; |
124
|
36
|
|
|
|
|
44
|
for my $clause ( @{ $tree->{$prefix} } ) { |
|
36
|
|
|
|
|
81
|
|
125
|
46
|
|
|
|
|
158
|
push( @clauses, $self->stringify_clause( $clause, $prefix ) ); |
126
|
|
|
|
|
|
|
} |
127
|
36
|
50
|
|
|
|
87
|
next if !@clauses; |
128
|
|
|
|
|
|
|
|
129
|
36
|
50
|
|
|
|
93
|
push @q, join( " $joiner ", grep { defined and length } @clauses ); |
|
46
|
|
|
|
|
263
|
|
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
34
|
|
|
|
|
440
|
return join " AND ", @q; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _doctor_value { |
136
|
41
|
|
|
41
|
|
56
|
my ( $self, $clause ) = @_; |
137
|
|
|
|
|
|
|
|
138
|
41
|
|
|
|
|
80
|
my $value = $clause->{value}; |
139
|
|
|
|
|
|
|
|
140
|
41
|
100
|
|
|
|
94
|
return $value unless defined $value; |
141
|
|
|
|
|
|
|
|
142
|
39
|
100
|
|
|
|
159
|
if ( $self->fuzzify ) { |
|
|
100
|
|
|
|
|
|
143
|
6
|
100
|
|
|
|
28
|
$value .= '*' unless $value =~ m/[\*\%]/; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
elsif ( $self->fuzzify2 ) { |
146
|
2
|
50
|
|
|
|
11
|
$value = "*$value*" unless $value =~ m/[\*\%]/; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# normalize wildcard |
150
|
39
|
|
|
|
|
169
|
my $wildcard = $self->wildcard; |
151
|
39
|
|
|
|
|
113
|
$value =~ s/\*/$wildcard/g; |
152
|
|
|
|
|
|
|
|
153
|
39
|
|
|
|
|
108
|
return $value; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 stringify_clause( I, I ) |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Called by stringify() to handle each Clause in the Query tree. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=cut |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub stringify_clause { |
163
|
46
|
|
|
46
|
1
|
62
|
my $self = shift; |
164
|
46
|
|
|
|
|
59
|
my $clause = shift; |
165
|
46
|
|
|
|
|
55
|
my $prefix = shift; |
166
|
|
|
|
|
|
|
|
167
|
46
|
100
|
|
|
|
198
|
if ( $clause->{op} eq '()' ) { |
168
|
5
|
100
|
66
|
|
|
26
|
if ( $clause->has_children and $clause->has_children == 1 ) { |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# muck about in the internals because SQL relies on the operator, |
171
|
|
|
|
|
|
|
# not the prefix, to indicate the "NOT"-ness of a clause. |
172
|
2
|
50
|
33
|
|
|
23
|
if ( $prefix eq '-' and exists $clause->{value}->{'+'} ) { |
173
|
0
|
|
|
|
|
0
|
$clause->{value}->{'-'} = delete $clause->{value}->{'+'}; |
174
|
|
|
|
|
|
|
} |
175
|
2
|
|
|
|
|
12
|
return '(' . $self->stringify( $clause->{value} ) . ')'; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
else { |
178
|
|
|
|
|
|
|
return |
179
|
3
|
50
|
|
|
|
24
|
( $prefix eq '-' ? 'NOT ' : '' ) . "(" |
180
|
|
|
|
|
|
|
. $self->stringify( $clause->{value} ) . ")"; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# optional |
185
|
41
|
|
|
|
|
114
|
my $quote_fields = $self->quote_fields; |
186
|
41
|
|
|
|
|
90
|
my $fuzzy_space = $self->fuzzy_space; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# TODO proximity - anything special and SQL-specific? |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# make sure we have a field |
191
|
|
|
|
|
|
|
my @fields |
192
|
8
|
|
|
|
|
42
|
= $clause->{field} |
193
|
|
|
|
|
|
|
? ( $clause->{field} ) |
194
|
41
|
100
|
|
|
|
153
|
: ( @{ $self->get_default_field } ); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# what value |
197
|
41
|
|
|
|
|
112
|
my $value = $self->_doctor_value($clause); |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# normalize operator |
200
|
41
|
|
100
|
|
|
139
|
my $op = $clause->{op} || "="; |
201
|
41
|
100
|
|
|
|
96
|
if ( $op eq ':' ) { |
202
|
18
|
|
|
|
|
29
|
$op = '='; |
203
|
|
|
|
|
|
|
} |
204
|
41
|
100
|
|
|
|
87
|
if ( $prefix eq '-' ) { |
205
|
4
|
|
|
|
|
10
|
$op = '!' . $op; |
206
|
|
|
|
|
|
|
} |
207
|
41
|
100
|
100
|
|
|
222
|
if ( defined $value and $value =~ m/\%/ ) { |
208
|
8
|
50
|
|
|
|
15
|
$op = $prefix eq '-' ? '!~' : '~'; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
41
|
|
|
|
|
52
|
my @buf; |
212
|
41
|
|
|
|
|
69
|
NAME: for my $name (@fields) { |
213
|
55
|
|
|
|
|
1836
|
my $field = $self->get_field($name); |
214
|
55
|
100
|
|
|
|
151
|
$value =~ s/\%//g if $field->is_int; |
215
|
55
|
|
|
|
|
69
|
my $this_op; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# whether we quote depends on the field (column) type |
218
|
55
|
100
|
|
|
|
171
|
my $quote = $field->is_int ? "" : $self->quote_char; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
#warn dump [ $prefix, $field, $value, $op, $quote ]; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# range |
223
|
55
|
100
|
|
|
|
278
|
if ( $op eq '..' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
224
|
2
|
50
|
33
|
|
|
18
|
if ( ref $value ne 'ARRAY' or @$value != 2 ) { |
225
|
0
|
|
|
|
|
0
|
croak "range of values must be a 2-element ARRAY"; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
2
|
|
|
|
|
12
|
my @range = ( $value->[0] .. $value->[1] ); |
229
|
10
|
|
|
|
|
28
|
push( |
230
|
|
|
|
|
|
|
@buf, |
231
|
|
|
|
|
|
|
join( '', |
232
|
|
|
|
|
|
|
$quote_fields, $name, $quote_fields, ' IN ', '(', |
233
|
2
|
|
|
|
|
8
|
join( ', ', map { $quote . $_ . $quote } @range ), ')' ) |
234
|
|
|
|
|
|
|
); |
235
|
2
|
|
|
|
|
10
|
next NAME; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# invert range |
240
|
|
|
|
|
|
|
elsif ( $op eq '!..' ) { |
241
|
2
|
50
|
33
|
|
|
19
|
if ( ref $value ne 'ARRAY' or @$value != 2 ) { |
242
|
0
|
|
|
|
|
0
|
croak "range of values must be a 2-element ARRAY"; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
2
|
|
|
|
|
14
|
my @range = ( $value->[0] .. $value->[1] ); |
246
|
10
|
|
|
|
|
30
|
push( |
247
|
|
|
|
|
|
|
@buf, |
248
|
|
|
|
|
|
|
join( '', |
249
|
|
|
|
|
|
|
$quote_fields, $name, $quote_fields, ' NOT IN ', '( ', |
250
|
2
|
|
|
|
|
8
|
join( ', ', map { $quote . $_ . $quote } @range ), ' )' ) |
251
|
|
|
|
|
|
|
); |
252
|
2
|
|
|
|
|
11
|
next NAME; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# fuzzy |
256
|
|
|
|
|
|
|
elsif ( $op =~ m/\~/ ) { |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# negation |
259
|
8
|
50
|
|
|
|
14
|
if ( $op eq '!~' ) { |
260
|
0
|
0
|
|
|
|
0
|
if ( $field->is_int ) { |
261
|
0
|
|
|
|
|
0
|
$this_op = $field->fuzzy_not_op; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
else { |
264
|
0
|
|
|
|
|
0
|
$this_op |
265
|
|
|
|
|
|
|
= $fuzzy_space . $field->fuzzy_not_op . $fuzzy_space; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# standard fuzzy |
270
|
|
|
|
|
|
|
else { |
271
|
8
|
100
|
|
|
|
19
|
if ( $field->is_int ) { |
272
|
4
|
|
|
|
|
11
|
$this_op = $field->fuzzy_op; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
else { |
275
|
4
|
|
|
|
|
13
|
$this_op = $fuzzy_space . $field->fuzzy_op . $fuzzy_space; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# null |
281
|
|
|
|
|
|
|
elsif ( !defined $value ) { |
282
|
2
|
100
|
|
|
|
6
|
if ( $op eq '=' ) { |
283
|
1
|
|
|
|
|
4
|
$this_op = ' is '; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
else { |
286
|
1
|
|
|
|
|
3
|
$this_op = ' is not '; |
287
|
|
|
|
|
|
|
} |
288
|
2
|
|
|
|
|
4
|
$value = 'NULL'; |
289
|
2
|
|
|
|
|
3
|
$quote = ''; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# default, pass through |
293
|
|
|
|
|
|
|
else { |
294
|
41
|
|
|
|
|
56
|
$this_op = $op; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
51
|
50
|
|
|
|
168
|
if ( defined $field->callback ) { |
298
|
0
|
|
|
|
|
0
|
push( @buf, $field->callback->( $field, $this_op, $value ) ); |
299
|
0
|
|
|
|
|
0
|
next NAME; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
#warn dump [ $quote_fields, $name, $this_op, $quote, $value ]; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
push( |
305
|
51
|
|
|
|
|
220
|
@buf, |
306
|
|
|
|
|
|
|
join( '', |
307
|
|
|
|
|
|
|
$quote_fields, $name, $quote_fields, $this_op, |
308
|
|
|
|
|
|
|
$quote, $value, $quote ) |
309
|
|
|
|
|
|
|
); |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
} |
312
|
41
|
100
|
|
|
|
118
|
my $joiner = $prefix eq '-' ? ' AND ' : ' OR '; |
313
|
|
|
|
|
|
|
return |
314
|
41
|
100
|
|
|
|
286
|
( scalar(@buf) > 1 ? '(' : '' ) |
|
|
100
|
|
|
|
|
|
315
|
|
|
|
|
|
|
. join( $joiner, @buf ) |
316
|
|
|
|
|
|
|
. ( scalar(@buf) > 1 ? ')' : '' ); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head2 get_field |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Overrides default to set fuzzy_op and fuzzy_not_op. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=cut |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
around get_field => sub { |
326
|
|
|
|
|
|
|
my $orig = shift; |
327
|
|
|
|
|
|
|
my $self = shift; |
328
|
|
|
|
|
|
|
my $field = $orig->( $self, @_ ); |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# fix up the operator based on our like() setting |
331
|
|
|
|
|
|
|
if ( !$field->is_int and $self->like ) { |
332
|
|
|
|
|
|
|
$field->fuzzy_op( $self->like ); |
333
|
|
|
|
|
|
|
$field->fuzzy_not_op( 'NOT ' . $self->like ); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
return $field; |
337
|
|
|
|
|
|
|
}; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head2 field_class |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
Returns "Search::Query::Field::SQL". |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=cut |
344
|
|
|
|
|
|
|
|
345
|
16
|
|
|
16
|
1
|
71
|
sub field_class {'Search::Query::Field::SQL'} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
1; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
__END__ |