rt/lib/RT/Tickets_Overlay_SQL.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   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
  10 # from www.gnu.org.
  11 #
  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.
  16 #
  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.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 use strict;
  25 use warnings;
  26
  27 # Import configuration data from the lexcial scope of __PACKAGE__ (or
  28 # at least where those two Subroutines are defined.)
  29
  30 my %FIELDS = %{FIELDS()};
  31 my %dispatch = %{dispatch()};
  32
  33 sub _InitSQL {
  34   my $self = shift;
  35
  36   # How many of these do we actually still use?
  37
  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'}    = {};
  52
  53 }
  54
  55 sub _SQLLimit {
  56   # All SQL stuff goes into one SB subclause so we can deal with all
  57   # the aggregation
  58   my $this = shift;
  59   $this->SUPER::Limit(@_,
  60                       SUBCLAUSE => 'ticketsql');
  61 }
  62
  63 # Helpers
  64 sub _OpenParen {
  65   $_[0]->SUPER::_OpenParen( 'ticketsql' );
  66 }
  67 sub _CloseParen {
  68   $_[0]->SUPER::_CloseParen( 'ticketsql' );
  69 }
  70
  71 =head1 SQL Functions
  72
  73 =cut
  74
  75 sub _match {
  76   # Case insensitive equality
  77   my ($y,$x) = @_;
  78   return 1 if $x =~ /^$y$/i;
  79   #  return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
  80   return 0;
  81 }
  82
  83 =head2 Robert's Simple SQL Parser
  84
  85 Documentation In Progress
  86
  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:
  88
  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.
  94
  95 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
  96
  97        KEY OP VALUE
  98   AND  KEY OP VALUE
  99   OR   KEY OP VALUE
 100
 101 That also deals with parenthesis for nesting.  (The parentheses are
 102 just handed off the SearchBuilder)
 103
 104 =cut
 105
 106 use Regexp::Common qw /delimited/;
 107
 108 # States
 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];
 115
 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'\(|\)';
 121
 122 sub _parser {
 123   my ($self,$string) = @_;
 124   my $want = KEYWORD | PAREN;
 125   my $last = undef;
 126
 127   my $depth = 0;
 128
 129   my ($ea,$key,$op,$value) = ("","","","");
 130
 131   while ($string =~ /(
 132                       $re_aggreg
 133                       |$re_keyword
 134                       |$re_value
 135                       |$re_op
 136                       |$re_paren
 137                      )/igx ) {
 138     my $val = $1;
 139     my $current = 0;
 140
 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);
 147
 148     unless ($current && $want & $current) {
 149       # Error
 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";
 152     }
 153
 154     # State Machine:
 155
 156     # Parens are highest priority
 157     if ($current & PAREN) {
 158       if ($val eq "(") {
 159         $depth++;
 160         $self->_OpenParen;
 161
 162       } else {
 163         $depth--;
 164         $self->_CloseParen;
 165       }
 166
 167       $want = KEYWORD | PAREN | AGGREG;
 168     }
 169     elsif ( $current & AGGREG ) {
 170       $ea = $val;
 171       $want = KEYWORD | PAREN;
 172     }
 173     elsif ( $current & KEYWORD ) {
 174       $key = $val;
 175       $want = OP;
 176     }
 177     elsif ( $current & OP ) {
 178       $op = $val;
 179       $want = VALUE;
 180     }
 181     elsif ( $current & VALUE ) {
 182       $value = $val;
 183
 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) = "";
 189       }
 190       if ($val =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
 191         substr($val,0,1) = "";
 192         substr($val,-1,1) = "";
 193       }
 194       # Unescape escaped characters
 195       $key =~ s!\\(.)!$1!g;
 196       $val =~ s!\\(.)!$1!g;
 197       #    print "$ea Key=[$key] op=[$op]  val=[$val]\n";
 198
 199
 200    my $subkey;
 201    if ($key =~ /^(.+?)\.(.+)$/) {
 202      $key = $1;
 203      $subkey = $2;
 204    }
 205
 206       my $class;
 207       my ($stdkey) = grep { /^$key$/i } (keys %FIELDS);
 208       if ($stdkey && exists $FIELDS{$stdkey}) {
 209         $class = $FIELDS{$key}->[0];
 210         $key = $stdkey;
 211       }
 212    # no longer have a default, since CF's are now a real class, not fallthrough
 213    # fixme: "default class" is not Generic.
 214
 215
 216    die "Unknown field: $key" unless $class;
 217
 218       $self->{_sql_localdepth} = 0;
 219       die "No such dispatch method: $class"
 220         unless exists $dispatch{$class};
 221       my $sub = $dispatch{$class} || die;;
 222       $sub->(
 223              $self,
 224              $key,
 225              $op,
 226              $val,
 227              SUBCLAUSE =>  "",  # don't need anymore
 228              ENTRYAGGREGATOR => $ea || "",
 229              SUBKEY => $subkey,
 230             );
 231
 232       $self->{_sql_looking_at}{lc $key} = 1;
 233
 234       ($ea,$key,$op,$value) = ("","","","");
 235
 236       $want = PAREN | AGGREG;
 237     } else {
 238       die "I'm lost";
 239     }
 240
 241     $last = $current;
 242   } # while
 243
 244   die "Incomplete query"
 245     unless (($want | PAREN) || ($want | KEYWORD));
 246
 247   die "Incomplete Query"
 248     unless ($last && ($last | PAREN) || ($last || VALUE));
 249
 250   # This will never happen, because the parser will complain
 251   die "Mismatched parentheses"
 252     unless $depth == 0;
 253
 254 }
 255
 256
 257 =head2 ClausesToSQL
 258
 259 =cut
 260
 261 sub ClausesToSQL {
 262   my $self = shift;
 263   my $clauses = shift;
 264   my @sql;
 265
 266   for my $f (keys %{$clauses}) {
 267     my $sql;
 268     my $first = 1;
 269
 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] . "' ";
 276     }
 277
 278     push @sql, " ( " . $sql . " ) ";
 279   }
 280
 281   return join("AND",@sql);
 282 }
 283
 284 =head2 FromSQL
 285
 286 Convert a RT-SQL string into a set of SearchBuilder restrictions.
 287
 288 Returns (1, 'Status message') on success and (0, 'Error Message') on
 289 failure.
 290
 291 =cut
 292
 293 sub FromSQL {
 294   my ($self,$query) = @_;
 295
 296   $self->CleanSlate;
 297   $self->_InitSQL();
 298   return (1,"No Query") unless $query;
 299
 300   $self->{_sql_query} = $query;
 301   eval { $self->_parser( $query ); };
 302   $RT::Logger->error( $@ ) if $@;
 303   return(0,$@) if $@;
 304
 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',
 309                      OPERATOR        => '=',
 310                      QUOTEVALUE      => 0,
 311                      VALUE           => 'main.id'
 312     );    #TODO, we shouldn't be hard #coding the tablename to main.
 313     }
 314   # FIXME: Need to bring this logic back in
 315
 316   #      if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
 317   #         $self->SUPER::Limit( FIELD => 'EffectiveId',
 318   #               OPERATOR => '=',
 319   #               QUOTEVALUE => 0,
 320   #               VALUE => 'main.id');   #TODO, we shouldn't be hard coding the tablename to main.
 321   #       }
 322   # --- This is hardcoded above.  This comment block can probably go.
 323   # Or, we need to reimplement the looking_at_effective_id toggle.
 324
 325   # Unless we've explicitly asked to look at a specific Type, we need
 326   # to limit to it.
 327   unless ($self->{looking_at_type}) {
 328     $self->SUPER::Limit( FIELD => 'Type',
 329                          OPERATOR => '=',
 330                          VALUE => 'ticket');
 331   }
 332
 333   # set SB's dirty flag
 334   $self->{'must_redo_search'} = 1;
 335   $self->{'RecalcTicketLimits'} = 0;
 336
 337   return (1,"Good Query");
 338
 339 }
 340
 341
 342 1;
 343
 344 =pod
 345
 346 =head2 Exceptions
 347
 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
 351 trapped via evals.
 352
 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.
 356
 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.
 359
 360 =head2 General Flow
 361
 362 Legacy Layer:
 363
 364    Legacy LimitFoo routines build up a RestrictionsHash
 365
 366    _ProcessRestrictions converts the Restrictions to Clauses
 367    ([key,op,val,rest]).
 368
 369    Clauses are converted to RT-SQL (TicketSQL)
 370
 371 New RT-SQL Layer:
 372
 373    FromSQL calls the parser
 374
 375    The parser calls the _FooLimit routines to do DBIx::SearchBuilder
 376    limits.
 377
 378 And then the normal SearchBuilder/Ticket routines are used for
 379 display/navigation.
 380
 381 =cut
 382