[Rt-commit] r5618 - in rt/branches/3.6-RELEASE: . html/Search
html/Search/Elements
jesse at bestpractical.com
jesse at bestpractical.com
Wed Jul 19 20:45:37 EDT 2006
Author: jesse
Date: Wed Jul 19 20:45:36 2006
New Revision: 5618
Modified:
rt/branches/3.6-RELEASE/ (props changed)
rt/branches/3.6-RELEASE/html/Search/Chart
rt/branches/3.6-RELEASE/html/Search/Elements/Chart
rt/branches/3.6-RELEASE/html/Search/Elements/SelectGroupBy
rt/branches/3.6-RELEASE/html/Search/Results.html
rt/branches/3.6-RELEASE/lib/RT/Report/Tickets.pm
Log:
r14219 at pinglin: jesse | 2006-07-19 17:45:03 -0700
* Backport the ability to chart by custom field from RT 3.7
Modified: rt/branches/3.6-RELEASE/html/Search/Chart
==============================================================================
--- rt/branches/3.6-RELEASE/html/Search/Chart (original)
+++ rt/branches/3.6-RELEASE/html/Search/Chart Wed Jul 19 20:45:36 2006
@@ -1,48 +1,3 @@
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2006 Best Practical Solutions, LLC
-%# <jesse at bestpractical.com>
-%#
-%# (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
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# 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:
-%#
-%# (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 }}}
<%args>
$Query => "id > 0"
$PrimaryGroupBy => 'Queue'
@@ -52,84 +7,88 @@
<%init>
my @keys;
my @values;
-my $chart_class;
+my $chart_class;
use GD;
use GD::Text;
if ($ChartStyle eq 'pie') {
require GD::Graph::pie;
- $chart_class= "GD::Graph::pie";
+ $chart_class = "GD::Graph::pie";
} else {
require GD::Graph::bars;
- $chart_class= "GD::Graph::bars";
+ $chart_class = "GD::Graph::bars";
}
+
use RT::Report::Tickets;
+my $tix = RT::Report::Tickets->new( $session{'CurrentUser'} );
+$tix->FromSQL( $Query );
+my $count_name = $tix->Column( FUNCTION => 'COUNT', FIELD => 'id' );
+$tix->GroupBy( FIELD => $PrimaryGroupBy );
+my $value_name = $tix->Column( FIELD => $PrimaryGroupBy );
my $chart = $chart_class->new( 600 => 400 );
if ($chart_class eq "GD::Graph::bars") {
$chart->set(
- x_label => $PrimaryGroupBy,
+ x_label => $tix->Label( $PrimaryGroupBy ),
x_labels_vertical => 1,
y_label => 'Tickets',
show_values => 1
- );
+ );
$chart->set_legend_font( ['verdana', 'arial', gdMediumBoldFont], 12);
-
}
-my $tix = RT::Report::Tickets->new( $session{'CurrentUser'} );
-$tix->GroupBy($PrimaryGroupBy);
-$tix->Column( FUNCTION => 'COUNT', FIELD => 'id' );
-$tix->Column( FIELD => $PrimaryGroupBy );
+my %class = (
+ Queue => 'RT::Queue',
+ Owner => 'RT::User',
+);
+my $class = $class{ $PrimaryGroupBy };
-$tix->FromSQL($Query);
-$tix->_DoSearch();
while ( my $entry = $tix->Next ) {
- my $class;
- if ( $PrimaryGroupBy eq 'Queue' ) {
- $class = "RT::Queue";
- }
- elsif ( $PrimaryGroupBy eq 'Owner' ) {
- $class = "RT::User";
- }
- if ($class) {
- my $q = $class->new( $session{'CurrentUser'} );
- $q->Load( $entry->__Value($PrimaryGroupBy) );
- if ($chart_class eq 'GD::Graph::pie') {
- push @keys, $q->Name() . " - ".$entry->id;
- }
- else {
- push @keys, $q->Name();
- }
- }
- else {
- if ($chart_class eq 'GD::Graph::pie') {
- push @keys, $entry->__Value($PrimaryGroupBy). "- ".$entry->id;
- }
- else {
- push @keys, $entry->__Value($PrimaryGroupBy);
- }
- }
- push @values, $entry->id;
+ if ( $class ) {
+ my $q = $class->new( $session{'CurrentUser'} );
+ $q->Load( $entry->__Value( $value_name ) );
+ push @keys, $q->Name;
+ }
+ else {
+ push @keys, $entry->__Value($value_name);
}
- #$chart->set( title => loc("[_1] grouped by [_2]",$Query, $PrimaryGroupBy) ) or die $chart->error;
-
- unless (@keys && @values) {
- @keys = ('');
- @values = (0);
+ $keys[-1] ||= loc('(no value)');
+ if ($chart_class eq 'GD::Graph::pie') {
+ $keys[-1] .= " - ". $entry->__Value( $count_name );
}
+ push @values, $entry->__Value($count_name);
+}
- my $plot = $chart->plot( [ [@keys], [@values] ] ) or die $chart->error;
- if ($plot->can('png') ) {
- $r->content_type('image/png');
- $m->out( $plot->png );
- } elsif ($plot->can('gif')) {
- $r->content_type('image/gif');
- $m->out( $plot->gif );
+# XXX: Convert 1970-01-01 date to the 'Not Set'
+# this code should be generalized!!!
+if ( $PrimaryGroupBy =~ /(Daily|Monthly|Annually)$/ ) {
+ my $re;
+ $re = qr{1970-01-01} if $PrimaryGroupBy =~ /Daily$/;
+ $re = qr{1970-01} if $PrimaryGroupBy =~ /Monthly$/;
+ $re = qr{1970} if $PrimaryGroupBy =~ /Annually$/;
+ foreach (@keys) {
+ s/^$re/loc('Not Set')/e;
+ }
+}
- } else {
- die "Your GD library appears to support neither PNG nor GIF";
- }
- $m->abort();
+unless (@keys && @values) {
+ @keys = ('');
+ @values = (0);
+}
+
+my $plot = $chart->plot( [ [@keys], [@values] ] ) or die $chart->error;
+
+if ( $plot->can('png') ) {
+ $r->content_type('image/png');
+ $m->out( $plot->png );
+}
+elsif ( $plot->can('gif') ) {
+ $r->content_type('image/gif');
+ $m->out( $plot->gif );
+}
+else {
+ die "Your GD library appears to support neither PNG nor GIF";
+}
+$m->abort();
</%init>
Modified: rt/branches/3.6-RELEASE/html/Search/Elements/Chart
==============================================================================
--- rt/branches/3.6-RELEASE/html/Search/Elements/Chart (original)
+++ rt/branches/3.6-RELEASE/html/Search/Elements/Chart Wed Jul 19 20:45:36 2006
@@ -50,49 +50,56 @@
$ChartStyle => 'bars'
</%args>
<%init>
-my @keys;
-my @values;
-
use RT::Report::Tickets;
+my $tix = RT::Report::Tickets->new( $session{'CurrentUser'} );
+$tix->FromSQL( $Query );
+my $count_name = $tix->Column( FUNCTION => 'COUNT', FIELD => 'id' );
+$tix->GroupBy( FIELD => $PrimaryGroupBy );
+my $value_name = $tix->Column( FIELD => $PrimaryGroupBy );
+
+my %class = (
+ Queue => 'RT::Queue',
+ Owner => 'RT::User',
+);
+my $class = $class{ $PrimaryGroupBy };
-my $tix = RT::Report::Tickets->new( $session{'CurrentUser'} );
-
-$tix->GroupBy($PrimaryGroupBy);
-$tix->Column( FUNCTION => 'COUNT', FIELD => 'id' );
-$tix->Column( FIELD => $PrimaryGroupBy );
-$tix->FromSQL($Query);
-$tix->_DoSearch();
+my (@keys, @values);
while ( my $entry = $tix->Next ) {
- my $class;
- if ( $PrimaryGroupBy eq 'Queue' ) {
- $class = "RT::Queue";
- }
- elsif ( $PrimaryGroupBy eq 'Owner' ) {
- $class = "RT::User";
- }
- if ($class) {
- my $q = $class->new( $session{'CurrentUser'} );
- $q->Load( $entry->__Value($PrimaryGroupBy) );
- push @keys, $q->Name();
- }
- else {
- push @keys, $entry->__Value($PrimaryGroupBy);
- }
- push @values, $entry->id;
+ if ($class) {
+ my $q = $class->new( $session{'CurrentUser'} );
+ $q->Load( $entry->__Value( $value_name ) );
+ push @keys, $q->Name;
+ }
+ else {
+ push @keys, $entry->__Value( $value_name );
}
+ $keys[-1] ||= loc('(no value)');
+ push @values, $entry->__Value( $count_name );
+}
+
+# XXX: Convert 1970-01-01 date to the 'Not Set'
+# this code should be generalized!!!
+if ( $PrimaryGroupBy =~ /(Daily|Monthly|Annually)$/ ) {
+ my $re;
+ $re = qr{1970-01-01} if $PrimaryGroupBy =~ /Daily$/;
+ $re = qr{1970-01} if $PrimaryGroupBy =~ /Monthly$/;
+ $re = qr{1970} if $PrimaryGroupBy =~ /Annually$/;
+ foreach (@keys) {
+ s/^$re/loc('Not Set')/e;
+ }
+}
my $query_string = $m->comp('/Elements/QueryString', %ARGS);
</%init>
-<img src="<%$RT::WebPath%>/Search/Chart?<%$query_string|n%>" />
-<br />
-<%$Query%>
+<% loc('Query:') %> <% $Query %><br />
+
+<img src="<%$RT::WebPath%>/Search/Chart?<%$query_string|n%>" /><br />
-<br />
<table class="collection-as-table">
<tr>
-<th class="collection-as-table"><%loc($PrimaryGroupBy)%>
+<th class="collection-as-table"><% $tix->Label($PrimaryGroupBy) %>
</th>
<th class="collection-as-table"><&|/l&>Tickets</&>
</th>
@@ -123,4 +130,3 @@
</tr>
</table>
-
Modified: rt/branches/3.6-RELEASE/html/Search/Elements/SelectGroupBy
==============================================================================
--- rt/branches/3.6-RELEASE/html/Search/Elements/SelectGroupBy (original)
+++ rt/branches/3.6-RELEASE/html/Search/Elements/SelectGroupBy Wed Jul 19 20:45:36 2006
@@ -46,14 +46,16 @@
<%args>
$Name => 'GroupBy'
$Default => 'Status'
+$Query => ''
</%args>
-<select name="<%$Name%>">
-% foreach my $option (@options) {
-<option value="<%$option%>" <% $option eq $Default ? 'SELECTED' : '' %>><%loc($option)%></option>
+<select name="<% $Name %>">
+% while (@options) {
+% my ($text, $value) = (shift @options, shift @options);
+<option value="<% $value %>" <% $value eq $Default ? 'selected' : '' %>><% loc($text) %></option>
% }
</select>
<%init>
use RT::Report::Tickets;
-my $report = RT::Report::Tickets->new($session{'CurrentUser'});
-my @options = $report->Groupings;
+my $report = RT::Report::Tickets->new( $session{'CurrentUser'} );
+my @options = $report->Groupings( Query => $Query );
</%init>
Modified: rt/branches/3.6-RELEASE/html/Search/Results.html
==============================================================================
--- rt/branches/3.6-RELEASE/html/Search/Results.html (original)
+++ rt/branches/3.6-RELEASE/html/Search/Results.html Wed Jul 19 20:45:36 2006
@@ -85,7 +85,7 @@
%foreach my $key (keys(%hiddens)) {
<input type="hidden" class="hidden" name="<%$key%>" value="<%defined($hiddens{$key})?$hiddens{$key}:''%>"/>
%}
-<&|/l, $m->scomp('Elements/SelectGroupBy', Name => 'PrimaryGroupBy') &>grouped by [_1]</&>
+<&|/l, $m->scomp('Elements/SelectGroupBy', Name => 'PrimaryGroupBy', Query => $Query) &>grouped by [_1]</&>
<&|/l, $m->scomp('Elements/SelectChartType', Name => 'ChartStyle') &>style: [_1]</&>
<input type="submit" class="button" value="<%loc('Go')%>" />
</form>
Modified: rt/branches/3.6-RELEASE/lib/RT/Report/Tickets.pm
==============================================================================
--- rt/branches/3.6-RELEASE/lib/RT/Report/Tickets.pm (original)
+++ rt/branches/3.6-RELEASE/lib/RT/Report/Tickets.pm Wed Jul 19 20:45:36 2006
@@ -44,46 +44,93 @@
#
# END BPS TAGGED BLOCK }}}
package RT::Report::Tickets;
+
use base qw/RT::Tickets/;
use RT::Report::Tickets::Entry;
+use strict;
+use warnings;
sub Groupings {
- qw (Owner
- Status
- Queue
- DueDaily
- DueMonthly
- DueAnnually
- ResolvedDaily
- ResolvedMonthly
- ResolvedAnnually
- CreatedDaily
- CreatedMonthly
- CreatedAnnually
- LastUpdatedDaily
- LastUpdatedMonthly
- LastUpdatedAnnually
- StartedDaily
- StartedMonthly
- StartedAnnually
- StartsDaily
- StartsMonthly
- StartsAnnually
- )
+ my $self = shift;
+ my %args = (@_);
+ my @fields = qw(
+ Owner
+ Status
+ Queue
+ DueDaily
+ DueMonthly
+ DueAnnually
+ ResolvedDaily
+ ResolvedMonthly
+ ResolvedAnnually
+ CreatedDaily
+ CreatedMonthly
+ CreatedAnnually
+ LastUpdatedDaily
+ LastUpdatedMonthly
+ LastUpdatedAnnually
+ StartedDaily
+ StartedMonthly
+ StartedAnnually
+ StartsDaily
+ StartsMonthly
+ StartsAnnually
+ );
+
+ @fields = map {$_, $_} @fields;
+
+ my $queues = $args{'Queues'};
+ if ( !$queues && $args{'Query'} ) {
+ my @actions;
+ my $tree;
+ # XXX TODO REFACTOR OUT
+ $self->_ParseQuery( $args{'Query'}, \$tree, \@actions );
+ $queues = $tree->GetReferencedQueues;
+ }
+ if ( $queues ) {
+ my $CustomFields = RT::CustomFields->new( $self->CurrentUser );
+ foreach my $id (keys %$queues) {
+ my $queue = RT::Queue->new( $self->CurrentUser );
+ $queue->Load($id);
+ unless ($queue->id) {
+ # XXX TODO: This ancient code dates from a former developer
+ # we have no idea what it means or why cfqueues are so encoded.
+ $id =~ s/^.'*(.*).'*$/$1/;
+ $queue->Load($id);
+ }
+ $CustomFields->LimitToQueue($queue->Id);
+ }
+ $CustomFields->LimitToGlobal;
+ while ( my $CustomField = $CustomFields->Next ) {
+ push @fields, "Custom field '". $CustomField->Name ."'", "CF.{". $CustomField->id ."}";
+ }
+ }
+ return @fields;
}
-sub GroupBy {
+sub Label {
my $self = shift;
my $field = shift;
+ if ( $field =~ /^(?:CF|CustomField)\.{(.*)}$/ ) {
+ my $cf = $1;
+ return $self->CurrentUser->loc( "Custom field '[_1]'", $cf ) if $cf =~ /\D/;
+ my $obj = RT::CustomField->new( $self->CurrentUser );
+ $obj->Load( $cf );
+ return $self->CurrentUser->loc( "Custom field '[_1]'", $obj->Name );
+ }
+ return $self->CurrentUser->loc($field);
+}
- $self->{'_group_by_field'} = $field;
+sub GroupBy {
+ my $self = shift;
+ my %args = ref $_[0]? %{ $_[0] }: (@_);
- my $function;
- (undef, $function) = $self->_FieldToFunction($field);
- $self->GroupByCols({ FIELD => $field, FUNCTION => $function});
+ $self->{'_group_by_field'} = $args{'FIELD'};
+ %args = $self->_FieldToFunction( %args );
+ $self->SUPER::GroupBy( \%args );
}
sub Column {
@@ -91,9 +138,10 @@
my %args = (@_);
if ( $args{'FIELD'} && !$args{'FUNCTION'} ) {
- ( undef, $args{'FUNCTION'} ) = $self->_FieldToFunction( $args{'FIELD'} ); }
+ %args = $self->_FieldToFunction( %args );
+ }
- return $self->SUPER::Column(%args);
+ return $self->SUPER::Column( %args );
}
=head2 _DoSearch
@@ -105,13 +153,10 @@
sub _DoSearch {
my $self = shift;
- $self->SUPER::_DoSearch(@_);
- $self->AddEmptyRows();
-
+ $self->SUPER::_DoSearch( @_ );
+ $self->AddEmptyRows;
}
-
-
=head2 _FieldToFunction FIELD
Returns a tuple of the field or a database function to allow grouping on that
@@ -119,29 +164,35 @@
=cut
-sub _FieldToFunction{
+sub _FieldToFunction {
my $self = shift;
- my $field = shift;
- my $func = '';
+ my %args = (@_);
+
+ my $field = $args{'FIELD'};
if ($field =~ /^(.*)(Daily|Monthly|Annually)$/) {
- $field = $1;
- $grouping = $2;
- if ($grouping =~ /Daily/) {
- $func = "SUBSTR($field,1,10)";
- $field = '';
+ my ($field, $grouping) = ($1, $2);
+ if ( $grouping =~ /Daily/ ) {
+ $args{'FUNCTION'} = "SUBSTR($field,1,10)";
}
- elsif ($grouping =~ /Monthly/) {
- $func = "SUBSTR($field,1,7)";
- $field = '';
+ elsif ( $grouping =~ /Monthly/ ) {
+ $args{'FUNCTION'} = "SUBSTR($field,1,7)";
}
- elsif ($grouping =~ /Annually/) {
- $func = "SUBSTR($field,1,4)";
- $field = '';
+ elsif ( $grouping =~ /Annually/ ) {
+ $args{'FUNCTION'} = "SUBSTR($field,1,4)";
+ }
+ } elsif ( $field =~ /^(?:CF|CustomField)\.{(.*)}$/ ) { #XXX: use CFDecipher method
+ my $cf_name = $1;
+ my $cf = RT::CustomField->new( $self->CurrentUser );
+ $cf->Load($cf_name);
+ unless ( $cf->id ) {
+ $RT::Logger->error("Couldn't load CustomField #$cf_name");
+ } else {
+ my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf->id, $cf_name);
+ @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content');
}
-
}
- return ($field, $func);
+ return %args;
}
@@ -181,19 +232,217 @@
sub AddEmptyRows {
my $self = shift;
- if ( $self->{'_group_by_field'} eq 'Status' ) {
- foreach my $status (RT::Queue->new($self->CurrentUser)->StatusArray ) {
- unless ( grep { $_->__Value('Status') eq $status } @{ $self->ItemsArrayRef } ) {
- my $record = $self->NewItem;
- $record->LoadFromHash(
- {
- id => 0,
- status => $status
- }
- );
- $self->AddRecord($record);
- }
+ if ( $self->{'_group_by_field'} eq 'Status' ) {
+ my %has = map { $_->__Value('Status') => 1 } @{ $self->ItemsArrayRef || [] };
+
+ foreach my $status ( grep !$has{$_}, RT::Queue->new($self->CurrentUser)->StatusArray ) {
+
+ my $record = $self->NewItem;
+ $record->LoadFromHash( {
+ id => 0,
+ status => $status
+ } );
+ $self->AddRecord($record);
+ }
}
}
+
+
+# XXX TODO: this code cut and pasted from html/Search/Build.html
+# This has already been improved (But not backported) in 3.7
+#
+# This code is hacky, evil and wrong. But it's end of lifed from day one and is
+# less likely to destabilize the codebase than the full refactoring it should get.
+use Regexp::Common qw /delimited/;
+
+# States
+use constant VALUE => 1;
+use constant AGGREG => 2;
+use constant OP => 4;
+use constant PAREN => 8;
+use constant KEYWORD => 16;
+
+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;
}
+
+sub _ParseQuery {
+ my $self = shift;
+ my $string = shift;
+ my $tree = shift;
+ my @actions = shift;
+ my $want = KEYWORD | PAREN;
+ my $last = undef;
+
+ my $depth = 1;
+
+ # make a tree root
+ $$tree = RT::Interface::Web::QueryBuilder::Tree->new;
+ my $root = RT::Interface::Web::QueryBuilder::Tree->new( 'AND', $$tree );
+ my $lastnode = $root;
+ my $parentnode = $root;
+
+ # get the FIELDS from Tickets_Overlay
+ my $tickets = new RT::Tickets( $self->CurrentUser );
+ my %FIELDS = %{ $tickets->FIELDS };
+
+ # Lower Case version of FIELDS, for case insensitivity
+ my %lcfields = map { ( lc($_) => $_ ) } ( keys %FIELDS );
+
+ my @tokens = qw[VALUE AGGREG OP 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_op =
+ qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]
+ ; # long to short
+ my $re_paren = qr'\(|\)';
+
+ # assume that $ea is AND if it is not set
+ my ( $ea, $key, $op, $value ) = ( "AND", "", "", "" );
+
+ # 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_paren
+ )/igx
+ )
+ {
+ 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 );
+
+ unless ( $current && $want & $current ) {
+
+ # Error
+ # FIXME: I will only print out the highest $want value
+ my $token = $tokens[ ( ( log $want ) / ( log 2 ) ) ];
+ push @actions,
+ [
+ loc(
+"current: $current, want $want, Error near ->$val<- expecting a "
+ . $token
+ . " in '$string'\n"
+ ),
+ -1
+ ];
+ }
+
+ # State Machine:
+ my $parentdepth = $depth;
+
+ # Parens are highest priority
+ if ( $current & PAREN ) {
+ if ( $val eq "(" ) {
+ $depth++;
+
+ # make a new node that the clauses can be children of
+ $parentnode = RT::Interface::Web::QueryBuilder::Tree->new( $ea, $parentnode );
+ }
+ else {
+ $depth--;
+ $parentnode = $parentnode->getParent();
+ $lastnode = $parentnode;
+ }
+
+ $want = KEYWORD | PAREN | AGGREG;
+ }
+ elsif ( $current & AGGREG ) {
+ $ea = $val;
+ $want = KEYWORD | PAREN;
+ }
+ elsif ( $current & KEYWORD ) {
+ $key = $val;
+ $want = OP;
+ }
+ elsif ( $current & OP ) {
+ $op = $val;
+ $want = VALUE;
+ }
+ elsif ( $current & VALUE ) {
+ $value = $val;
+
+ # Remove surrounding quotes from $key, $val
+ # (in future, simplify as for($key,$val) { action on $_ })
+ if ( $key =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
+ substr( $key, 0, 1 ) = "";
+ substr( $key, -1, 1 ) = "";
+ }
+ if ( $val =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
+ substr( $val, 0, 1 ) = "";
+ substr( $val, -1, 1 ) = "";
+ }
+
+ # Unescape escaped characters
+ $key =~ s!\\(.)!$1!g;
+ $val =~ s!\\(.)!$1!g;
+
+ my $class;
+ if ( exists $lcfields{ lc $key } ) {
+ $key = $lcfields{ lc $key };
+ $class = $FIELDS{$key}->[0];
+ }
+ if ( $class ne 'INT' ) {
+ $val = "'$val'";
+ }
+
+ push @actions, [ loc("Unknown field: $key"), -1 ] unless $class;
+
+ $want = PAREN | AGGREG;
+ }
+ else {
+ push @actions, [ loc("I'm lost"), -1 ];
+ }
+
+ if ( $current & VALUE ) {
+ if ( $key =~ /^CF./ ) {
+ $key = "'" . $key . "'";
+ }
+ my $clause = {
+ Key => $key,
+ Op => $op,
+ Value => $val
+ };
+
+ # explicity add a child to it
+ $lastnode = RT::Interface::Web::QueryBuilder::Tree->new( $clause, $parentnode );
+ $lastnode->getParent()->setNodeValue($ea);
+
+ ( $ea, $key, $op, $value ) = ( "", "", "", "" );
+ }
+
+ $last = $current;
+ } # while
+
+ push @actions, [ loc("Incomplete query"), -1 ]
+ unless ( ( $want | PAREN ) || ( $want | KEYWORD ) );
+
+ push @actions, [ loc("Incomplete Query"), -1 ]
+ unless ( $last && ( $last | PAREN ) || ( $last || VALUE ) );
+
+ # This will never happen, because the parser will complain
+ push @actions, [ loc("Mismatched parentheses"), -1 ]
+ unless $depth == 1;
+};
+
1;
More information about the Rt-commit
mailing list