rt/lib/RT/Tickets_Overlay_SQL.pm

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