-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
#
+# CONTRIBUTION SUBMISSION POLICY:
#
-# END LICENSE BLOCK
+# (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 BPS TAGGED BLOCK }}}
+package RT::Tickets;
+
use strict;
use warnings;
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;
$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') {
+ $self->{'looking_at_effective_id'} = 1;
+ }
+
+ if ($args{'FIELD'} eq 'Type') {
+ $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' );
=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
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
# 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;
# 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 $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.
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";
}
$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"
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( "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',
# 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;
=pod