rt/lib/RT/Tickets_Overlay_SQL.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2007 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/copyleft/gpl.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
 295    my $subkey = '';
 296    if ($key =~ /^(.+?)\.(.+)$/) {
 297      $key = $1;
 298      $subkey = $2;
 299    }
 300
 301       my $class;
 302       if (exists $lcfields{lc $key}) {
 303         $key = $lcfields{lc $key};
 304         $class = $FIELD_METADATA{$key}->[0];
 305       }
 306    # no longer have a default, since CF's are now a real class, not fallthrough
 307    # fixme: "default class" is not Generic.
 308
 309
 310    die "Unknown field: $key" unless $class;
 311
 312       $self->{_sql_localdepth} = 0;
 313       die "No such dispatch method: $class"
 314         unless exists $dispatch{$class};
 315       my $sub = $dispatch{$class} || die;;
 316       if ($can_bundle{$class} &&
 317           (!@bundle ||
 318             ($bundle[-1]->{dispatch} == $sub &&
 319              $bundle[-1]->{key} eq $key &&
 320              $bundle[-1]->{subkey} eq $subkey)))
 321       {
 322           push @bundle, {
 323               dispatch => $sub,
 324               key      => $key,
 325               op       => $op,
 326               val      => $val,
 327               ea       => $ea || "",
 328               subkey   => $subkey,
 329           };
 330       } else {
 331         $self->_close_bundle(@bundle);  @bundle = ();
 332         $sub->(
 333                $self,
 334                $key,
 335                $op,
 336                $val,
 337                SUBCLAUSE =>  "",  # don't need anymore
 338                ENTRYAGGREGATOR => $ea || "",
 339                SUBKEY => $subkey,
 340               );
 341       }
 342
 343       $self->{_sql_looking_at}{lc $key} = 1;
 344
 345       ($ea,$key,$op,$value) = ("","","","");
 346
 347       $want = CLOSE_PAREN | AGGREG;
 348     } else {
 349       die "I'm lost";
 350     }
 351
 352     $last = $current;
 353   } # while
 354
 355   $self->_close_bundle(@bundle);  @bundle = ();
 356
 357   die "Incomplete query"
 358     unless (($want | CLOSE_PAREN) || ($want | KEYWORD));
 359
 360   die "Incomplete Query"
 361     unless ($last && ($last | CLOSE_PAREN) || ($last || VALUE));
 362
 363   # This will never happen, because the parser will complain
 364   die "Mismatched parentheses"
 365     unless $depth == 0;
 366
 367 }
 368
 369
 370 =head2 ClausesToSQL
 371
 372 =cut
 373
 374 sub ClausesToSQL {
 375   my $self = shift;
 376   my $clauses = shift;
 377   my @sql;
 378
 379   for my $f (keys %{$clauses}) {
 380     my $sql;
 381     my $first = 1;
 382
 383     # Build SQL from the data hash
 384     for my $data ( @{ $clauses->{$f} } ) {
 385       $sql .= $data->[0] unless $first; $first=0; # ENTRYAGGREGATOR
 386       $sql .= " '". $data->[2] . "' ";            # FIELD
 387       $sql .= $data->[3] . " ";                   # OPERATOR
 388       $sql .= "'". $data->[4] . "' ";             # VALUE
 389     }
 390
 391     push @sql, " ( " . $sql . " ) ";
 392   }
 393
 394   return join("AND",@sql);
 395 }
 396
 397 =head2 FromSQL
 398
 399 Convert a RT-SQL string into a set of SearchBuilder restrictions.
 400
 401 Returns (1, 'Status message') on success and (0, 'Error Message') on
 402 failure.
 403
 404
 405 =begin testing
 406
 407 use RT::Tickets;
 408 use strict;
 409
 410 my $tix = RT::Tickets->new($RT::SystemUser);
 411 {
 412     my $query = "Status = 'open'";
 413     my ($status, $msg)  = $tix->FromSQL($query);
 414     ok ($status, "correct query") or diag("error: $msg");
 415 }
 416
 417
 418 my (@created,%created);
 419 my $string = 'subject/content SQL test';
 420 {
 421     my $t = RT::Ticket->new($RT::SystemUser);
 422     ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
 423     $created{ $t->Id }++; push @created, $t->Id;
 424 }
 425
 426 {
 427     my $Message = MIME::Entity->build(
 428                      Subject     => 'this is my subject',
 429                      From        => 'jesse@example.com',
 430                      Data        => [ $string ],
 431             );
 432
 433     my $t = RT::Ticket->new($RT::SystemUser);
 434     ok( $t->Create( Queue => 'General',
 435                     Subject => 'another ticket',
 436                     MIMEObj => $Message,
 437                     MemberOf => $created[0]
 438                   ),
 439         "Ticket Created"
 440     );
 441     $created{ $t->Id }++; push @created, $t->Id;
 442 }
 443
 444 {
 445     my $query = ("Subject LIKE '$string' OR Content LIKE '$string'");
 446     my ($status, $msg) = $tix->FromSQL($query);
 447     ok ($status, "correct query") or diag("error: $msg");
 448
 449     my $count = 0;
 450     while (my $tick = $tix->Next) {
 451         $count++ if $created{ $tick->id };
 452     }
 453     is ($count, scalar @created, "number of returned tickets same as entered");
 454 }
 455
 456 {
 457     my $query = "id = $created[0] OR MemberOf = $created[0]";
 458     my ($status, $msg) = $tix->FromSQL($query);
 459     ok ($status, "correct query") or diag("error: $msg");
 460
 461     my $count = 0;
 462     while (my $tick = $tix->Next) {
 463         $count++ if $created{ $tick->id };
 464     }
 465     is ($count, scalar @created, "number of returned tickets same as entered");
 466 }
 467
 468
 469 =end testing
 470
 471
 472 =cut
 473
 474 sub FromSQL {
 475   my ($self,$query) = @_;
 476
 477   {
 478     # preserve first_row and show_rows across the CleanSlate
 479     local($self->{'first_row'}, $self->{'show_rows'});
 480     $self->CleanSlate;
 481   }
 482   $self->_InitSQL();
 483
 484   return (1,$self->loc("No Query")) unless $query;
 485
 486   $self->{_sql_query} = $query;
 487   eval { $self->_parser( $query ); };
 488     if ($@) {
 489         $RT::Logger->error( "Query error in <<$query>>:\n$@" );
 490         return(0,$@);
 491     }
 492   # We only want to look at EffectiveId's (mostly) for these searches.
 493   unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
 494   $self->SUPER::Limit( FIELD           => 'EffectiveId',
 495                      ENTRYAGGREGATOR => 'AND',
 496                      OPERATOR        => '=',
 497                      QUOTEVALUE      => 0,
 498                      VALUE           => 'main.id'
 499     );    #TODO, we shouldn't be hard #coding the tablename to main.
 500     }
 501   # FIXME: Need to bring this logic back in
 502
 503   #      if ($self->_isLimited && (! $self->{'looking_at_effective_id'})) {
 504   #         $self->SUPER::Limit( FIELD => 'EffectiveId',
 505   #               OPERATOR => '=',
 506   #               QUOTEVALUE => 0,
 507   #               VALUE => 'main.id');   #TODO, we shouldn't be hard coding the tablename to main.
 508   #       }
 509   # --- This is hardcoded above.  This comment block can probably go.
 510   # Or, we need to reimplement the looking_at_effective_id toggle.
 511
 512   # Unless we've explicitly asked to look at a specific Type, we need
 513   # to limit to it.
 514   unless ($self->{looking_at_type}) {
 515     $self->SUPER::Limit( FIELD => 'Type', OPERATOR => '=', VALUE => 'ticket');
 516   }
 517
 518   # We don't want deleted tickets unless 'allow_deleted_search' is set
 519   unless( $self->{'allow_deleted_search'} ) {
 520     $self->SUPER::Limit(FIELD => 'Status',
 521                         OPERATOR => '!=',
 522                         VALUE => 'deleted');
 523   }
 524
 525
 526   # set SB's dirty flag
 527   $self->{'must_redo_search'} = 1;
 528   $self->{'RecalcTicketLimits'} = 0;
 529
 530   return (1,$self->loc("Valid Query"));
 531
 532 }
 533
 534 =head2 Query
 535
 536 Returns the query that this object was initialized with
 537
 538 =cut
 539
 540 sub Query {
 541     my $self = shift;
 542     return ($self->{_sql_query});
 543 }
 544
 545
 546
 547 1;
 548
 549 =pod
 550
 551 =head2 Exceptions
 552
 553 Most of the RT code does not use Exceptions (die/eval) but it is used
 554 in the TicketSQL code for simplicity and historical reasons.  Lest you
 555 be worried that the dies will trigger user visible errors, all are
 556 trapped via evals.
 557
 558 99% of the dies fall in subroutines called via FromSQL and then parse.
 559 (This includes all of the _FooLimit routines in Tickets_Overlay.pm.)
 560 The other 1% or so are via _ProcessRestrictions.
 561
 562 All dies are trapped by eval {}s, and will be logged at the 'error'
 563 log level.  The general failure mode is to not display any tickets.
 564
 565 =head2 General Flow
 566
 567 Legacy Layer:
 568
 569    Legacy LimitFoo routines build up a RestrictionsHash
 570
 571    _ProcessRestrictions converts the Restrictions to Clauses
 572    ([key,op,val,rest]).
 573
 574    Clauses are converted to RT-SQL (TicketSQL)
 575
 576 New RT-SQL Layer:
 577
 578    FromSQL calls the parser
 579
 580    The parser calls the _FooLimit routines to do DBIx::SearchBuilder
 581    limits.
 582
 583 And then the normal SearchBuilder/Ticket routines are used for
 584 display/navigation.
 585
 586 =cut
 587