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          (!$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) {
  90         $self->{'looking_at_effective_id'} = 1;
  91     }
  92
  93     if ($args{'FIELD'} eq 'Type' &&
  94          (!$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) {
  95         $self->{'looking_at_type'} = 1;
  96     }
  97
  98   # All SQL stuff goes into one SB subclause so we can deal with all
  99   # the aggregation
 100   $self->SUPER::Limit(%args,
 101                       SUBCLAUSE => 'ticketsql');
 102 }
 103
 104 sub _SQLJoin {
 105   # All SQL stuff goes into one SB subclause so we can deal with all
 106   # the aggregation
 107   my $this = shift;
 108
 109   $this->SUPER::Join(@_,
 110                      SUBCLAUSE => 'ticketsql');
 111 }
 112
 113 # Helpers
 114 sub _OpenParen {
 115   $_[0]->SUPER::_OpenParen( 'ticketsql' );
 116 }
 117 sub _CloseParen {
 118   $_[0]->SUPER::_CloseParen( 'ticketsql' );
 119 }
 120
 121 =head1 SQL Functions
 122
 123 =cut
 124
 125 =head2 Robert's Simple SQL Parser
 126
 127 Documentation In Progress
 128
 129 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:
 130
 131   VALUE -> quoted string or number
 132   AGGREGator -> AND or OR
 133   KEYWORD -> quoted string or single word
 134   OPerator -> =,!=,LIKE,etc..
 135   PARENthesis -> open or close.
 136
 137 And that stream of tokens is passed through the "machine" in order to build up a structure that looks like:
 138
 139        KEY OP VALUE
 140   AND  KEY OP VALUE
 141   OR   KEY OP VALUE
 142
 143 That also deals with parenthesis for nesting.  (The parentheses are
 144 just handed off the SearchBuilder)
 145
 146 =cut
 147
 148 use Regexp::Common qw /delimited/;
 149
 150 # States
 151 use constant VALUE => 1;
 152 use constant AGGREG => 2;
 153 use constant OP => 4;
 154 use constant OPEN_PAREN => 8;
 155 use constant CLOSE_PAREN => 16;
 156 use constant KEYWORD => 32;
 157 my @tokens = qw[VALUE AGGREG OP OPEN_PAREN CLOSE_PAREN KEYWORD];
 158
 159 my $re_aggreg = qr[(?i:AND|OR)];
 160 my $re_delim  = qr[$RE{delimited}{-delim=>qq{\'\"}}];
 161 my $re_value  = qr[$re_delim|\d+|NULL];
 162 my $re_keyword = qr[$re_delim|(?:\{|\}|\w|\.)+];
 163 my $re_op     = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
 164 my $re_open_paren  = qr'\(';
 165 my $re_close_paren  = qr'\)';
 166
 167 sub _close_bundle
 168 {
 169   my ($self, @bundle) = @_;
 170   return unless @bundle;
 171   if (@bundle == 1) {
 172     $bundle[0]->{dispatch}->(
 173                          $self,
 174                          $bundle[0]->{key},
 175                          $bundle[0]->{op},
 176                          $bundle[0]->{val},
 177                          SUBCLAUSE =>  "",
 178                          ENTRYAGGREGATOR => $bundle[0]->{ea},
 179                          SUBKEY => $bundle[0]->{subkey},
 180                         );
 181   } else {
 182     my @args;
 183     for my $chunk (@bundle) {
 184       push @args, [
 185           $chunk->{key},
 186           $chunk->{op},
 187           $chunk->{val},
 188           SUBCLAUSE =>  "",
 189           ENTRYAGGREGATOR => $chunk->{ea},
 190           SUBKEY => $chunk->{subkey},
 191       ];
 192     }
 193     $bundle[0]->{dispatch}->(
 194         $self, \@args,
 195     );
 196   }
 197 }
 198
 199 sub _parser {
 200   my ($self,$string) = @_;
 201   my $want = KEYWORD | OPEN_PAREN;
 202   my $last = undef;
 203
 204   my $depth = 0;
 205   my @bundle;
 206
 207   my ($ea,$key,$op,$value) = ("","","","");
 208
 209   # order of matches in the RE is important.. op should come early,
 210   # because it has spaces in it.  otherwise "NOT LIKE" might be parsed
 211   # as a keyword or value.
 212
 213
 214
 215
 216
 217   while ($string =~ /(
 218                       $re_aggreg
 219                       |$re_op
 220                       |$re_keyword
 221                       |$re_value
 222                       |$re_open_paren
 223                       |$re_close_paren
 224                      )/iogx ) {
 225     my $val = $1;
 226     my $current = 0;
 227
 228     # Highest priority is last
 229     $current = OP          if ($want & OP)          && $val =~ /^$re_op$/io;
 230     $current = VALUE       if ($want & VALUE)       && $val =~ /^$re_value$/io;
 231     $current = KEYWORD     if ($want & KEYWORD)     && $val =~ /^$re_keyword$/io;
 232     $current = AGGREG      if ($want & AGGREG)      && $val =~ /^$re_aggreg$/io;
 233     $current = OPEN_PAREN  if ($want & OPEN_PAREN)  && $val =~ /^$re_open_paren$/io;
 234     $current = CLOSE_PAREN if ($want & CLOSE_PAREN) && $val =~ /^$re_close_paren$/io;
 235
 236
 237     unless ($current && $want & $current) {
 238       # Error
 239       # FIXME: I will only print out the highest $want value
 240       die "Error near ->$val<- expecting a ", $tokens[((log $want)/(log 2))], " in $string\n";
 241     }
 242
 243     # State Machine:
 244
 245     #$RT::Logger->debug("We've just found a '$current' called '$val'");
 246
 247     # Parens are highest priority
 248     if ($current & OPEN_PAREN) {
 249       $self->_close_bundle(@bundle);  @bundle = ();
 250       $depth++;
 251       $self->_OpenParen;
 252
 253       $want = KEYWORD | OPEN_PAREN;
 254     }
 255     elsif ( $current & CLOSE_PAREN ) {
 256       $self->_close_bundle(@bundle);  @bundle = ();
 257       $depth--;
 258       $self->_CloseParen;
 259
 260       $want = CLOSE_PAREN | AGGREG;
 261     }
 262     elsif ( $current & AGGREG ) {
 263       $ea = $val;
 264       $want = KEYWORD | OPEN_PAREN;
 265     }
 266     elsif ( $current & KEYWORD ) {
 267       $key = $val;
 268       $want = OP;
 269     }
 270     elsif ( $current & OP ) {
 271       $op = $val;
 272       $want = VALUE;
 273     }
 274     elsif ( $current & VALUE ) {
 275       $value = $val;
 276
 277       # Remove surrounding quotes from $key, $val
 278       # (in future, simplify as for($key,$val) { action on $_ })
 279       if ($key =~ /$re_delim/o) {
 280         substr($key,0,1) = "";
 281         substr($key,-1,1) = "";
 282       }
 283       if ($val =~ /$re_delim/o) {
 284         substr($val,0,1) = "";
 285         substr($val,-1,1) = "";
 286       }
 287       # Unescape escaped characters
 288       $key =~ s!\\(.)!$1!g;
 289       $val =~ s!\\(.)!$1!g;
 290       #    print "$ea Key=[$key] op=[$op]  val=[$val]\n";
 291
 292
 293    my $subkey = '';
 294    if ($key =~ /^(.+?)\.(.+)$/) {
 295      $key = $1;
 296      $subkey = $2;
 297    }
 298
 299       my $class;
 300       if (exists $lcfields{lc $key}) {
 301         $key = $lcfields{lc $key};
 302         $class = $FIELDS{$key}->[0];
 303       }
 304    # no longer have a default, since CF's are now a real class, not fallthrough
 305    # fixme: "default class" is not Generic.
 306
 307
 308    die "Unknown field: $key" unless $class;
 309
 310       $self->{_sql_localdepth} = 0;
 311       die "No such dispatch method: $class"
 312         unless exists $dispatch{$class};
 313       my $sub = $dispatch{$class} || die;;
 314       if ($can_bundle{$class} &&
 315           (!@bundle ||
 316             ($bundle[-1]->{dispatch} == $sub &&
 317              $bundle[-1]->{key} eq $key &&
 318              $bundle[-1]->{subkey} eq $subkey)))
 319       {
 320           push @bundle, {
 321               dispatch => $sub,
 322               key      => $key,
 323               op       => $op,
 324               val      => $val,
 325               ea       => $ea || "",
 326               subkey   => $subkey,
 327           };
 328       } else {
 329         $self->_close_bundle(@bundle);  @bundle = ();
 330         $sub->(
 331                $self,
 332                $key,
 333                $op,
 334                $val,
 335                SUBCLAUSE =>  "",  # don't need anymore
 336                ENTRYAGGREGATOR => $ea || "",
 337                SUBKEY => $subkey,
 338               );
 339       }
 340
 341       $self->{_sql_looking_at}{lc $key} = 1;
 342
 343       ($ea,$key,$op,$value) = ("","","","");
 344
 345       $want = CLOSE_PAREN | AGGREG;
 346     } else {
 347       die "I'm lost";
 348     }
 349
 350     $last = $current;
 351   } # while
 352
 353   $self->_close_bundle(@bundle);  @bundle = ();
 354
 355   die "Incomplete query"
 356     unless (($want | CLOSE_PAREN) || ($want | KEYWORD));
 357
 358   die "Incomplete Query"
 359     unless ($last && ($last | CLOSE_PAREN) || ($last || VALUE));
 360
 361   # This will never happen, because the parser will complain
 362   die "Mismatched parentheses"
 363     unless $depth == 0;
 364
 365 }
 366
 367
 368 =head2 ClausesToSQL
 369
 370 =cut
 371
 372 sub ClausesToSQL {
 373   my $self = shift;
 374   my $clauses = shift;
 375   my @sql;
 376
 377   for my $f (keys %{$clauses}) {
 378     my $sql;
 379     my $first = 1;
 380
 381     # Build SQL from the data hash
 382     for my $data ( @{ $clauses->{$f} } ) {
 383       $sql .= $data->[0] unless $first; $first=0; # ENTRYAGGREGATOR
 384       $sql .= " '". $data->[2] . "' ";            # FIELD
 385       $sql .= $data->[3] . " ";                   # OPERATOR
 386       $sql .= "'". $data->[4] . "' ";             # VALUE
 387     }
 388
 389     push @sql, " ( " . $sql . " ) ";
 390   }
 391
 392   return join("AND",@sql);
 393 }
 394
 395 =head2 FromSQL
 396
 397 Convert a RT-SQL string into a set of SearchBuilder restrictions.
 398
 399 Returns (1, 'Status message') on success and (0, 'Error Message') on
 400 failure.
 401
 402
 403 =begin testing
 404
 405 use RT::Tickets;
 406
 407
 408
 409 my $tix = RT::Tickets->new($RT::SystemUser);
 410
 411 my $query = "Status = 'open'";
 412 my ($id, $msg)  = $tix->FromSQL($query);
 413
 414 ok ($id, $msg);
 415
 416
 417 my (@ids, @expectedids);
 418
 419 my $t = RT::Ticket->new($RT::SystemUser);
 420
 421 my $string = 'subject/content SQL test';
 422 ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
 423
 424 push @ids, $t->Id;
 425
 426 my $Message = MIME::Entity->build(
 427                              Subject     => 'this is my subject',
 428                              From        => 'jesse@example.com',
 429                              Data        => [ $string ],
 430         );
 431
 432 ok( $t->Create(Queue => 'General', Subject => 'another ticket', MIMEObj => $Message, MemberOf => $ids[0]), "Ticket Created");
 433
 434 push @ids, $t->Id;
 435
 436 $query = ("Subject LIKE '$string' OR Content LIKE '$string'");
 437
 438 my ($id, $msg) = $tix->FromSQL($query);
 439
 440
 441 ok ($id, $msg);
 442
 443 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
 444 while (my $tick = $tix->Next) {
 445     push @expectedids, $tick->Id;
 446 }
 447 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
 448
 449 $query = ("id = $ids[0] OR MemberOf = $ids[0]");
 450
 451 my ($id, $msg) = $tix->FromSQL($query);
 452
 453 ok ($id, $msg);
 454
 455 is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
 456
 457 @expectedids = ();
 458 while (my $tick = $tix->Next) {
 459     push @expectedids, $tick->Id;
 460 }
 461
 462 ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
 463
 464 =end testing
 465
 466
 467 =cut
 468
 469 sub FromSQL {
 470   my ($self,$query) = @_;
 471
 472   {
 473     # preserve first_row and show_rows across the CleanSlate
 474     local($self->{'first_row'}, $self->{'show_rows'});
 475     $self->CleanSlate;
 476   }
 477   $self->_InitSQL();
 478
 479   return (1,$self->loc("No Query")) unless $query;
 480
 481   $self->{_sql_query} = $query;
 482   eval { $self->_parser( $query ); };
 483     if ($@) {
 484         $RT::Logger->error( "Query error in <<$query>>:\n$@" );
 485         return(0,$@);
 486     }
 487   # We only want to look at EffectiveId's (mostly) for these searches.
 488   unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
 489   $self->SUPER::Limit( FIELD           => 'EffectiveId',
 490                      ENTRYAGGREGATOR => 'AND',
 491                      OPERATOR        => '=',
 492                      QUOTEVALUE      => 0,
 493                      VALUE           => 'main.id'
 494     );    #TODO, we shouldn't be hard #coding the tablename to main.
 495     }
 496   # FIXME: Need to bring this logic back in
 497
 498   #      if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
 499   #         $self->SUPER::Limit( FIELD => 'EffectiveId',
 500   #               OPERATOR => '=',
 501   #               QUOTEVALUE => 0,
 502   #               VALUE => 'main.id');   #TODO, we shouldn't be hard coding the tablename to main.
 503   #       }
 504   # --- This is hardcoded above.  This comment block can probably go.
 505   # Or, we need to reimplement the looking_at_effective_id toggle.
 506
 507   # Unless we've explicitly asked to look at a specific Type, we need
 508   # to limit to it.
 509   unless ($self->{looking_at_type}) {
 510     $self->SUPER::Limit( FIELD => 'Type', OPERATOR => '=', VALUE => 'ticket');
 511   }
 512
 513   # We don't want deleted tickets unless 'allow_deleted_search' is set
 514   unless( $self->{'allow_deleted_search'} ) {
 515     $self->SUPER::Limit(FIELD => 'Status',
 516                         OPERATOR => '!=',
 517                         VALUE => 'deleted');
 518   }
 519
 520
 521   # set SB's dirty flag
 522   $self->{'must_redo_search'} = 1;
 523   $self->{'RecalcTicketLimits'} = 0;
 524
 525   return (1,$self->loc("Valid Query"));
 526
 527 }
 528
 529 =head2 Query
 530
 531 Returns the query that this object was initialized with
 532
 533 =cut
 534
 535 sub Query {
 536     my $self = shift;
 537     return ($self->{_sql_query});
 538 }
 539
 540
 541
 542 1;
 543
 544 =pod
 545
 546 =head2 Exceptions
 547
 548 Most of the RT code does not use Exceptions (die/eval) but it is used
 549 in the TicketSQL code for simplicity and historical reasons.  Lest you
 550 be worried that the dies will trigger user visible errors, all are
 551 trapped via evals.
 552
 553 99% of the dies fall in subroutines called via FromSQL and then parse.
 554 (This includes all of the _FooLimit routines in Tickets_Overlay.pm.)
 555 The other 1% or so are via _ProcessRestrictions.
 556
 557 All dies are trapped by eval {}s, and will be logged at the 'error'
 558 log level.  The general failure mode is to not display any tickets.
 559
 560 =head2 General Flow
 561
 562 Legacy Layer:
 563
 564    Legacy LimitFoo routines build up a RestrictionsHash
 565
 566    _ProcessRestrictions converts the Restrictions to Clauses
 567    ([key,op,val,rest]).
 568
 569    Clauses are converted to RT-SQL (TicketSQL)
 570
 571 New RT-SQL Layer:
 572
 573    FromSQL calls the parser
 574
 575    The parser calls the _FooLimit routines to do DBIx::SearchBuilder
 576    limits.
 577
 578 And then the normal SearchBuilder/Ticket routines are used for
 579 display/navigation.
 580
 581 =cut
 582