second big RT integration checkin, customer linking/delinking interface
[freeside.git] / rt / lib / RT / Tickets_Overlay_SQL.pm
index d78a56d..4ba19e6 100644 (file)
 use strict;
 use warnings;
 
+use RT::Tickets;
+
 # Import configuration data from the lexcial scope of __PACKAGE__ (or
 # at least where those two Subroutines are defined.)
 
 my %FIELDS = %{FIELDS()};
 my %dispatch = %{dispatch()};
+my %can_bundle = %{can_bundle()};
+
+# Lower Case version of FIELDS, for case insensitivity
+my %lcfields = map { ( lc($_) => $_ ) } (keys %FIELDS);
 
 sub _InitSQL {
   my $self = shift;
@@ -42,6 +48,7 @@ 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;
@@ -49,6 +56,7 @@ sub _InitSQL {
   $self->{'_sql_localdepth'}    = 0;
   $self->{'_sql_query'}         = '';
   $self->{'_sql_looking_at'}    = {};
+  $self->{'_sql_columns_to_display'} = [];
 
 }
 
@@ -56,10 +64,20 @@ sub _SQLLimit {
   # All SQL stuff goes into one SB subclause so we can deal with all
   # the aggregation
   my $this = shift;
+
   $this->SUPER::Limit(@_,
                       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' );
@@ -119,32 +137,74 @@ my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
 my $re_op     = qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]; # long to short
 my $re_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 $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 ) {
     my $val = $1;
     my $current = 0;
 
     # Highest priority is last
-    $current = OP      if _match($re_op,$val);
+    $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);
 
+
     unless ($current && $want & $current) {
       # Error
       # FIXME: I will only print out the highest $want value
@@ -153,19 +213,24 @@ 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 "(") {
+        $self->_close_bundle(@bundle);  @bundle = ();
         $depth++;
         $self->_OpenParen;
 
       } else {
+        $self->_close_bundle(@bundle);  @bundle = ();
         $depth--;
         $self->_CloseParen;
       }
 
       $want = KEYWORD | PAREN | AGGREG;
     }
+
     elsif ( $current & AGGREG ) {
       $ea = $val;
       $want = KEYWORD | PAREN;
@@ -191,7 +256,7 @@ sub _parser {
         substr($val,0,1) = "";
         substr($val,-1,1) = "";
       }
-      # Unescape escaped characters                                            
+      # Unescape escaped characters
       $key =~ s!\\(.)!$1!g;                                                    
       $val =~ s!\\(.)!$1!g;     
       #    print "$ea Key=[$key] op=[$op]  val=[$val]\n";
@@ -204,10 +269,9 @@ sub _parser {
    }
 
       my $class;
-      my ($stdkey) = grep { /^$key$/i } (keys %FIELDS);
-      if ($stdkey && exists $FIELDS{$stdkey}) {
+      if (exists $lcfields{lc $key}) {
+        $key = $lcfields{lc $key};
         $class = $FIELDS{$key}->[0];
-        $key = $stdkey;
       }
    # no longer have a default, since CF's are now a real class, not fallthrough
    # fixme: "default class" is not Generic.
@@ -219,20 +283,37 @@ 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;
     } else {
       die "I'm lost";
@@ -241,6 +322,8 @@ sub _parser {
     $last = $current;
   } # while
 
+  $self->_close_bundle(@bundle);  @bundle = ();
+
   die "Incomplete query"
     unless (($want | PAREN) || ($want | KEYWORD));
 
@@ -288,20 +371,93 @@ 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;
+
+
+
+my $tix = RT::Tickets->new($RT::SystemUser);
+
+my $query = "Status = 'open'";
+my ($id, $msg)  = $tix->FromSQL($query);
+
+ok ($id, $msg);
+
+
+my (@ids, @expectedids);
+
+my $t = RT::Ticket->new($RT::SystemUser);
+
+my $string = 'subject/content SQL test';
+ok( $t->Create(Queue => 'General', Subject => $string), "Ticket Created");
+
+push @ids, $t->Id;
+
+my $Message = MIME::Entity->build(
+                            Subject     => 'this is my subject',
+                            From        => 'jesse@example.com',
+                            Data        => [ $string ],
+        );
+
+ok( $t->Create(Queue => 'General', Subject => 'another ticket', MIMEObj => $Message, MemberOf => $ids[0]), "Ticket Created");
+
+push @ids, $t->Id;
+
+$query = ("Subject LIKE '$string' OR Content LIKE '$string'");
+
+my ($id, $msg) = $tix->FromSQL($query);
+
+ok ($id, $msg);
+
+is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
+
+while (my $tick = $tix->Next) {
+    push @expectedids, $tick->Id;
+}
+
+ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
+
+$query = ("id = $ids[0] OR MemberOf = $ids[0]");
+
+my ($id, $msg) = $tix->FromSQL($query);
+
+ok ($id, $msg);
+
+is ($tix->Count, scalar @ids, "number of returned tickets same as entered");
+
+@expectedids = ();
+while (my $tick = $tix->Next) {
+    push @expectedids, $tick->Id;
+}
+
+ok (eq_array(\@ids, \@expectedids), "returned expected tickets");
+
+=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( $@ );
+        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 +481,33 @@ 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 never ever want to show deleted tickets
+  $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;