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.
29 # Import configuration data from the lexcial scope of __PACKAGE__ (or
30 # at least where those two Subroutines are defined.)
32 my %FIELDS = %{FIELDS()};
33 my %dispatch = %{dispatch()};
34 my %can_bundle = %{can_bundle()};
36 # Lower Case version of FIELDS, for case insensitivity
37 my %lcfields = map { ( lc($_) => $_ ) } (keys %FIELDS);
42 # How many of these do we actually still use?
44 # Private Member Variales (which should get cleaned)
45 $self->{'_sql_linksc'} = 0;
46 $self->{'_sql_watchersc'} = 0;
47 $self->{'_sql_keywordsc'} = 0;
48 $self->{'_sql_subclause'} = "a";
49 $self->{'_sql_first'} = 0;
50 $self->{'_sql_opstack'} = [''];
51 $self->{'_sql_linkalias'} = undef;
52 $self->{'_sql_transalias'} = undef;
53 $self->{'_sql_trattachalias'} = undef;
54 $self->{'_sql_keywordalias'} = undef;
55 $self->{'_sql_depth'} = 0;
56 $self->{'_sql_localdepth'} = 0;
57 $self->{'_sql_query'} = '';
58 $self->{'_sql_looking_at'} = {};
59 $self->{'_sql_columns_to_display'} = [];
64 # All SQL stuff goes into one SB subclause so we can deal with all
68 $this->SUPER::Limit(@_,
69 SUBCLAUSE => 'ticketsql');
73 # All SQL stuff goes into one SB subclause so we can deal with all
77 $this->SUPER::Join(@_,
78 SUBCLAUSE => 'ticketsql');
83 $_[0]->SUPER::_OpenParen( 'ticketsql' );
86 $_[0]->SUPER::_CloseParen( 'ticketsql' );
94 # Case insensitive equality
96 return 1 if $x =~ /^$y$/i;
97 # return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
101 =head2 Robert's Simple SQL Parser
103 Documentation In Progress
105 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:
107 VALUE -> quoted string or number
108 AGGREGator -> AND or OR
109 KEYWORD -> quoted string or single word
110 OPerator -> =,!=,LIKE,etc..
111 PARENthesis -> open or close.
113 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
119 That also deals with parenthesis for nesting. (The parentheses are
120 just handed off the SearchBuilder)
124 use Regexp::Common qw /delimited/;
127 use constant VALUE => 1;
128 use constant AGGREG => 2;
129 use constant OP => 4;
130 use constant PAREN => 8;
131 use constant KEYWORD => 16;
132 my @tokens = qw[VALUE AGGREG OP PAREN KEYWORD];
134 my $re_aggreg = qr[(?i:AND|OR)];
135 my $re_value = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
136 my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
137 my $re_op = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
138 my $re_paren = qr'\(|\)';
142 my ($self, @bundle) = @_;
143 return unless @bundle;
145 $bundle[0]->{dispatch}->(
151 ENTRYAGGREGATOR => $bundle[0]->{ea},
152 SUBKEY => $bundle[0]->{subkey},
156 for my $chunk (@bundle) {
162 ENTRYAGGREGATOR => $chunk->{ea},
163 SUBKEY => $chunk->{subkey},
166 $bundle[0]->{dispatch}->(
173 my ($self,$string) = @_;
174 my $want = KEYWORD | PAREN;
180 my ($ea,$key,$op,$value) = ("","","","");
182 # order of matches in the RE is important.. op should come early,
183 # because it has spaces in it. otherwise "NOT LIKE" might be parsed
184 # as a keyword or value.
200 # Highest priority is last
201 $current = OP if _match($re_op,$val) ;
202 $current = VALUE if _match($re_value,$val);
203 $current = KEYWORD if _match($re_keyword,$val) && ($want & KEYWORD);
204 $current = AGGREG if _match($re_aggreg,$val);
205 $current = PAREN if _match($re_paren,$val);
208 unless ($current && $want & $current) {
210 # FIXME: I will only print out the highest $want value
211 die "Error near ->$val<- expecting a ", $tokens[((log $want)/(log 2))], " in $string\n";
216 #$RT::Logger->debug("We've just found a '$current' called '$val'");
218 # Parens are highest priority
219 if ($current & PAREN) {
221 $self->_close_bundle(@bundle); @bundle = ();
226 $self->_close_bundle(@bundle); @bundle = ();
231 $want = KEYWORD | PAREN | AGGREG;
234 elsif ( $current & AGGREG ) {
236 $want = KEYWORD | PAREN;
238 elsif ( $current & KEYWORD ) {
242 elsif ( $current & OP ) {
246 elsif ( $current & VALUE ) {
249 # Remove surrounding quotes from $key, $val
250 # (in future, simplify as for($key,$val) { action on $_ })
251 if ($key =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
252 substr($key,0,1) = "";
253 substr($key,-1,1) = "";
255 if ($val =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
256 substr($val,0,1) = "";
257 substr($val,-1,1) = "";
259 # Unescape escaped characters
260 $key =~ s!\\(.)!$1!g;
261 $val =~ s!\\(.)!$1!g;
262 # print "$ea Key=[$key] op=[$op] val=[$val]\n";
266 if ($key =~ /^(.+?)\.(.+)$/) {
272 if (exists $lcfields{lc $key}) {
273 $key = $lcfields{lc $key};
274 $class = $FIELDS{$key}->[0];
276 # no longer have a default, since CF's are now a real class, not fallthrough
277 # fixme: "default class" is not Generic.
280 die "Unknown field: $key" unless $class;
282 $self->{_sql_localdepth} = 0;
283 die "No such dispatch method: $class"
284 unless exists $dispatch{$class};
285 my $sub = $dispatch{$class} || die;;
286 if ($can_bundle{$class} &&
288 ($bundle[-1]->{dispatch} == $sub &&
289 $bundle[-1]->{key} eq $key &&
290 $bundle[-1]->{subkey} eq $subkey)))
301 $self->_close_bundle(@bundle); @bundle = ();
307 SUBCLAUSE => "", # don't need anymore
308 ENTRYAGGREGATOR => $ea || "",
313 $self->{_sql_looking_at}{lc $key} = 1;
315 ($ea,$key,$op,$value) = ("","","","");
317 $want = PAREN | AGGREG;
325 $self->_close_bundle(@bundle); @bundle = ();
327 die "Incomplete query"
328 unless (($want | PAREN) || ($want | KEYWORD));
330 die "Incomplete Query"
331 unless ($last && ($last | PAREN) || ($last || VALUE));
333 # This will never happen, because the parser will complain
334 die "Mismatched parentheses"
349 for my $f (keys %{$clauses}) {
353 # Build SQL from the data hash
354 for my $data ( @{ $clauses->{$f} } ) {
355 $sql .= $data->[0] unless $first; $first=0;
356 $sql .= " '". $data->[2] . "' ";
357 $sql .= $data->[3] . " ";
358 $sql .= "'". $data->[4] . "' ";
361 push @sql, " ( " . $sql . " ) ";
364 return join("AND",@sql);
369 Convert a RT-SQL string into a set of SearchBuilder restrictions.
371 Returns (1, 'Status message') on success and (0, 'Error Message') on
381 my $tix = RT::Tickets->new($RT::SystemUser);
383 my $query = "Status = 'open'";
384 my ($id, $msg) = $tix->FromSQL($query);
389 my (@ids, @expectedids);
391 my $t = RT::Ticket->new($RT::SystemUser);
393 my $string = 'subject/content SQL test';
394 ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
398 my $Message = MIME::Entity->build(
399 Subject => 'this is my subject',
400 From => 'jesse@example.com',
404 ok( $t->Create(Queue => 'General', Subject => 'another ticket', MIMEObj => $Message, MemberOf => $ids[0]), "Ticket Created");
408 $query = ("Subject LIKE '$string' OR Content LIKE '$string'");
410 my ($id, $msg) = $tix->FromSQL($query);
414 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
416 while (my $tick = $tix->Next) {
417 push @expectedids, $tick->Id;
420 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
422 $query = ("id = $ids[0] OR MemberOf = $ids[0]");
424 my ($id, $msg) = $tix->FromSQL($query);
428 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
431 while (my $tick = $tix->Next) {
432 push @expectedids, $tick->Id;
435 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
443 my ($self,$query) = @_;
447 # preserve first_row and show_rows across the CleanSlate
448 local($self->{'first_row'}, $self->{'show_rows'});
453 return (1,$self->loc("No Query")) unless $query;
455 $self->{_sql_query} = $query;
456 eval { $self->_parser( $query ); };
458 $RT::Logger->error( $@ );
461 # We only want to look at EffectiveId's (mostly) for these searches.
462 unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
463 $self->SUPER::Limit( FIELD => 'EffectiveId',
464 ENTRYAGGREGATOR => 'AND',
468 ); #TODO, we shouldn't be hard #coding the tablename to main.
470 # FIXME: Need to bring this logic back in
472 # if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
473 # $self->SUPER::Limit( FIELD => 'EffectiveId',
476 # VALUE => 'main.id'); #TODO, we shouldn't be hard coding the tablename to main.
478 # --- This is hardcoded above. This comment block can probably go.
479 # Or, we need to reimplement the looking_at_effective_id toggle.
481 # Unless we've explicitly asked to look at a specific Type, we need
483 unless ($self->{looking_at_type}) {
484 $self->SUPER::Limit( FIELD => 'Type', OPERATOR => '=', VALUE => 'ticket');
487 # We never ever want to show deleted tickets
488 $self->SUPER::Limit(FIELD => 'Status' , OPERATOR => '!=', VALUE => 'deleted');
491 # set SB's dirty flag
492 $self->{'must_redo_search'} = 1;
493 $self->{'RecalcTicketLimits'} = 0;
495 return (1,$self->loc("Valid Query"));
501 Returns the query that this object was initialized with
507 return ($self->{_sql_query});
518 Most of the RT code does not use Exceptions (die/eval) but it is used
519 in the TicketSQL code for simplicity and historical reasons. Lest you
520 be worried that the dies will trigger user visible errors, all are
523 99% of the dies fall in subroutines called via FromSQL and then parse.
524 (This includes all of the _FooLimit routines in Tickets_Overlay.pm.)
525 The other 1% or so are via _ProcessRestrictions.
527 All dies are trapped by eval {}s, and will be logged at the 'error'
528 log level. The general failure mode is to not display any tickets.
534 Legacy LimitFoo routines build up a RestrictionsHash
536 _ProcessRestrictions converts the Restrictions to Clauses
539 Clauses are converted to RT-SQL (TicketSQL)
543 FromSQL calls the parser
545 The parser calls the _FooLimit routines to do DBIx::SearchBuilder
548 And then the normal SearchBuilder/Ticket routines are used for