import rt 3.6.4
[freeside.git] / rt / lib / RT / Tickets_Overlay_SQL.pm
index d78a56d..4531a16 100644 (file)
@@ -1,8 +1,14 @@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
 # 
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#  
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC 
+#                                          <jesse@bestpractical.com>
 # 
-# (Except where explictly superceded by other copyright notices)
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
 # 
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
 # 
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/copyleft/gpl.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
 # 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
 # 
-# END LICENSE BLOCK
+# END BPS TAGGED BLOCK }}}
+package RT::Tickets;
+
 use strict;
 use warnings;
 
 # Import configuration data from the lexcial scope of __PACKAGE__ (or
 # at least where those two Subroutines are defined.)
 
-my %FIELDS = %{FIELDS()};
+my %FIELD_METADATA = %{FIELDS()};
 my %dispatch = %{dispatch()};
+my %can_bundle = %{can_bundle()};
+
+# Lower Case version of FIELDS, for case insensitivity
+my %lcfields = map { ( lc($_) => $_ ) } (keys %FIELD_METADATA);
 
 sub _InitSQL {
   my $self = shift;
@@ -42,24 +72,46 @@ sub _InitSQL {
   $self->{'_sql_subclause'}     = "a";
   $self->{'_sql_first'}         = 0;
   $self->{'_sql_opstack'}       = [''];
+  $self->{'_sql_linkalias'}    = undef;
   $self->{'_sql_transalias'}    = undef;
   $self->{'_sql_trattachalias'} = undef;
-  $self->{'_sql_keywordalias'}  = undef;
+  $self->{'_sql_object_cf_alias'}  = undef;
   $self->{'_sql_depth'}         = 0;
   $self->{'_sql_localdepth'}    = 0;
   $self->{'_sql_query'}         = '';
   $self->{'_sql_looking_at'}    = {};
+  $self->{'_sql_columns_to_display'} = [];
 
 }
 
 sub _SQLLimit {
+  my $self = shift;
+    my %args = (@_);
+    if ($args{'FIELD'} eq 'EffectiveId' &&
+         (!$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) {
+        $self->{'looking_at_effective_id'} = 1;
+    }      
+    
+    if ($args{'FIELD'} eq 'Type' &&
+         (!$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) ) {
+        $self->{'looking_at_type'} = 1;
+    }
+
   # All SQL stuff goes into one SB subclause so we can deal with all
   # the aggregation
-  my $this = shift;
-  $this->SUPER::Limit(@_,
+  $self->SUPER::Limit(%args,
                       SUBCLAUSE => 'ticketsql');
 }
 
+sub _SQLJoin {
+  # All SQL stuff goes into one SB subclause so we can deal with all
+  # the aggregation
+  my $this = shift;
+
+  $this->SUPER::Join(@_,
+                    SUBCLAUSE => 'ticketsql');
+}
+
 # Helpers
 sub _OpenParen {
   $_[0]->SUPER::_OpenParen( 'ticketsql' );
@@ -72,14 +124,6 @@ sub _CloseParen {
 
 =cut
 
-sub _match {
-  # Case insensitive equality
-  my ($y,$x) = @_;
-  return 1 if $x =~ /^$y$/i;
-  #  return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
-  return 0;
-}
-
 =head2 Robert's Simple SQL Parser
 
 Documentation In Progress
@@ -109,41 +153,88 @@ use Regexp::Common qw /delimited/;
 use constant VALUE => 1;
 use constant AGGREG => 2;
 use constant OP => 4;
-use constant PAREN => 8;
-use constant KEYWORD => 16;
-my @tokens = qw[VALUE AGGREG OP PAREN KEYWORD];
+use constant OPEN_PAREN => 8;
+use constant CLOSE_PAREN => 16;
+use constant KEYWORD => 32;
+my @tokens = qw[VALUE AGGREG OP OPEN_PAREN CLOSE_PAREN KEYWORD];
 
 my $re_aggreg = qr[(?i:AND|OR)];
-my $re_value  = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
-my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
+my $re_delim  = qr[$RE{delimited}{-delim=>qq{\'\"}}];
+my $re_value  = qr[$re_delim|\d+|NULL];
+my $re_keyword = qr[$re_delim|(?:\{|\}|\w|\.)+];
 my $re_op     = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
-my $re_paren  = qr'\(|\)';
+my $re_open_paren  = qr'\(';
+my $re_close_paren  = qr'\)';
+
+sub _close_bundle
+{
+  my ($self, @bundle) = @_;
+  return unless @bundle;
+  if (@bundle == 1) {
+    $bundle[0]->{dispatch}->(
+                         $self,
+                         $bundle[0]->{key},
+                         $bundle[0]->{op},
+                         $bundle[0]->{val},
+                         SUBCLAUSE =>  "",
+                         ENTRYAGGREGATOR => $bundle[0]->{ea},
+                         SUBKEY => $bundle[0]->{subkey},
+                        );
+  } else {
+    my @args;
+    for my $chunk (@bundle) {
+      push @args, [
+          $chunk->{key},
+          $chunk->{op},
+          $chunk->{val},
+          SUBCLAUSE =>  "",
+          ENTRYAGGREGATOR => $chunk->{ea},
+          SUBKEY => $chunk->{subkey},
+      ];
+    }
+    $bundle[0]->{dispatch}->(
+        $self, \@args,
+    );
+  }
+}
 
 sub _parser {
   my ($self,$string) = @_;
-  my $want = KEYWORD | PAREN;
+  my $want = KEYWORD | OPEN_PAREN;
   my $last = undef;
 
   my $depth = 0;
+  my @bundle;
 
   my ($ea,$key,$op,$value) = ("","","","");
 
+  # order of matches in the RE is important.. op should come early,
+  # because it has spaces in it.  otherwise "NOT LIKE" might be parsed
+  # as a keyword or value.
+
+
+
+
+
   while ($string =~ /(
                       $re_aggreg
+                      |$re_op
                       |$re_keyword
                       |$re_value
-                      |$re_op
-                      |$re_paren
-                     )/igx ) {
+                      |$re_open_paren
+                      |$re_close_paren
+                     )/iogx ) {
     my $val = $1;
     my $current = 0;
 
     # Highest priority is last
-    $current = OP      if _match($re_op,$val);
-    $current = VALUE   if _match($re_value,$val);
-    $current = KEYWORD if _match($re_keyword,$val) && ($want & KEYWORD);
-    $current = AGGREG  if _match($re_aggreg,$val);
-    $current = PAREN   if _match($re_paren,$val);
+    $current = OP          if ($want & OP)          && $val =~ /^$re_op$/io;
+    $current = VALUE       if ($want & VALUE)       && $val =~ /^$re_value$/io;
+    $current = KEYWORD     if ($want & KEYWORD)     && $val =~ /^$re_keyword$/io;
+    $current = AGGREG      if ($want & AGGREG)      && $val =~ /^$re_aggreg$/io;
+    $current = OPEN_PAREN  if ($want & OPEN_PAREN)  && $val =~ /^$re_open_paren$/io;
+    $current = CLOSE_PAREN if ($want & CLOSE_PAREN) && $val =~ /^$re_close_paren$/io;
+
 
     unless ($current && $want & $current) {
       # Error
@@ -153,22 +244,26 @@ sub _parser {
 
     # State Machine:
 
+    #$RT::Logger->debug("We've just found a '$current' called '$val'");
+
     # Parens are highest priority
-    if ($current & PAREN) {
-      if ($val eq "(") {
-        $depth++;
-        $self->_OpenParen;
+    if ($current & OPEN_PAREN) {
+      $self->_close_bundle(@bundle);  @bundle = ();
+      $depth++;
+      $self->_OpenParen;
 
-      } else {
-        $depth--;
-        $self->_CloseParen;
-      }
+      $want = KEYWORD | OPEN_PAREN;
+    }
+    elsif ( $current & CLOSE_PAREN ) {
+      $self->_close_bundle(@bundle);  @bundle = ();
+      $depth--;
+      $self->_CloseParen;
 
-      $want = KEYWORD | PAREN | AGGREG;
+      $want = CLOSE_PAREN | AGGREG;
     }
     elsif ( $current & AGGREG ) {
       $ea = $val;
-      $want = KEYWORD | PAREN;
+      $want = KEYWORD | OPEN_PAREN;
     }
     elsif ( $current & KEYWORD ) {
       $key = $val;
@@ -183,31 +278,30 @@ sub _parser {
 
       # Remove surrounding quotes from $key, $val
       # (in future, simplify as for($key,$val) { action on $_ })
-      if ($key =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
+      if ($key =~ /$re_delim/o) {
         substr($key,0,1) = "";
         substr($key,-1,1) = "";
       }
-      if ($val =~ /$RE{delimited}{-delim=>qq{\'\"}}/) {
+      if ($val =~ /$re_delim/o) {
         substr($val,0,1) = "";
         substr($val,-1,1) = "";
       }
-      # Unescape escaped characters                                            
-      $key =~ s!\\(.)!$1!g;                                                    
-      $val =~ s!\\(.)!$1!g;     
+      # Unescape escaped characters
+      $key =~ s!\\(.)!$1!g;
+      $val =~ s!\\(.)!$1!g;
       #    print "$ea Key=[$key] op=[$op]  val=[$val]\n";
 
 
-   my $subkey;
+   my $subkey = '';
    if ($key =~ /^(.+?)\.(.+)$/) {
      $key = $1;
      $subkey = $2;
    }
 
       my $class;
-      my ($stdkey) = grep { /^$key$/i } (keys %FIELDS);
-      if ($stdkey && exists $FIELDS{$stdkey}) {
-        $class = $FIELDS{$key}->[0];
-        $key = $stdkey;
+      if (exists $lcfields{lc $key}) {
+        $key = $lcfields{lc $key};
+        $class = $FIELD_METADATA{$key}->[0];
       }
    # no longer have a default, since CF's are now a real class, not fallthrough
    # fixme: "default class" is not Generic.
@@ -219,21 +313,38 @@ sub _parser {
       die "No such dispatch method: $class"
         unless exists $dispatch{$class};
       my $sub = $dispatch{$class} || die;;
-      $sub->(
-             $self,
-             $key,
-             $op,
-             $val,
-             SUBCLAUSE =>  "",  # don't need anymore
-             ENTRYAGGREGATOR => $ea || "",
-             SUBKEY => $subkey,
-            );
+      if ($can_bundle{$class} &&
+          (!@bundle ||
+            ($bundle[-1]->{dispatch} == $sub &&
+             $bundle[-1]->{key} eq $key &&
+             $bundle[-1]->{subkey} eq $subkey)))
+      {
+          push @bundle, {
+              dispatch => $sub,
+              key      => $key,
+              op       => $op,
+              val      => $val,
+              ea       => $ea || "",
+              subkey   => $subkey,
+          };
+      } else {
+        $self->_close_bundle(@bundle);  @bundle = ();
+        $sub->(
+               $self,
+               $key,
+               $op,
+               $val,
+               SUBCLAUSE =>  "",  # don't need anymore
+               ENTRYAGGREGATOR => $ea || "",
+               SUBKEY => $subkey,
+              );
+      }
 
       $self->{_sql_looking_at}{lc $key} = 1;
-
+  
       ($ea,$key,$op,$value) = ("","","","");
-
-      $want = PAREN | AGGREG;
+  
+      $want = CLOSE_PAREN | AGGREG;
     } else {
       die "I'm lost";
     }
@@ -241,11 +352,13 @@ sub _parser {
     $last = $current;
   } # while
 
+  $self->_close_bundle(@bundle);  @bundle = ();
+
   die "Incomplete query"
-    unless (($want | PAREN) || ($want | KEYWORD));
+    unless (($want | CLOSE_PAREN) || ($want | KEYWORD));
 
   die "Incomplete Query"
-    unless ($last && ($last | PAREN) || ($last || VALUE));
+    unless ($last && ($last | CLOSE_PAREN) || ($last || VALUE));
 
   # This will never happen, because the parser will complain
   die "Mismatched parentheses"
@@ -268,11 +381,11 @@ sub ClausesToSQL {
     my $first = 1;
 
     # Build SQL from the data hash
-     for my $data ( @{ $clauses->{$f} } ) {
-      $sql .= $data->[0] unless $first; $first=0;
-      $sql .= " '". $data->[2] . "' ";
-      $sql .= $data->[3] . " ";
-      $sql .= "'". $data->[4] . "' ";
+    for my $data ( @{ $clauses->{$f} } ) {
+      $sql .= $data->[0] unless $first; $first=0; # ENTRYAGGREGATOR
+      $sql .= " '". $data->[2] . "' ";            # FIELD
+      $sql .= $data->[3] . " ";                   # OPERATOR
+      $sql .= "'". $data->[4] . "' ";             # VALUE
     }
 
     push @sql, " ( " . $sql . " ) ";
@@ -288,20 +401,94 @@ Convert a RT-SQL string into a set of SearchBuilder restrictions.
 Returns (1, 'Status message') on success and (0, 'Error Message') on
 failure.
 
+
+=begin testing
+
+use RT::Tickets;
+use strict;
+
+my $tix = RT::Tickets->new($RT::SystemUser);
+{
+    my $query = "Status = 'open'";
+    my ($status, $msg)  = $tix->FromSQL($query);
+    ok ($status, "correct query") or diag("error: $msg");
+}
+
+
+my (@created,%created);
+my $string = 'subject/content SQL test';
+{
+    my $t = RT::Ticket->new($RT::SystemUser);
+    ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
+    $created{ $t->Id }++; push @created, $t->Id;
+}
+
+{
+    my $Message = MIME::Entity->build(
+                     Subject     => 'this is my subject',
+                     From        => 'jesse@example.com',
+                     Data        => [ $string ],
+            );
+
+    my $t = RT::Ticket->new($RT::SystemUser);
+    ok( $t->Create( Queue => 'General',
+                    Subject => 'another ticket',
+                    MIMEObj => $Message,
+                    MemberOf => $created[0]
+                  ),
+        "Ticket Created"
+    );
+    $created{ $t->Id }++; push @created, $t->Id;
+}
+
+{
+    my $query = ("Subject LIKE '$string' OR Content LIKE '$string'");
+    my ($status, $msg) = $tix->FromSQL($query);
+    ok ($status, "correct query") or diag("error: $msg");
+
+    my $count = 0;
+    while (my $tick = $tix->Next) {
+        $count++ if $created{ $tick->id };
+    }
+    is ($count, scalar @created, "number of returned tickets same as entered");
+}
+
+{
+    my $query = "id = $created[0] OR MemberOf = $created[0]";
+    my ($status, $msg) = $tix->FromSQL($query);
+    ok ($status, "correct query") or diag("error: $msg");
+
+    my $count = 0;
+    while (my $tick = $tix->Next) {
+        $count++ if $created{ $tick->id };
+    }
+    is ($count, scalar @created, "number of returned tickets same as entered");
+}
+
+
+=end testing
+
+
 =cut
 
 sub FromSQL {
   my ($self,$query) = @_;
 
-  $self->CleanSlate;
+  {
+    # preserve first_row and show_rows across the CleanSlate
+    local($self->{'first_row'}, $self->{'show_rows'});
+    $self->CleanSlate;
+  }
   $self->_InitSQL();
-  return (1,"No Query") unless $query;
+
+  return (1,$self->loc("No Query")) unless $query;
 
   $self->{_sql_query} = $query;
   eval { $self->_parser( $query ); };
-  $RT::Logger->error( $@ ) if $@;
-  return(0,$@) if $@;
-
+    if ($@) {
+        $RT::Logger->error( "Query error in <<$query>>:\n$@" );
+        return(0,$@);
+    }
   # We only want to look at EffectiveId's (mostly) for these searches.
   unless (exists $self->{_sql_looking_at}{'effectiveid'}) {
   $self->SUPER::Limit( FIELD           => 'EffectiveId',
@@ -325,19 +512,37 @@ sub FromSQL {
   # Unless we've explicitly asked to look at a specific Type, we need
   # to limit to it.
   unless ($self->{looking_at_type}) {
-    $self->SUPER::Limit( FIELD => 'Type',
-                         OPERATOR => '=',
-                         VALUE => 'ticket');
+    $self->SUPER::Limit( FIELD => 'Type', OPERATOR => '=', VALUE => 'ticket');
   }
 
+  # We don't want deleted tickets unless 'allow_deleted_search' is set
+  unless( $self->{'allow_deleted_search'} ) {
+    $self->SUPER::Limit(FIELD => 'Status',
+                        OPERATOR => '!=',
+                        VALUE => 'deleted');
+  }
+
+
   # set SB's dirty flag
   $self->{'must_redo_search'} = 1;
   $self->{'RecalcTicketLimits'} = 0;                                           
 
-  return (1,"Good Query");
+  return (1,$self->loc("Valid Query"));
 
 }
 
+=head2 Query
+
+Returns the query that this object was initialized with
+
+=cut
+
+sub Query {
+    my $self = shift;
+    return ($self->{_sql_query}); 
+}
+
+
 
 1;