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()};
36 # How many of these do we actually still use?
38 # Private Member Variales (which should get cleaned)
39 $self->{'_sql_linksc'} = 0;
40 $self->{'_sql_watchersc'} = 0;
41 $self->{'_sql_keywordsc'} = 0;
42 $self->{'_sql_subclause'} = "a";
43 $self->{'_sql_first'} = 0;
44 $self->{'_sql_opstack'} = [''];
45 $self->{'_sql_transalias'} = undef;
46 $self->{'_sql_trattachalias'} = undef;
47 $self->{'_sql_keywordalias'} = undef;
48 $self->{'_sql_depth'} = 0;
49 $self->{'_sql_localdepth'} = 0;
50 $self->{'_sql_query'} = '';
51 $self->{'_sql_looking_at'} = {};
56 # All SQL stuff goes into one SB subclause so we can deal with all
59 $this->SUPER::Limit(@_,
60 SUBCLAUSE => 'ticketsql');
65 $_[0]->SUPER::_OpenParen( 'ticketsql' );
68 $_[0]->SUPER::_CloseParen( 'ticketsql' );
76 # Case insensitive equality
78 return 1 if $x =~ /^$y$/i;
79 # return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
83 =head2 Robert's Simple SQL Parser
85 Documentation In Progress
87 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:
89 VALUE -> quoted string or number
90 AGGREGator -> AND or OR
91 KEYWORD -> quoted string or single word
92 OPerator -> =,!=,LIKE,etc..
93 PARENthesis -> open or close.
95 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
101 That also deals with parenthesis for nesting. (The parentheses are
102 just handed off the SearchBuilder)
106 use Regexp::Common qw /delimited/;
109 use constant VALUE => 1;
110 use constant AGGREG => 2;
111 use constant OP => 4;
112 use constant PAREN => 8;
113 use constant KEYWORD => 16;
114 my @tokens = qw[VALUE AGGREG OP PAREN KEYWORD];
116 my $re_aggreg = qr[(?i:AND|OR)];
117 my $re_value = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
118 my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
119 my $re_op = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
120 my $re_paren = qr'\(|\)';
123 my ($self,$string) = @_;
124 my $want = KEYWORD | PAREN;
129 my ($ea,$key,$op,$value) = ("","","","");
141 # Highest priority is last
142 $current = OP if _match($re_op,$val);
143 $current = VALUE if _match($re_value,$val);
144 $current = KEYWORD if _match($re_keyword,$val) && ($want & KEYWORD);
145 $current = AGGREG if _match($re_aggreg,$val);
146 $current = PAREN if _match($re_paren,$val);
148 unless ($current && $want & $current) {
150 # FIXME: I will only print out the highest $want value
151 die "Error near ->$val<- expecting a ", $tokens[((log $want)/(log 2))], " in $string\n";
156 # Parens are highest priority
157 if ($current & PAREN) {
167 $want = KEYWORD | PAREN | AGGREG;
169 elsif ( $current & AGGREG ) {
171 $want = KEYWORD | PAREN;
173 elsif ( $current & KEYWORD ) {
177 elsif ( $current & OP ) {
181 elsif ( $current & VALUE ) {
184 # Remove surrounding quotes from $key, $val
185 # (in future, simplify as for($key,$val) { action on $_ })
186 if ($key =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
187 substr($key,0,1) = "";
188 substr($key,-1,1) = "";
190 if ($val =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
191 substr($val,0,1) = "";
192 substr($val,-1,1) = "";
194 # Unescape escaped characters
195 $key =~ s!\\(.)!$1!g;
196 $val =~ s!\\(.)!$1!g;
197 # print "$ea Key=[$key] op=[$op] val=[$val]\n";
201 if ($key =~ /^(.+?)\.(.+)$/) {
207 my ($stdkey) = grep { /^$key$/i } (keys %FIELDS);
208 if ($stdkey && exists $FIELDS{$stdkey}) {
209 $class = $FIELDS{$key}->[0];
212 # no longer have a default, since CF's are now a real class, not fallthrough
213 # fixme: "default class" is not Generic.
216 die "Unknown field: $key" unless $class;
218 $self->{_sql_localdepth} = 0;
219 die "No such dispatch method: $class"
220 unless exists $dispatch{$class};
221 my $sub = $dispatch{$class} || die;;
227 SUBCLAUSE => "", # don't need anymore
228 ENTRYAGGREGATOR => $ea || "",
232 $self->{_sql_looking_at}{lc $key} = 1;
234 ($ea,$key,$op,$value) = ("","","","");
236 $want = PAREN | AGGREG;
244 die "Incomplete query"
245 unless (($want | PAREN) || ($want | KEYWORD));
247 die "Incomplete Query"
248 unless ($last && ($last | PAREN) || ($last || VALUE));
250 # This will never happen, because the parser will complain
251 die "Mismatched parentheses"
266 for my $f (keys %{$clauses}) {
270 # Build SQL from the data hash
271 for my $data ( @{ $clauses->{$f} } ) {
272 $sql .= $data->[0] unless $first; $first=0;
273 $sql .= " '". $data->[2] . "' ";
274 $sql .= $data->[3] . " ";
275 $sql .= "'". $data->[4] . "' ";
278 push @sql, " ( " . $sql . " ) ";
281 return join("AND",@sql);
286 Convert a RT-SQL string into a set of SearchBuilder restrictions.
288 Returns (1, 'Status message') on success and (0, 'Error Message') on
294 my ($self,$query) = @_;
298 return (1,"No Query") unless $query;
300 $self->{_sql_query} = $query;
301 eval { $self->_parser( $query ); };
302 $RT::Logger->error( $@ ) if $@;
305 # We only want to look at EffectiveId's (mostly) for these searches.
306 unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
307 $self->SUPER::Limit( FIELD => 'EffectiveId',
308 ENTRYAGGREGATOR => 'AND',
312 ); #TODO, we shouldn't be hard #coding the tablename to main.
314 # FIXME: Need to bring this logic back in
316 # if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
317 # $self->SUPER::Limit( FIELD => 'EffectiveId',
320 # VALUE => 'main.id'); #TODO, we shouldn't be hard coding the tablename to main.
322 # --- This is hardcoded above. This comment block can probably go.
323 # Or, we need to reimplement the looking_at_effective_id toggle.
325 # Unless we've explicitly asked to look at a specific Type, we need
327 unless ($self->{looking_at_type}) {
328 $self->SUPER::Limit( FIELD => 'Type',
333 # set SB's dirty flag
334 $self->{'must_redo_search'} = 1;
335 $self->{'RecalcTicketLimits'} = 0;
337 return (1,"Good Query");
348 Most of the RT code does not use Exceptions (die/eval) but it is used
349 in the TicketSQL code for simplicity and historical reasons. Lest you
350 be worried that the dies will trigger user visible errors, all are
353 99% of the dies fall in subroutines called via FromSQL and then parse.
354 (This includes all of the _FooLimit routines in Tickets_Overlay.pm.)
355 The other 1% or so are via _ProcessRestrictions.
357 All dies are trapped by eval {}s, and will be logged at the 'error'
358 log level. The general failure mode is to not display any tickets.
364 Legacy LimitFoo routines build up a RestrictionsHash
366 _ProcessRestrictions converts the Restrictions to Clauses
369 Clauses are converted to RT-SQL (TicketSQL)
373 FromSQL calls the parser
375 The parser calls the _FooLimit routines to do DBIx::SearchBuilder
378 And then the normal SearchBuilder/Ticket routines are used for