3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
5 # (Except where explictly superceded by other copyright notices)
7 # This work is made available to you under the terms of Version 2 of
8 # the GNU General Public License. A copy of that license should have
9 # been provided with this software, but in any event can be snarfed
12 # This work is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # Unless otherwise specified, all modifications, corrections or
18 # extensions to this work which alter its source code become the
19 # property of Best Practical Solutions, LLC when submitted for
20 # inclusion in the work.
27 # Import configuration data from the lexcial scope of __PACKAGE__ (or
28 # at least where those two Subroutines are defined.)
30 my %FIELDS = %{FIELDS()};
31 my %dispatch = %{dispatch()};
32 my %can_bundle = %{can_bundle()};
34 # Lower Case version of FIELDS, for case insensitivity
35 my %lcfields = map { ( lc($_) => $_ ) } (keys %FIELDS);
40 # How many of these do we actually still use?
42 # Private Member Variales (which should get cleaned)
43 $self->{'_sql_linksc'} = 0;
44 $self->{'_sql_watchersc'} = 0;
45 $self->{'_sql_keywordsc'} = 0;
46 $self->{'_sql_subclause'} = "a";
47 $self->{'_sql_first'} = 0;
48 $self->{'_sql_opstack'} = [''];
49 $self->{'_sql_transalias'} = undef;
50 $self->{'_sql_trattachalias'} = undef;
51 $self->{'_sql_keywordalias'} = undef;
52 $self->{'_sql_depth'} = 0;
53 $self->{'_sql_localdepth'} = 0;
54 $self->{'_sql_query'} = '';
55 $self->{'_sql_looking_at'} = {};
60 # All SQL stuff goes into one SB subclause so we can deal with all
63 $this->SUPER::Limit(@_,
64 SUBCLAUSE => 'ticketsql');
69 $_[0]->SUPER::_OpenParen( 'ticketsql' );
72 $_[0]->SUPER::_CloseParen( 'ticketsql' );
80 # Case insensitive equality
82 return 1 if $x =~ /^$y$/i;
83 # return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
87 =head2 Robert's Simple SQL Parser
89 Documentation In Progress
91 The Parser/Tokenizer is a relatively simple state machine that scans through a SQL WHERE clause type string extracting a token at a time (where a token is:
93 VALUE -> quoted string or number
94 AGGREGator -> AND or OR
95 KEYWORD -> quoted string or single word
96 OPerator -> =,!=,LIKE,etc..
97 PARENthesis -> open or close.
99 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
105 That also deals with parenthesis for nesting. (The parentheses are
106 just handed off the SearchBuilder)
110 use Regexp::Common qw /delimited/;
113 use constant VALUE => 1;
114 use constant AGGREG => 2;
115 use constant OP => 4;
116 use constant PAREN => 8;
117 use constant KEYWORD => 16;
118 my @tokens = qw[VALUE AGGREG OP PAREN KEYWORD];
120 my $re_aggreg = qr[(?i:AND|OR)];
121 my $re_value = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
122 my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
123 my $re_op = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
124 my $re_paren = qr'\(|\)';
128 my ($self, @bundle) = @_;
129 return unless @bundle;
131 $bundle[0]->{dispatch}->(
137 ENTRYAGGREGATOR => $bundle[0]->{ea},
138 SUBKEY => $bundle[0]->{subkey},
142 for my $chunk (@bundle) {
148 ENTRYAGGREGATOR => $chunk->{ea},
149 SUBKEY => $chunk->{subkey},
152 $bundle[0]->{dispatch}->(
159 my ($self,$string) = @_;
160 my $want = KEYWORD | PAREN;
166 my ($ea,$key,$op,$value) = ("","","","");
168 # order of matches in the RE is important.. op should come early,
169 # because it has spaces in it. otherwise "NOT LIKE" might be parsed
170 # as a keyword or value.
182 # Highest priority is last
183 $current = OP if _match($re_op,$val);
184 $current = VALUE if _match($re_value,$val);
185 $current = KEYWORD if _match($re_keyword,$val) && ($want & KEYWORD);
186 $current = AGGREG if _match($re_aggreg,$val);
187 $current = PAREN if _match($re_paren,$val);
189 unless ($current && $want & $current) {
191 # FIXME: I will only print out the highest $want value
192 die "Error near ->$val<- expecting a ", $tokens[((log $want)/(log 2))], " in $string\n";
197 # Parens are highest priority
198 if ($current & PAREN) {
200 $self->_close_bundle(@bundle); @bundle = ();
205 $self->_close_bundle(@bundle); @bundle = ();
210 $want = KEYWORD | PAREN | AGGREG;
212 elsif ( $current & AGGREG ) {
214 $want = KEYWORD | PAREN;
216 elsif ( $current & KEYWORD ) {
220 elsif ( $current & OP ) {
224 elsif ( $current & VALUE ) {
227 # Remove surrounding quotes from $key, $val
228 # (in future, simplify as for($key,$val) { action on $_ })
229 if ($key =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
230 substr($key,0,1) = "";
231 substr($key,-1,1) = "";
233 if ($val =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
234 substr($val,0,1) = "";
235 substr($val,-1,1) = "";
237 # Unescape escaped characters
238 $key =~ s!\\(.)!$1!g;
239 $val =~ s!\\(.)!$1!g;
240 # print "$ea Key=[$key] op=[$op] val=[$val]\n";
244 if ($key =~ /^(.+?)\.(.+)$/) {
250 if (exists $lcfields{lc $key}) {
251 $key = $lcfields{lc $key};
252 $class = $FIELDS{$key}->[0];
254 # no longer have a default, since CF's are now a real class, not fallthrough
255 # fixme: "default class" is not Generic.
258 die "Unknown field: $key" unless $class;
260 $self->{_sql_localdepth} = 0;
261 die "No such dispatch method: $class"
262 unless exists $dispatch{$class};
263 my $sub = $dispatch{$class} || die;;
264 if ($can_bundle{$class} &&
266 ($bundle[-1]->{dispatch} == $sub &&
267 $bundle[-1]->{key} eq $key &&
268 $bundle[-1]->{subkey} eq $subkey)))
279 $self->_close_bundle(@bundle); @bundle = ();
285 SUBCLAUSE => "", # don't need anymore
286 ENTRYAGGREGATOR => $ea || "",
291 $self->{_sql_looking_at}{lc $key} = 1;
293 ($ea,$key,$op,$value) = ("","","","");
295 $want = PAREN | AGGREG;
303 $self->_close_bundle(@bundle); @bundle = ();
305 die "Incomplete query"
306 unless (($want | PAREN) || ($want | KEYWORD));
308 die "Incomplete Query"
309 unless ($last && ($last | PAREN) || ($last || VALUE));
311 # This will never happen, because the parser will complain
312 die "Mismatched parentheses"
327 for my $f (keys %{$clauses}) {
331 # Build SQL from the data hash
332 for my $data ( @{ $clauses->{$f} } ) {
333 $sql .= $data->[0] unless $first; $first=0;
334 $sql .= " '". $data->[2] . "' ";
335 $sql .= $data->[3] . " ";
336 $sql .= "'". $data->[4] . "' ";
339 push @sql, " ( " . $sql . " ) ";
342 return join("AND",@sql);
347 Convert a RT-SQL string into a set of SearchBuilder restrictions.
349 Returns (1, 'Status message') on success and (0, 'Error Message') on
355 my ($self,$query) = @_;
359 return (1,"No Query") unless $query;
361 $self->{_sql_query} = $query;
362 eval { $self->_parser( $query ); };
363 $RT::Logger->error( $@ ) if $@;
366 # We only want to look at EffectiveId's (mostly) for these searches.
367 unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
368 $self->SUPER::Limit( FIELD => 'EffectiveId',
369 ENTRYAGGREGATOR => 'AND',
373 ); #TODO, we shouldn't be hard #coding the tablename to main.
375 # FIXME: Need to bring this logic back in
377 # if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
378 # $self->SUPER::Limit( FIELD => 'EffectiveId',
381 # VALUE => 'main.id'); #TODO, we shouldn't be hard coding the tablename to main.
383 # --- This is hardcoded above. This comment block can probably go.
384 # Or, we need to reimplement the looking_at_effective_id toggle.
386 # Unless we've explicitly asked to look at a specific Type, we need
388 unless ($self->{looking_at_type}) {
389 $self->SUPER::Limit( FIELD => 'Type',
394 # We never ever want to show deleted tickets
395 $self->SUPER::Limit(FIELD => 'Status' , OPERATOR => '!=', VALUE => 'deleted');
398 # set SB's dirty flag
399 $self->{'must_redo_search'} = 1;
400 $self->{'RecalcTicketLimits'} = 0;
402 return (1,"Good Query");
413 Most of the RT code does not use Exceptions (die/eval) but it is used
414 in the TicketSQL code for simplicity and historical reasons. Lest you
415 be worried that the dies will trigger user visible errors, all are
418 99% of the dies fall in subroutines called via FromSQL and then parse.
419 (This includes all of the _FooLimit routines in Tickets_Overlay.pm.)
420 The other 1% or so are via _ProcessRestrictions.
422 All dies are trapped by eval {}s, and will be logged at the 'error'
423 log level. The general failure mode is to not display any tickets.
429 Legacy LimitFoo routines build up a RestrictionsHash
431 _ProcessRestrictions converts the Restrictions to Clauses
434 Clauses are converted to RT-SQL (TicketSQL)
438 FromSQL calls the parser
440 The parser calls the _FooLimit routines to do DBIx::SearchBuilder
443 And then the normal SearchBuilder/Ticket routines are used for