rt/lib/RT/Report/Tickets.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  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
  16 # from www.gnu.org.
  17 #
  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.
  22 #
  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/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  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.)
  37 #
  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.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48 package RT::Report::Tickets;
  49
  50 use base qw/RT::Tickets/;
  51 use RT::Report::Tickets::Entry;
  52
  53 use strict;
  54 use warnings;
  55
  56 sub Groupings {
  57     my $self = shift;
  58     my %args = (@_);
  59     my @fields = qw(
  60         Owner
  61         Status
  62         Queue
  63         DueDaily
  64         DueMonthly
  65         DueAnnually
  66         ResolvedDaily
  67         ResolvedMonthly
  68         ResolvedAnnually
  69         CreatedDaily
  70         CreatedMonthly
  71         CreatedAnnually
  72         LastUpdatedDaily
  73         LastUpdatedMonthly
  74         LastUpdatedAnnually
  75         StartedDaily
  76         StartedMonthly
  77         StartedAnnually
  78         StartsDaily
  79         StartsMonthly
  80         StartsAnnually
  81     );
  82
  83     @fields = map {$_, $_} @fields;
  84
  85     my $queues = $args{'Queues'};
  86     if ( !$queues && $args{'Query'} ) {
  87         my @actions;
  88         my $tree;
  89         # XXX TODO REFACTOR OUT
  90         $self->_ParseQuery( $args{'Query'}, \$tree, \@actions );
  91         $queues = $tree->GetReferencedQueues;
  92     }
  93
  94     if ( $queues ) {
  95         my $CustomFields = RT::CustomFields->new( $self->CurrentUser );
  96         foreach my $id (keys %$queues) {
  97             my $queue = RT::Queue->new( $self->CurrentUser );
  98             $queue->Load($id);
  99             unless ($queue->id) {
 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/;
 103                 $queue->Load($id);
 104             }
 105             $CustomFields->LimitToQueue($queue->Id);
 106         }
 107         $CustomFields->LimitToGlobal;
 108         while ( my $CustomField = $CustomFields->Next ) {
 109             push @fields, "Custom field '". $CustomField->Name ."'", "CF.{". $CustomField->id ."}";
 110         }
 111     }
 112     return @fields;
 113 }
 114
 115 sub Label {
 116     my $self = shift;
 117     my $field = shift;
 118     if ( $field =~ /^(?:CF|CustomField)\.{(.*)}$/ ) {
 119         my $cf = $1;
 120         return $self->CurrentUser->loc( "Custom field '[_1]'", $cf ) if $cf =~ /\D/;
 121         my $obj = RT::CustomField->new( $self->CurrentUser );
 122         $obj->Load( $cf );
 123         return $self->CurrentUser->loc( "Custom field '[_1]'", $obj->Name );
 124     }
 125     return $self->CurrentUser->loc($field);
 126 }
 127
 128 sub GroupBy {
 129     my $self = shift;
 130     my %args = ref $_[0]? %{ $_[0] }: (@_);
 131
 132     $self->{'_group_by_field'} = $args{'FIELD'};
 133     %args = $self->_FieldToFunction( %args );
 134
 135     $self->SUPER::GroupBy( \%args );
 136 }
 137
 138 sub Column {
 139     my $self = shift;
 140     my %args = (@_);
 141
 142     if ( $args{'FIELD'} && !$args{'FUNCTION'} ) {
 143         %args = $self->_FieldToFunction( %args );
 144     }
 145
 146     return $self->SUPER::Column( %args );
 147 }
 148
 149 =head2 _DoSearch
 150
 151 Subclass _DoSearch from our parent so we can go through and add in empty
 152 columns if it makes sense
 153
 154 =cut
 155
 156 sub _DoSearch {
 157     my $self = shift;
 158     $self->SUPER::_DoSearch( @_ );
 159     $self->AddEmptyRows;
 160 }
 161
 162 =head2 _FieldToFunction FIELD
 163
 164 Returns a tuple of the field or a database function to allow grouping on that
 165 field.
 166
 167 =cut
 168
 169 sub _FieldToFunction {
 170     my $self = shift;
 171     my %args = (@_);
 172
 173     my $field = $args{'FIELD'};
 174
 175     if ($field =~ /^(.*)(Daily|Monthly|Annually)$/) {
 176         my ($field, $grouping) = ($1, $2);
 177         if ( $grouping =~ /Daily/ ) {
 178             $args{'FUNCTION'} = "SUBSTR($field,1,10)";
 179         }
 180         elsif ( $grouping =~ /Monthly/ ) {
 181             $args{'FUNCTION'} = "SUBSTR($field,1,7)";
 182         }
 183         elsif ( $grouping =~ /Annually/ ) {
 184             $args{'FUNCTION'} = "SUBSTR($field,1,4)";
 185         }
 186     } elsif ( $field =~ /^(?:CF|CustomField)\.{(.*)}$/ ) { #XXX: use CFDecipher method
 187         my $cf_name = $1;
 188         my $cf = RT::CustomField->new( $self->CurrentUser );
 189         $cf->Load($cf_name);
 190         unless ( $cf->id ) {
 191             $RT::Logger->error("Couldn't load CustomField #$cf_name");
 192         } else {
 193             my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf->id, $cf_name);
 194             @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content');
 195         }
 196     }
 197     return %args;
 198 }
 199
 200
 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.
 203 sub AddRecord {
 204     my $self = shift;
 205     my $record = shift;
 206     push @{$self->{'items'}}, $record;
 207     $self->{'rows'}++;
 208 }
 209
 210 1;
 211
 212
 213
 214 # Gotta skip over RT::Tickets->Next, since it does all sorts of crazy magic we
 215 # don't want.
 216 sub Next {
 217     my $self = shift;
 218     $self->RT::SearchBuilder::Next(@_);
 219
 220 }
 221
 222 sub NewItem {
 223     my $self = shift;
 224     return RT::Report::Tickets::Entry->new($RT::SystemUser); # $self->CurrentUser);
 225 }
 226
 227
 228 =head2 AddEmptyRows
 229
 230 If we're grouping on a criterion we know how to add zero-value rows
 231 for, do that.
 232
 233 =cut
 234
 235 sub AddEmptyRows {
 236     my $self = shift;
 237     if ( $self->{'_group_by_field'} eq 'Status' ) {
 238         my %has = map { $_->__Value('Status') => 1 } @{ $self->ItemsArrayRef || [] };
 239
 240         foreach my $status ( grep !$has{$_}, RT::Queue->new($self->CurrentUser)->StatusArray ) {
 241
 242             my $record = $self->NewItem;
 243             $record->LoadFromHash( {
 244                 id     => 0,
 245                 status => $status
 246             } );
 247             $self->AddRecord($record);
 248         }
 249     }
 250 }
 251
 252
 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
 255 #
 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/;
 259
 260 # States
 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;
 266
 267 sub _match {
 268
 269     # Case insensitive equality
 270     my ( $y, $x ) = @_;
 271     return 1 if $x =~ /^$y$/i;
 272
 273     #  return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv?
 274     return 0;
 275 }
 276
 277 sub _ParseQuery {
 278     my $self = shift;
 279     my $string  = shift;
 280     my $tree    = shift;
 281     my @actions = shift;
 282     my $want    = KEYWORD | PAREN;
 283     my $last    = undef;
 284
 285     my $depth = 1;
 286
 287     # make a tree root
 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;
 293
 294     # get the FIELDS from Tickets_Overlay
 295     my $tickets = new RT::Tickets( $self->CurrentUser );
 296     my %FIELDS  = %{ $tickets->FIELDS };
 297
 298     # Lower Case version of FIELDS, for case insensitivity
 299     my %lcfields = map { ( lc($_) => $_ ) } ( keys %FIELDS );
 300
 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|\.)+];
 305     my $re_op      =
 306       qr[=|!=|>=|<=|>|<|(?i:IS NOT)|(?i:IS)|(?i:NOT LIKE)|(?i:LIKE)]
 307       ;    # long to short
 308     my $re_paren = qr'\(|\)';
 309
 310     # assume that $ea is AND if it is not set
 311     my ( $ea, $key, $op, $value ) = ( "AND", "", "", "" );
 312
 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.
 316
 317     while (
 318         $string =~ /(
 319                       $re_aggreg
 320                       |$re_op
 321                       |$re_keyword
 322                       |$re_value
 323                       |$re_paren
 324                      )/igx
 325       )
 326     {
 327         my $val     = $1;
 328         my $current = 0;
 329
 330         # Highest priority is last
 331         $current = OP    if _match( $re_op,    $val );
 332         $current = VALUE if _match( $re_value, $val );
 333         $current = KEYWORD
 334           if _match( $re_keyword, $val ) && ( $want & KEYWORD );
 335         $current = AGGREG if _match( $re_aggreg, $val );
 336         $current = PAREN  if _match( $re_paren,  $val );
 337
 338         unless ( $current && $want & $current ) {
 339
 340             # Error
 341             # FIXME: I will only print out the highest $want value
 342             my $token = $tokens[ ( ( log $want ) / ( log 2 ) ) ];
 343             push @actions,
 344               [
 345                 $self->CurrentUser->loc(
 346 "current: $current, want $want, Error near ->$val<- expecting a $token in '$string'\n"
 347                 ),
 348                 -1
 349               ];
 350         }
 351
 352         # State Machine:
 353         my $parentdepth = $depth;
 354
 355         # Parens are highest priority
 356         if ( $current & PAREN ) {
 357             if ( $val eq "(" ) {
 358                 $depth++;
 359
 360                 # make a new node that the clauses can be children of
 361                 $parentnode = RT::Interface::Web::QueryBuilder::Tree->new( $ea, $parentnode );
 362             }
 363             else {
 364                 $depth--;
 365                 $parentnode = $parentnode->getParent();
 366                 $lastnode   = $parentnode;
 367             }
 368
 369             $want = KEYWORD | PAREN | AGGREG;
 370         }
 371         elsif ( $current & AGGREG ) {
 372             $ea   = $val;
 373             $want = KEYWORD | PAREN;
 374         }
 375         elsif ( $current & KEYWORD ) {
 376             $key  = $val;
 377             $want = OP;
 378         }
 379         elsif ( $current & OP ) {
 380             $op   = $val;
 381             $want = VALUE;
 382         }
 383         elsif ( $current & VALUE ) {
 384             $value = $val;
 385
 386             # Remove surrounding quotes from $key, $val
 387             # (in future, simplify as for($key,$val) { action on $_ })
 388             if ( $key =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
 389                 substr( $key, 0,  1 ) = "";
 390                 substr( $key, -1, 1 ) = "";
 391             }
 392             if ( $val =~ /$RE{delimited}{-delim=>qq{\'\"}}/ ) {
 393                 substr( $val, 0,  1 ) = "";
 394                 substr( $val, -1, 1 ) = "";
 395             }
 396
 397             # Unescape escaped characters
 398             $key =~ s!\\(.)!$1!g;
 399             $val =~ s!\\(.)!$1!g;
 400
 401             my $class;
 402             if ( exists $lcfields{ lc $key } ) {
 403                 $key   = $lcfields{ lc $key };
 404                 $class = $FIELDS{$key}->[0];
 405             }
 406             if ( $class ne 'INT' ) {
 407                 $val = "'$val'";
 408             }
 409
 410             push @actions, [ $self->CurrentUser->loc("Unknown field: [_1]", $key), -1 ] unless $class;
 411
 412             $want = PAREN | AGGREG;
 413         }
 414         else {
 415             push @actions, [ $self->CurrentUser->loc("I'm lost"), -1 ];
 416         }
 417
 418         if ( $current & VALUE ) {
 419             if ( $key =~ /^CF./ ) {
 420                 $key = "'" . $key . "'";
 421             }
 422             my $clause = {
 423                 Key   => $key,
 424                 Op    => $op,
 425                 Value => $val
 426             };
 427
 428             # explicity add a child to it
 429             $lastnode = RT::Interface::Web::QueryBuilder::Tree->new( $clause, $parentnode );
 430             $lastnode->getParent()->setNodeValue($ea);
 431
 432             ( $ea, $key, $op, $value ) = ( "", "", "", "" );
 433         }
 434
 435         $last = $current;
 436     }    # while
 437
 438     push @actions, [ $self->CurrentUser->loc("Incomplete query"), -1 ]
 439       unless ( ( $want | PAREN ) || ( $want | KEYWORD ) );
 440
 441     push @actions, [ $self->CurrentUser->loc("Incomplete Query"), -1 ]
 442       unless ( $last && ( $last | PAREN ) || ( $last || VALUE ) );
 443
 444     # This will never happen, because the parser will complain
 445     push @actions, [ $self->CurrentUser->loc("Mismatched parentheses"), -1 ]
 446       unless $depth == 1;
 447 };
 448
 449 1;