1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
6 # <jesse@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/copyleft/gpl.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
48 package RT::Report::Tickets;
50 use base qw/RT::Tickets/;
51 use RT::Report::Tickets::Entry;
83 @fields = map {$_, $_} @fields;
85 my $queues = $args{'Queues'};
86 if ( !$queues && $args{'Query'} ) {
89 # XXX TODO REFACTOR OUT
90 $self->_ParseQuery( $args{'Query'}, \$tree, \@actions );
91 $queues = $tree->GetReferencedQueues;
95 my $CustomFields = RT::CustomFields->new( $self->CurrentUser );
96 foreach my $id (keys %$queues) {
97 my $queue = RT::Queue->new( $self->CurrentUser );
100 # XXX TODO: This ancient code dates from a former developer
101 # we have no idea what it means or why cfqueues are so encoded.
102 $id =~ s/^.'*(.*).'*$/$1/;
105 $CustomFields->LimitToQueue($queue->Id);
107 $CustomFields->LimitToGlobal;
108 while ( my $CustomField = $CustomFields->Next ) {
109 push @fields, "Custom field '". $CustomField->Name ."'", "CF.{". $CustomField->id ."}";
118 if ( $field =~ /^(?:CF|CustomField)\.{(.*)}$/ ) {
120 return $self->CurrentUser->loc( "Custom field '[_1]'", $cf ) if $cf =~ /\D/;
121 my $obj = RT::CustomField->new( $self->CurrentUser );
123 return $self->CurrentUser->loc( "Custom field '[_1]'", $obj->Name );
125 return $self->CurrentUser->loc($field);
130 my %args = ref $_[0]? %{ $_[0] }: (@_);
132 $self->{'_group_by_field'} = $args{'FIELD'};
133 %args = $self->_FieldToFunction( %args );
135 $self->SUPER::GroupBy( \%args );
142 if ( $args{'FIELD'} && !$args{'FUNCTION'} ) {
143 %args = $self->_FieldToFunction( %args );
146 return $self->SUPER::Column( %args );
151 Subclass _DoSearch from our parent so we can go through and add in empty
152 columns if it makes sense
158 $self->SUPER::_DoSearch( @_ );
162 =head2 _FieldToFunction FIELD
164 Returns a tuple of the field or a database function to allow grouping on that
169 sub _FieldToFunction {
173 my $field = $args{'FIELD'};
175 if ($field =~ /^(.*)(Daily|Monthly|Annually)$/) {
176 my ($field, $grouping) = ($1, $2);
177 if ( $grouping =~ /Daily/ ) {
178 $args{'FUNCTION'} = "SUBSTR($field,1,10)";
180 elsif ( $grouping =~ /Monthly/ ) {
181 $args{'FUNCTION'} = "SUBSTR($field,1,7)";
183 elsif ( $grouping =~ /Annually/ ) {
184 $args{'FUNCTION'} = "SUBSTR($field,1,4)";
186 } elsif ( $field =~ /^(?:CF|CustomField)\.{(.*)}$/ ) { #XXX: use CFDecipher method
188 my $cf = RT::CustomField->new( $self->CurrentUser );
191 $RT::Logger->error("Couldn't load CustomField #$cf_name");
193 my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf->id, $cf_name);
194 @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content');
201 # Override the AddRecord from DBI::SearchBuilder::Unique. id isn't id here
202 # wedon't want to disambiguate all the items with a count of 1.
206 push @{$self->{'items'}}, $record;
214 # Gotta skip over RT::Tickets->Next, since it does all sorts of crazy magic we
218 $self->RT::SearchBuilder::Next(@_);
224 return RT::Report::Tickets::Entry->new($RT::SystemUser); # $self->CurrentUser);
230 If we're grouping on a criterion we know how to add zero-value rows
237 if ( $self->{'_group_by_field'} eq 'Status' ) {
238 my %has = map { $_->__Value('Status') => 1 } @{ $self->ItemsArrayRef || [] };
240 foreach my $status ( grep !$has{$_}, RT::Queue->new($self->CurrentUser)->StatusArray ) {
242 my $record = $self->NewItem;
243 $record->LoadFromHash( {
247 $self->AddRecord($record);
253 # XXX TODO: this code cut and pasted from html/Search/Build.html
254 # This has already been improved (But not backported) in 3.7
256 # This code is hacky, evil and wrong. But it's end of lifed from day one and is
257 # less likely to destabilize the codebase than the full refactoring it should get.
258 use Regexp::Common qw /delimited/;
261 use constant VALUE => 1;
262 use constant AGGREG => 2;
263 use constant OP => 4;
264 use constant PAREN => 8;
265 use constant KEYWORD => 16;
269 # Case insensitive equality
271 return 1 if $x =~ /^$y$/i;
273 # return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
282 my $want = KEYWORD | PAREN;
288 use RT::Interface::Web::QueryBuilder::Tree;
289 $$tree = RT::Interface::Web::QueryBuilder::Tree->new;
290 my $root = RT::Interface::Web::QueryBuilder::Tree->new( 'AND', $$tree );
291 my $lastnode = $root;
292 my $parentnode = $root;
294 # get the FIELDS from Tickets_Overlay
295 my $tickets = new RT::Tickets( $self->CurrentUser );
296 my %FIELDS = %{ $tickets->FIELDS };
298 # Lower Case version of FIELDS, for case insensitivity
299 my %lcfields = map { ( lc($_) => $_ ) } ( keys %FIELDS );
301 my @tokens = qw[VALUE AGGREG OP PAREN KEYWORD];
302 my $re_aggreg = qr[(?i:AND|OR)];
303 my $re_value = qr[$RE{delimited}{-delim=>qq{\'\"}}|\d+];
304 my $re_keyword = qr[$RE{delimited}{-delim=>qq{\'\"}}|(?:\{|\}|\w|\.)+];
306 qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]
308 my $re_paren = qr'\(|\)';
310 # assume that $ea is AND if it is not set
311 my ( $ea, $key, $op, $value ) = ( "AND", "", "", "" );
313 # order of matches in the RE is important.. op should come early,
314 # because it has spaces in it. otherwise "NOT LIKE" might be parsed
315 # as a keyword or value.
330 # Highest priority is last
331 $current = OP if _match( $re_op, $val );
332 $current = VALUE if _match( $re_value, $val );
334 if _match( $re_keyword, $val ) && ( $want & KEYWORD );
335 $current = AGGREG if _match( $re_aggreg, $val );
336 $current = PAREN if _match( $re_paren, $val );
338 unless ( $current && $want & $current ) {
341 # FIXME: I will only print out the highest $want value
342 my $token = $tokens[ ( ( log $want ) / ( log 2 ) ) ];
345 $self->CurrentUser->loc(
346 "current: $current, want $want, Error near ->$val<- expecting a "
355 my $parentdepth = $depth;
357 # Parens are highest priority
358 if ( $current & PAREN ) {
362 # make a new node that the clauses can be children of
363 $parentnode = RT::Interface::Web::QueryBuilder::Tree->new( $ea, $parentnode );
367 $parentnode = $parentnode->getParent();
368 $lastnode = $parentnode;
371 $want = KEYWORD | PAREN | AGGREG;
373 elsif ( $current & AGGREG ) {
375 $want = KEYWORD | PAREN;
377 elsif ( $current & KEYWORD ) {
381 elsif ( $current & OP ) {
385 elsif ( $current & VALUE ) {
388 # Remove surrounding quotes from $key, $val
389 # (in future, simplify as for($key,$val) { action on $_ })
390 if ( $key =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
391 substr( $key, 0, 1 ) = "";
392 substr( $key, -1, 1 ) = "";
394 if ( $val =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
395 substr( $val, 0, 1 ) = "";
396 substr( $val, -1, 1 ) = "";
399 # Unescape escaped characters
400 $key =~ s!\\(.)!$1!g;
401 $val =~ s!\\(.)!$1!g;
404 if ( exists $lcfields{ lc $key } ) {
405 $key = $lcfields{ lc $key };
406 $class = $FIELDS{$key}->[0];
408 if ( $class ne 'INT' ) {
412 push @actions, [ $self->CurrentUser->loc("Unknown field: [_1]", $key), -1 ] unless $class;
414 $want = PAREN | AGGREG;
417 push @actions, [ $self->CurrentUser->loc("I'm lost"), -1 ];
420 if ( $current & VALUE ) {
421 if ( $key =~ /^CF./ ) {
422 $key = "'" . $key . "'";
430 # explicity add a child to it
431 $lastnode = RT::Interface::Web::QueryBuilder::Tree->new( $clause, $parentnode );
432 $lastnode->getParent()->setNodeValue($ea);
434 ( $ea, $key, $op, $value ) = ( "", "", "", "" );
440 push @actions, [ $self->CurrentUser->loc("Incomplete query"), -1 ]
441 unless ( ( $want | PAREN ) || ( $want | KEYWORD ) );
443 push @actions, [ $self->CurrentUser->loc("Incomplete Query"), -1 ]
444 unless ( $last && ( $last | PAREN ) || ( $last || VALUE ) );
446 # This will never happen, because the parser will complain
447 push @actions, [ $self->CurrentUser->loc("Mismatched parentheses"), -1 ]