rt/lib/RT/Tickets_Overlay_SQL.pm

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