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 use RT::Tickets;
  28
  29 # Import configuration data from the lexcial scope of __PACKAGE__ (or
  30 # at least where those two Subroutines are defined.)
  31
  32 my %FIELDS = %{FIELDS()};
  33 my %dispatch = %{dispatch()};
  34 my %can_bundle = %{can_bundle()};
  35
  36 # Lower Case version of FIELDS, for case insensitivity
  37 my %lcfields = map { ( lc($_) => $_ ) } (keys %FIELDS);
  38
  39 sub _InitSQL {
  40   my $self = shift;
  41
  42   # How many of these do we actually still use?
  43
  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'} = [];
  60
  61 }
  62
  63 sub _SQLLimit {
  64   # All SQL stuff goes into one SB subclause so we can deal with all
  65   # the aggregation
  66   my $this = shift;
  67
  68   $this->SUPER::Limit(@_,
  69                       SUBCLAUSE => 'ticketsql');
  70 }
  71
  72 sub _SQLJoin {
  73   # All SQL stuff goes into one SB subclause so we can deal with all
  74   # the aggregation
  75   my $this = shift;
  76
  77   $this->SUPER::Join(@_,
  78                      SUBCLAUSE => 'ticketsql');
  79 }
  80
  81 # Helpers
  82 sub _OpenParen {
  83   $_[0]->SUPER::_OpenParen( 'ticketsql' );
  84 }
  85 sub _CloseParen {
  86   $_[0]->SUPER::_CloseParen( 'ticketsql' );
  87 }
  88
  89 =head1 SQL Functions
  90
  91 =cut
  92
  93 sub _match {
  94   # Case insensitive equality
  95   my ($y,$x) = @_;
  96   return 1 if $x =~ /^$y$/i;
  97   #  return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
  98   return 0;
  99 }
 100
 101 =head2 Robert's Simple SQL Parser
 102
 103 Documentation In Progress
 104
 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:
 106
 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.
 112
 113 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
 114
 115        KEY OP VALUE
 116   AND  KEY OP VALUE
 117   OR   KEY OP VALUE
 118
 119 That also deals with parenthesis for nesting.  (The parentheses are
 120 just handed off the SearchBuilder)
 121
 122 =cut
 123
 124 use Regexp::Common qw /delimited/;
 125
 126 # States
 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];
 133
 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'\(|\)';
 139
 140 sub _close_bundle
 141 {
 142   my ($self, @bundle) = @_;
 143   return unless @bundle;
 144   if (@bundle == 1) {
 145     $bundle[0]->{dispatch}->(
 146                          $self,
 147                          $bundle[0]->{key},
 148                          $bundle[0]->{op},
 149                          $bundle[0]->{val},
 150                          SUBCLAUSE =>  "",
 151                          ENTRYAGGREGATOR => $bundle[0]->{ea},
 152                          SUBKEY => $bundle[0]->{subkey},
 153                         );
 154   } else {
 155     my @args;
 156     for my $chunk (@bundle) {
 157       push @args, [
 158           $chunk->{key},
 159           $chunk->{op},
 160           $chunk->{val},
 161           SUBCLAUSE =>  "",
 162           ENTRYAGGREGATOR => $chunk->{ea},
 163           SUBKEY => $chunk->{subkey},
 164       ];
 165     }
 166     $bundle[0]->{dispatch}->(
 167         $self, \@args,
 168     );
 169   }
 170 }
 171
 172 sub _parser {
 173   my ($self,$string) = @_;
 174   my $want = KEYWORD | PAREN;
 175   my $last = undef;
 176
 177   my $depth = 0;
 178   my @bundle;
 179
 180   my ($ea,$key,$op,$value) = ("","","","");
 181
 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.
 185
 186
 187
 188
 189
 190   while ($string =~ /(
 191                       $re_aggreg
 192                       |$re_op
 193                       |$re_keyword
 194                       |$re_value
 195                       |$re_paren
 196                      )/igx ) {
 197     my $val = $1;
 198     my $current = 0;
 199
 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);
 206
 207
 208     unless ($current && $want & $current) {
 209       # Error
 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";
 212     }
 213
 214     # State Machine:
 215
 216     #$RT::Logger->debug("We've just found a '$current' called '$val'");
 217
 218     # Parens are highest priority
 219     if ($current & PAREN) {
 220       if ($val eq "(") {
 221         $self->_close_bundle(@bundle);  @bundle = ();
 222         $depth++;
 223         $self->_OpenParen;
 224
 225       } else {
 226         $self->_close_bundle(@bundle);  @bundle = ();
 227         $depth--;
 228         $self->_CloseParen;
 229       }
 230
 231       $want = KEYWORD | PAREN | AGGREG;
 232     }
 233
 234     elsif ( $current & AGGREG ) {
 235       $ea = $val;
 236       $want = KEYWORD | PAREN;
 237     }
 238     elsif ( $current & KEYWORD ) {
 239       $key = $val;
 240       $want = OP;
 241     }
 242     elsif ( $current & OP ) {
 243       $op = $val;
 244       $want = VALUE;
 245     }
 246     elsif ( $current & VALUE ) {
 247       $value = $val;
 248
 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) = "";
 254       }
 255       if ($val =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
 256         substr($val,0,1) = "";
 257         substr($val,-1,1) = "";
 258       }
 259       # Unescape escaped characters
 260       $key =~ s!\\(.)!$1!g;
 261       $val =~ s!\\(.)!$1!g;
 262       #    print "$ea Key=[$key] op=[$op]  val=[$val]\n";
 263
 264
 265    my $subkey;
 266    if ($key =~ /^(.+?)\.(.+)$/) {
 267      $key = $1;
 268      $subkey = $2;
 269    }
 270
 271       my $class;
 272       if (exists $lcfields{lc $key}) {
 273         $key = $lcfields{lc $key};
 274         $class = $FIELDS{$key}->[0];
 275       }
 276    # no longer have a default, since CF's are now a real class, not fallthrough
 277    # fixme: "default class" is not Generic.
 278
 279
 280    die "Unknown field: $key" unless $class;
 281
 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} &&
 287           (!@bundle ||
 288             ($bundle[-1]->{dispatch} == $sub &&
 289              $bundle[-1]->{key} eq $key &&
 290              $bundle[-1]->{subkey} eq $subkey)))
 291       {
 292           push @bundle, {
 293               dispatch => $sub,
 294               key      => $key,
 295               op       => $op,
 296               val      => $val,
 297               ea       => $ea || "",
 298               subkey   => $subkey,
 299           };
 300       } else {
 301         $self->_close_bundle(@bundle);  @bundle = ();
 302         $sub->(
 303                $self,
 304                $key,
 305                $op,
 306                $val,
 307                SUBCLAUSE =>  "",  # don't need anymore
 308                ENTRYAGGREGATOR => $ea || "",
 309                SUBKEY => $subkey,
 310               );
 311       }
 312
 313       $self->{_sql_looking_at}{lc $key} = 1;
 314
 315       ($ea,$key,$op,$value) = ("","","","");
 316
 317       $want = PAREN | AGGREG;
 318     } else {
 319       die "I'm lost";
 320     }
 321
 322     $last = $current;
 323   } # while
 324
 325   $self->_close_bundle(@bundle);  @bundle = ();
 326
 327   die "Incomplete query"
 328     unless (($want | PAREN) || ($want | KEYWORD));
 329
 330   die "Incomplete Query"
 331     unless ($last && ($last | PAREN) || ($last || VALUE));
 332
 333   # This will never happen, because the parser will complain
 334   die "Mismatched parentheses"
 335     unless $depth == 0;
 336
 337 }
 338
 339
 340 =head2 ClausesToSQL
 341
 342 =cut
 343
 344 sub ClausesToSQL {
 345   my $self = shift;
 346   my $clauses = shift;
 347   my @sql;
 348
 349   for my $f (keys %{$clauses}) {
 350     my $sql;
 351     my $first = 1;
 352
 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] . "' ";
 359     }
 360
 361     push @sql, " ( " . $sql . " ) ";
 362   }
 363
 364   return join("AND",@sql);
 365 }
 366
 367 =head2 FromSQL
 368
 369 Convert a RT-SQL string into a set of SearchBuilder restrictions.
 370
 371 Returns (1, 'Status message') on success and (0, 'Error Message') on
 372 failure.
 373
 374
 375 =begin testing
 376
 377 use RT::Tickets;
 378
 379
 380
 381 my $tix = RT::Tickets->new($RT::SystemUser);
 382
 383 my $query = "Status = 'open'";
 384 my ($id, $msg)  = $tix->FromSQL($query);
 385
 386 ok ($id, $msg);
 387
 388
 389 my (@ids, @expectedids);
 390
 391 my $t = RT::Ticket->new($RT::SystemUser);
 392
 393 my $string = 'subject/content SQL test';
 394 ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
 395
 396 push @ids, $t->Id;
 397
 398 my $Message = MIME::Entity->build(
 399                              Subject     => 'this is my subject',
 400                              From        => 'jesse@example.com',
 401                              Data        => [ $string ],
 402         );
 403
 404 ok( $t->Create(Queue => 'General', Subject => 'another ticket', MIMEObj => $Message, MemberOf => $ids[0]), "Ticket Created");
 405
 406 push @ids, $t->Id;
 407
 408 $query = ("Subject LIKE '$string' OR Content LIKE '$string'");
 409
 410 my ($id, $msg) = $tix->FromSQL($query);
 411
 412 ok ($id, $msg);
 413
 414 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
 415
 416 while (my $tick = $tix->Next) {
 417     push @expectedids, $tick->Id;
 418 }
 419
 420 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
 421
 422 $query = ("id = $ids[0] OR MemberOf = $ids[0]");
 423
 424 my ($id, $msg) = $tix->FromSQL($query);
 425
 426 ok ($id, $msg);
 427
 428 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
 429
 430 @expectedids = ();
 431 while (my $tick = $tix->Next) {
 432     push @expectedids, $tick->Id;
 433 }
 434
 435 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
 436
 437 =end testing
 438
 439
 440 =cut
 441
 442 sub FromSQL {
 443   my ($self,$query) = @_;
 444
 445   $self->CleanSlate;
 446   {
 447     # preserve first_row and show_rows across the CleanSlate
 448     local($self->{'first_row'}, $self->{'show_rows'});
 449     $self->CleanSlate;
 450   }
 451   $self->_InitSQL();
 452
 453   return (1,$self->loc("No Query")) unless $query;
 454
 455   $self->{_sql_query} = $query;
 456   eval { $self->_parser( $query ); };
 457     if ($@) {
 458         $RT::Logger->error( $@ );
 459         return(0,$@);
 460     }
 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',
 465                      OPERATOR        => '=',
 466                      QUOTEVALUE      => 0,
 467                      VALUE           => 'main.id'
 468     );    #TODO, we shouldn't be hard #coding the tablename to main.
 469     }
 470   # FIXME: Need to bring this logic back in
 471
 472   #      if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
 473   #         $self->SUPER::Limit( FIELD => 'EffectiveId',
 474   #               OPERATOR => '=',
 475   #               QUOTEVALUE => 0,
 476   #               VALUE => 'main.id');   #TODO, we shouldn't be hard coding the tablename to main.
 477   #       }
 478   # --- This is hardcoded above.  This comment block can probably go.
 479   # Or, we need to reimplement the looking_at_effective_id toggle.
 480
 481   # Unless we've explicitly asked to look at a specific Type, we need
 482   # to limit to it.
 483   unless ($self->{looking_at_type}) {
 484     $self->SUPER::Limit( FIELD => 'Type', OPERATOR => '=', VALUE => 'ticket');
 485   }
 486
 487   # We never ever want to show deleted tickets
 488   $self->SUPER::Limit(FIELD => 'Status' , OPERATOR => '!=', VALUE => 'deleted');
 489
 490
 491   # set SB's dirty flag
 492   $self->{'must_redo_search'} = 1;
 493   $self->{'RecalcTicketLimits'} = 0;
 494
 495   return (1,$self->loc("Valid Query"));
 496
 497 }
 498
 499 =head2 Query
 500
 501 Returns the query that this object was initialized with
 502
 503 =cut
 504
 505 sub Query {
 506     my $self = shift;
 507     return ($self->{_sql_query});
 508 }
 509
 510
 511
 512 1;
 513
 514 =pod
 515
 516 =head2 Exceptions
 517
 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
 521 trapped via evals.
 522
 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.
 526
 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.
 529
 530 =head2 General Flow
 531
 532 Legacy Layer:
 533
 534    Legacy LimitFoo routines build up a RestrictionsHash
 535
 536    _ProcessRestrictions converts the Restrictions to Clauses
 537    ([key,op,val,rest]).
 538
 539    Clauses are converted to RT-SQL (TicketSQL)
 540
 541 New RT-SQL Layer:
 542
 543    FromSQL calls the parser
 544
 545    The parser calls the _FooLimit routines to do DBIx::SearchBuilder
 546    limits.
 547
 548 And then the normal SearchBuilder/Ticket routines are used for
 549 display/navigation.
 550
 551 =cut
 552