rt/lib/RT/Tickets_Overlay_SQL.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 #
  27 #
  28 # CONTRIBUTION SUBMISSION POLICY:
  29 #
  30 # (The following paragraph is not intended to limit the rights granted
  31 # to you to modify and distribute this software under the terms of
  32 # the GNU General Public License and is only of importance to you if
  33 # you choose to contribute your changes and enhancements to the
  34 # community by submitting them to Best Practical Solutions, LLC.)
  35 #
  36 # By intentionally submitting any modifications, corrections or
  37 # derivatives to this work, or any other work intended for use with
  38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  39 # you are the copyright holder for those contributions and you grant
  40 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  41 # royalty-free, perpetual, license to use, copy, create derivative
  42 # works based on those contributions, and sublicense and distribute
  43 # those contributions and any derivatives thereof.
  44 #
  45 # END BPS TAGGED BLOCK }}}
  46 package RT::Tickets;
  47
  48 use strict;
  49 use warnings;
  50
  51 # Import configuration data from the lexcial scope of __PACKAGE__ (or
  52 # at least where those two Subroutines are defined.)
  53
  54 my %FIELDS = %{FIELDS()};
  55 my %dispatch = %{dispatch()};
  56 my %can_bundle = %{can_bundle()};
  57
  58 # Lower Case version of FIELDS, for case insensitivity
  59 my %lcfields = map { ( lc($_) => $_ ) } (keys %FIELDS);
  60
  61 sub _InitSQL {
  62   my $self = shift;
  63
  64   # How many of these do we actually still use?
  65
  66   # Private Member Variales (which should get cleaned)
  67   $self->{'_sql_linksc'}        = 0;
  68   $self->{'_sql_watchersc'}     = 0;
  69   $self->{'_sql_keywordsc'}     = 0;
  70   $self->{'_sql_subclause'}     = "a";
  71   $self->{'_sql_first'}         = 0;
  72   $self->{'_sql_opstack'}       = [''];
  73   $self->{'_sql_linkalias'}    = undef;
  74   $self->{'_sql_transalias'}    = undef;
  75   $self->{'_sql_trattachalias'} = undef;
  76   $self->{'_sql_object_cf_alias'}  = undef;
  77   $self->{'_sql_depth'}         = 0;
  78   $self->{'_sql_localdepth'}    = 0;
  79   $self->{'_sql_query'}         = '';
  80   $self->{'_sql_looking_at'}    = {};
  81   $self->{'_sql_columns_to_display'} = [];
  82
  83 }
  84
  85 sub _SQLLimit {
  86   my $self = shift;
  87     my %args = (@_);
  88     if ($args{'FIELD'} eq 'EffectiveId') {
  89         $self->{'looking_at_effective_id'} = 1;
  90     }
  91
  92     if ($args{'FIELD'} eq 'Type') {
  93         $self->{'looking_at_type'} = 1;
  94     }
  95
  96   # All SQL stuff goes into one SB subclause so we can deal with all
  97   # the aggregation
  98   $self->SUPER::Limit(%args,
  99                       SUBCLAUSE => 'ticketsql');
 100 }
 101
 102 sub _SQLJoin {
 103   # All SQL stuff goes into one SB subclause so we can deal with all
 104   # the aggregation
 105   my $this = shift;
 106
 107   $this->SUPER::Join(@_,
 108                      SUBCLAUSE => 'ticketsql');
 109 }
 110
 111 # Helpers
 112 sub _OpenParen {
 113   $_[0]->SUPER::_OpenParen( 'ticketsql' );
 114 }
 115 sub _CloseParen {
 116   $_[0]->SUPER::_CloseParen( 'ticketsql' );
 117 }
 118
 119 =head1 SQL Functions
 120
 121 =cut
 122
 123 =head2 Robert's Simple SQL Parser
 124
 125 Documentation In Progress
 126
 127 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:
 128
 129   VALUE -> quoted string or number
 130   AGGREGator -> AND or OR
 131   KEYWORD -> quoted string or single word
 132   OPerator -> =,!=,LIKE,etc..
 133   PARENthesis -> open or close.
 134
 135 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
 136
 137        KEY OP VALUE
 138   AND  KEY OP VALUE
 139   OR   KEY OP VALUE
 140
 141 That also deals with parenthesis for nesting.  (The parentheses are
 142 just handed off the SearchBuilder)
 143
 144 =cut
 145
 146 use Regexp::Common qw /delimited/;
 147
 148 # States
 149 use constant VALUE => 1;
 150 use constant AGGREG => 2;
 151 use constant OP => 4;
 152 use constant OPEN_PAREN => 8;
 153 use constant CLOSE_PAREN => 16;
 154 use constant KEYWORD => 32;
 155 my @tokens = qw[VALUE AGGREG OP OPEN_PAREN CLOSE_PAREN KEYWORD];
 156
 157 my $re_aggreg = qr[(?i:AND|OR)];
 158 my $re_delim  = qr[$RE{delimited}{-delim=>qq{\'\"}}];
 159 my $re_value  = qr[$re_delim|\d+|NULL];
 160 my $re_keyword = qr[$re_delim|(?:\{|\}|\w|\.)+];
 161 my $re_op     = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
 162 my $re_open_paren  = qr'\(';
 163 my $re_close_paren  = qr'\)';
 164
 165 sub _close_bundle
 166 {
 167   my ($self, @bundle) = @_;
 168   return unless @bundle;
 169   if (@bundle == 1) {
 170     $bundle[0]->{dispatch}->(
 171                          $self,
 172                          $bundle[0]->{key},
 173                          $bundle[0]->{op},
 174                          $bundle[0]->{val},
 175                          SUBCLAUSE =>  "",
 176                          ENTRYAGGREGATOR => $bundle[0]->{ea},
 177                          SUBKEY => $bundle[0]->{subkey},
 178                         );
 179   } else {
 180     my @args;
 181     for my $chunk (@bundle) {
 182       push @args, [
 183           $chunk->{key},
 184           $chunk->{op},
 185           $chunk->{val},
 186           SUBCLAUSE =>  "",
 187           ENTRYAGGREGATOR => $chunk->{ea},
 188           SUBKEY => $chunk->{subkey},
 189       ];
 190     }
 191     $bundle[0]->{dispatch}->(
 192         $self, \@args,
 193     );
 194   }
 195 }
 196
 197 sub _parser {
 198   my ($self,$string) = @_;
 199   my $want = KEYWORD | OPEN_PAREN;
 200   my $last = undef;
 201
 202   my $depth = 0;
 203   my @bundle;
 204
 205   my ($ea,$key,$op,$value) = ("","","","");
 206
 207   # order of matches in the RE is important.. op should come early,
 208   # because it has spaces in it.  otherwise "NOT LIKE" might be parsed
 209   # as a keyword or value.
 210
 211
 212
 213
 214
 215   while ($string =~ /(
 216                       $re_aggreg
 217                       |$re_op
 218                       |$re_keyword
 219                       |$re_value
 220                       |$re_open_paren
 221                       |$re_close_paren
 222                      )/iogx ) {
 223     my $val = $1;
 224     my $current = 0;
 225
 226     # Highest priority is last
 227     $current = OP          if ($want & OP)          && $val =~ /^$re_op$/io;
 228     $current = VALUE       if ($want & VALUE)       && $val =~ /^$re_value$/io;
 229     $current = KEYWORD     if ($want & KEYWORD)     && $val =~ /^$re_keyword$/io;
 230     $current = AGGREG      if ($want & AGGREG)      && $val =~ /^$re_aggreg$/io;
 231     $current = OPEN_PAREN  if ($want & OPEN_PAREN)  && $val =~ /^$re_open_paren$/io;
 232     $current = CLOSE_PAREN if ($want & CLOSE_PAREN) && $val =~ /^$re_close_paren$/io;
 233
 234
 235     unless ($current && $want & $current) {
 236       # Error
 237       # FIXME: I will only print out the highest $want value
 238       die "Error near ->$val<- expecting a ", $tokens[((log $want)/(log 2))], " in $string\n";
 239     }
 240
 241     # State Machine:
 242
 243     #$RT::Logger->debug("We've just found a '$current' called '$val'");
 244
 245     # Parens are highest priority
 246     if ($current & OPEN_PAREN) {
 247       $self->_close_bundle(@bundle);  @bundle = ();
 248       $depth++;
 249       $self->_OpenParen;
 250
 251       $want = KEYWORD | OPEN_PAREN;
 252     }
 253     elsif ( $current & CLOSE_PAREN ) {
 254       $self->_close_bundle(@bundle);  @bundle = ();
 255       $depth--;
 256       $self->_CloseParen;
 257
 258       $want = CLOSE_PAREN | AGGREG;
 259     }
 260     elsif ( $current & AGGREG ) {
 261       $ea = $val;
 262       $want = KEYWORD | OPEN_PAREN;
 263     }
 264     elsif ( $current & KEYWORD ) {
 265       $key = $val;
 266       $want = OP;
 267     }
 268     elsif ( $current & OP ) {
 269       $op = $val;
 270       $want = VALUE;
 271     }
 272     elsif ( $current & VALUE ) {
 273       $value = $val;
 274
 275       # Remove surrounding quotes from $key, $val
 276       # (in future, simplify as for($key,$val) { action on $_ })
 277       if ($key =~ /$re_delim/o) {
 278         substr($key,0,1) = "";
 279         substr($key,-1,1) = "";
 280       }
 281       if ($val =~ /$re_delim/o) {
 282         substr($val,0,1) = "";
 283         substr($val,-1,1) = "";
 284       }
 285       # Unescape escaped characters
 286       $key =~ s!\\(.)!$1!g;
 287       $val =~ s!\\(.)!$1!g;
 288       #    print "$ea Key=[$key] op=[$op]  val=[$val]\n";
 289
 290
 291    my $subkey;
 292    if ($key =~ /^(.+?)\.(.+)$/) {
 293      $key = $1;
 294      $subkey = $2;
 295    }
 296
 297       my $class;
 298       if (exists $lcfields{lc $key}) {
 299         $key = $lcfields{lc $key};
 300         $class = $FIELDS{$key}->[0];
 301       }
 302    # no longer have a default, since CF's are now a real class, not fallthrough
 303    # fixme: "default class" is not Generic.
 304
 305
 306    die "Unknown field: $key" unless $class;
 307
 308       $self->{_sql_localdepth} = 0;
 309       die "No such dispatch method: $class"
 310         unless exists $dispatch{$class};
 311       my $sub = $dispatch{$class} || die;;
 312       if ($can_bundle{$class} &&
 313           (!@bundle ||
 314             ($bundle[-1]->{dispatch} == $sub &&
 315              $bundle[-1]->{key} eq $key &&
 316              $bundle[-1]->{subkey} eq $subkey)))
 317       {
 318           push @bundle, {
 319               dispatch => $sub,
 320               key      => $key,
 321               op       => $op,
 322               val      => $val,
 323               ea       => $ea || "",
 324               subkey   => $subkey,
 325           };
 326       } else {
 327         $self->_close_bundle(@bundle);  @bundle = ();
 328         $sub->(
 329                $self,
 330                $key,
 331                $op,
 332                $val,
 333                SUBCLAUSE =>  "",  # don't need anymore
 334                ENTRYAGGREGATOR => $ea || "",
 335                SUBKEY => $subkey,
 336               );
 337       }
 338
 339       $self->{_sql_looking_at}{lc $key} = 1;
 340
 341       ($ea,$key,$op,$value) = ("","","","");
 342
 343       $want = CLOSE_PAREN | AGGREG;
 344     } else {
 345       die "I'm lost";
 346     }
 347
 348     $last = $current;
 349   } # while
 350
 351   $self->_close_bundle(@bundle);  @bundle = ();
 352
 353   die "Incomplete query"
 354     unless (($want | CLOSE_PAREN) || ($want | KEYWORD));
 355
 356   die "Incomplete Query"
 357     unless ($last && ($last | CLOSE_PAREN) || ($last || VALUE));
 358
 359   # This will never happen, because the parser will complain
 360   die "Mismatched parentheses"
 361     unless $depth == 0;
 362
 363 }
 364
 365
 366 =head2 ClausesToSQL
 367
 368 =cut
 369
 370 sub ClausesToSQL {
 371   my $self = shift;
 372   my $clauses = shift;
 373   my @sql;
 374
 375   for my $f (keys %{$clauses}) {
 376     my $sql;
 377     my $first = 1;
 378
 379     # Build SQL from the data hash
 380      for my $data ( @{ $clauses->{$f} } ) {
 381       $sql .= $data->[0] unless $first; $first=0;
 382       $sql .= " '". $data->[2] . "' ";
 383       $sql .= $data->[3] . " ";
 384       $sql .= "'". $data->[4] . "' ";
 385     }
 386
 387     push @sql, " ( " . $sql . " ) ";
 388   }
 389
 390   return join("AND",@sql);
 391 }
 392
 393 =head2 FromSQL
 394
 395 Convert a RT-SQL string into a set of SearchBuilder restrictions.
 396
 397 Returns (1, 'Status message') on success and (0, 'Error Message') on
 398 failure.
 399
 400
 401 =begin testing
 402
 403 use RT::Tickets;
 404
 405
 406
 407 my $tix = RT::Tickets->new($RT::SystemUser);
 408
 409 my $query = "Status = 'open'";
 410 my ($id, $msg)  = $tix->FromSQL($query);
 411
 412 ok ($id, $msg);
 413
 414
 415 my (@ids, @expectedids);
 416
 417 my $t = RT::Ticket->new($RT::SystemUser);
 418
 419 my $string = 'subject/content SQL test';
 420 ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
 421
 422 push @ids, $t->Id;
 423
 424 my $Message = MIME::Entity->build(
 425                              Subject     => 'this is my subject',
 426                              From        => 'jesse@example.com',
 427                              Data        => [ $string ],
 428         );
 429
 430 ok( $t->Create(Queue => 'General', Subject => 'another ticket', MIMEObj => $Message, MemberOf => $ids[0]), "Ticket Created");
 431
 432 push @ids, $t->Id;
 433
 434 $query = ("Subject LIKE '$string' OR Content LIKE '$string'");
 435
 436 my ($id, $msg) = $tix->FromSQL($query);
 437
 438
 439 ok ($id, $msg);
 440
 441 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
 442 while (my $tick = $tix->Next) {
 443     push @expectedids, $tick->Id;
 444 }
 445 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
 446
 447 $query = ("id = $ids[0] OR MemberOf = $ids[0]");
 448
 449 my ($id, $msg) = $tix->FromSQL($query);
 450
 451 ok ($id, $msg);
 452
 453 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
 454
 455 @expectedids = ();
 456 while (my $tick = $tix->Next) {
 457     push @expectedids, $tick->Id;
 458 }
 459
 460 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
 461
 462 =end testing
 463
 464
 465 =cut
 466
 467 sub FromSQL {
 468   my ($self,$query) = @_;
 469
 470   {
 471     # preserve first_row and show_rows across the CleanSlate
 472     local($self->{'first_row'}, $self->{'show_rows'});
 473     $self->CleanSlate;
 474   }
 475   $self->_InitSQL();
 476
 477   return (1,$self->loc("No Query")) unless $query;
 478
 479   $self->{_sql_query} = $query;
 480   eval { $self->_parser( $query ); };
 481     if ($@) {
 482         $RT::Logger->error( "Query error in <<$query>>:\n$@" );
 483         return(0,$@);
 484     }
 485   # We only want to look at EffectiveId's (mostly) for these searches.
 486   unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
 487   $self->SUPER::Limit( FIELD           => 'EffectiveId',
 488                      ENTRYAGGREGATOR => 'AND',
 489                      OPERATOR        => '=',
 490                      QUOTEVALUE      => 0,
 491                      VALUE           => 'main.id'
 492     );    #TODO, we shouldn't be hard #coding the tablename to main.
 493     }
 494   # FIXME: Need to bring this logic back in
 495
 496   #      if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
 497   #         $self->SUPER::Limit( FIELD => 'EffectiveId',
 498   #               OPERATOR => '=',
 499   #               QUOTEVALUE => 0,
 500   #               VALUE => 'main.id');   #TODO, we shouldn't be hard coding the tablename to main.
 501   #       }
 502   # --- This is hardcoded above.  This comment block can probably go.
 503   # Or, we need to reimplement the looking_at_effective_id toggle.
 504
 505   # Unless we've explicitly asked to look at a specific Type, we need
 506   # to limit to it.
 507   unless ($self->{looking_at_type}) {
 508     $self->SUPER::Limit( FIELD => 'Type', OPERATOR => '=', VALUE => 'ticket');
 509   }
 510
 511   # We don't want deleted tickets unless 'allow_deleted_search' is set
 512   unless( $self->{'allow_deleted_search'} ) {
 513     $self->SUPER::Limit(FIELD => 'Status',
 514                         OPERATOR => '!=',
 515                         VALUE => 'deleted');
 516   }
 517
 518
 519   # set SB's dirty flag
 520   $self->{'must_redo_search'} = 1;
 521   $self->{'RecalcTicketLimits'} = 0;
 522
 523   return (1,$self->loc("Valid Query"));
 524
 525 }
 526
 527 =head2 Query
 528
 529 Returns the query that this object was initialized with
 530
 531 =cut
 532
 533 sub Query {
 534     my $self = shift;
 535     return ($self->{_sql_query});
 536 }
 537
 538
 539
 540 1;
 541
 542 =pod
 543
 544 =head2 Exceptions
 545
 546 Most of the RT code does not use Exceptions (die/eval) but it is used
 547 in the TicketSQL code for simplicity and historical reasons.  Lest you
 548 be worried that the dies will trigger user visible errors, all are
 549 trapped via evals.
 550
 551 99% of the dies fall in subroutines called via FromSQL and then parse.
 552 (This includes all of the _FooLimit routines in Tickets_Overlay.pm.)
 553 The other 1% or so are via _ProcessRestrictions.
 554
 555 All dies are trapped by eval {}s, and will be logged at the 'error'
 556 log level.  The general failure mode is to not display any tickets.
 557
 558 =head2 General Flow
 559
 560 Legacy Layer:
 561
 562    Legacy LimitFoo routines build up a RestrictionsHash
 563
 564    _ProcessRestrictions converts the Restrictions to Clauses
 565    ([key,op,val,rest]).
 566
 567    Clauses are converted to RT-SQL (TicketSQL)
 568
 569 New RT-SQL Layer:
 570
 571    FromSQL calls the parser
 572
 573    The parser calls the _FooLimit routines to do DBIx::SearchBuilder
 574    limits.
 575
 576 And then the normal SearchBuilder/Ticket routines are used for
 577 display/navigation.
 578
 579 =cut
 580