X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FReport%2FTickets.pm;h=0ea1bb199bb9fe2d58ae41d27cdc9e0743822010;hb=44dd00a3ff974a17999e86e64488e996edc71e3c;hp=c1834caf81f6043606cf273b528fb6aa0a02fa18;hpb=2dfda73eeb3eae2d4f894099754794ef07d060dd;p=freeside.git diff --git a/rt/lib/RT/Report/Tickets.pm b/rt/lib/RT/Report/Tickets.pm index c1834caf8..0ea1bb199 100644 --- a/rt/lib/RT/Report/Tickets.pm +++ b/rt/lib/RT/Report/Tickets.pm @@ -1,40 +1,40 @@ # BEGIN BPS TAGGED BLOCK {{{ -# +# # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# -# +# +# This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC +# +# # (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., 51 Franklin Street, Fifth Floor, Boston, MA # 02110-1301 or visit their web page on the internet at # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# +# +# # 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 @@ -43,8 +43,9 @@ # 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::Report::Tickets; use base qw/RT::Tickets/; @@ -53,97 +54,533 @@ use RT::Report::Tickets::Entry; use strict; use warnings; -sub Groupings { - 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 - ); +use Scalar::Util qw(weaken); - @fields = map {$_, $_} @fields; +our @GROUPINGS = ( + Status => 'Enum', #loc_left_pair - 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; - } + Queue => 'Queue', #loc_left_pair + + InitialPriority => 'Priority', #loc_left_pair + FinalPriority => 'Priority', #loc_left_pair + Priority => 'Priority', #loc_left_pair + + Owner => 'User', #loc_left_pair + Creator => 'User', #loc_left_pair + LastUpdatedBy => 'User', #loc_left_pair + + Requestor => 'Watcher', #loc_left_pair + Cc => 'Watcher', #loc_left_pair + AdminCc => 'Watcher', #loc_left_pair + Watcher => 'Watcher', #loc_left_pair + + Created => 'Date', #loc_left_pair + Starts => 'Date', #loc_left_pair + Started => 'Date', #loc_left_pair + Resolved => 'Date', #loc_left_pair + Due => 'Date', #loc_left_pair + Told => 'Date', #loc_left_pair + LastUpdated => 'Date', #loc_left_pair + + CF => 'CustomField', #loc_left_pair +); +our %GROUPINGS; + +our %GROUPINGS_META = ( + Queue => { + Display => sub { + my $self = shift; + my %args = (@_); - 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( $args{'VALUE'} ); + return $queue->Name; + }, + Localize => 1, + }, + Priority => { + Sort => 'numeric raw', + }, + User => { + SubFields => [grep RT::User->_Accessible($_, "public"), qw( + Name RealName NickName + EmailAddress + Organization + Lang City Country Timezone + )], + Function => 'GenerateUserFunction', + }, + Watcher => { + SubFields => [grep RT::User->_Accessible($_, "public"), qw( + Name RealName NickName + EmailAddress + Organization + Lang City Country Timezone + )], + Function => 'GenerateWatcherFunction', + }, + Date => { + SubFields => [qw( + Time + Hourly Hour + Date Daily + DayOfWeek Day DayOfMonth DayOfYear + Month Monthly + Year Annually + WeekOfYear + )], # loc_qw + Function => 'GenerateDateFunction', + Display => sub { + my $self = shift; + my %args = (@_); + + my $raw = $args{'VALUE'}; + return $raw unless defined $raw; + + if ( $args{'SUBKEY'} eq 'DayOfWeek' ) { + return $self->loc($RT::Date::DAYS_OF_WEEK[ int $raw ]); + } + elsif ( $args{'SUBKEY'} eq 'Month' ) { + return $self->loc($RT::Date::MONTHS[ int($raw) - 1 ]); + } + return $raw; + }, + Sort => 'raw', + }, + CustomField => { + SubFields => sub { + my $self = shift; + my $args = shift; + + + my $queues = $args->{'Queues'}; + if ( !$queues && $args->{'Query'} ) { + require RT::Interface::Web::QueryBuilder::Tree; + my $tree = RT::Interface::Web::QueryBuilder::Tree->new('AND'); + $tree->ParseSQL( Query => $args->{'Query'}, CurrentUser => $self->CurrentUser ); + $queues = $args->{'Queues'} = $tree->GetReferencedQueues; + } + return () unless $queues; + + my @res; + + my $CustomFields = RT::CustomFields->new( $self->CurrentUser ); + foreach my $id (keys %$queues) { + my $queue = RT::Queue->new( $self->CurrentUser ); $queue->Load($id); + next unless $queue->id; + + $CustomFields->LimitToQueue($queue->id); } - $CustomFields->LimitToQueue($queue->Id); + $CustomFields->LimitToGlobal; + while ( my $CustomField = $CustomFields->Next ) { + push @res, ["Custom field", $CustomField->Name], "CF.{". $CustomField->id ."}"; + } + return @res; + }, + Function => 'GenerateCustomFieldFunction', + Label => sub { + my $self = shift; + my %args = (@_); + + my ($cf) = ( $args{'SUBKEY'} =~ /^\{(.*)\}$/ ); + if ( $cf =~ /^\d+$/ ) { + my $obj = RT::CustomField->new( $self->CurrentUser ); + $obj->Load( $cf ); + $cf = $obj->Name; + } + + return 'Custom field [_1]', $cf; + }, + }, + Enum => { + Localize => 1, + }, +); + +# loc'able strings below generated with (s/loq/loc/): +# perl -MRT=-init -MRT::Report::Tickets -E 'say qq{\# loq("$_->[0]")} while $_ = splice @RT::Report::Tickets::STATISTICS, 0, 2' +# +# loc("Ticket count") +# loc("Summary of time worked") +# loc("Total time worked") +# loc("Average time worked") +# loc("Minimum time worked") +# loc("Maximum time worked") +# loc("Summary of time estimated") +# loc("Total time estimated") +# loc("Average time estimated") +# loc("Minimum time estimated") +# loc("Maximum time estimated") +# loc("Summary of time left") +# loc("Total time left") +# loc("Average time left") +# loc("Minimum time left") +# loc("Maximum time left") +# loc("Summary of Created-Started") +# loc("Total Created-Started") +# loc("Average Created-Started") +# loc("Minimum Created-Started") +# loc("Maximum Created-Started") +# loc("Summary of Created-Resolved") +# loc("Total Created-Resolved") +# loc("Average Created-Resolved") +# loc("Minimum Created-Resolved") +# loc("Maximum Created-Resolved") +# loc("Summary of Created-LastUpdated") +# loc("Total Created-LastUpdated") +# loc("Average Created-LastUpdated") +# loc("Minimum Created-LastUpdated") +# loc("Maximum Created-LastUpdated") +# loc("Summary of Starts-Started") +# loc("Total Starts-Started") +# loc("Average Starts-Started") +# loc("Minimum Starts-Started") +# loc("Maximum Starts-Started") +# loc("Summary of Due-Resolved") +# loc("Total Due-Resolved") +# loc("Average Due-Resolved") +# loc("Minimum Due-Resolved") +# loc("Maximum Due-Resolved") +# loc("Summary of Started-Resolved") +# loc("Total Started-Resolved") +# loc("Average Started-Resolved") +# loc("Minimum Started-Resolved") +# loc("Maximum Started-Resolved") + +our @STATISTICS = ( + COUNT => ['Ticket count', 'Count', 'id'], +); + +foreach my $field (qw(TimeWorked TimeEstimated TimeLeft)) { + my $friendly = lc join ' ', split /(?<=[a-z])(?=[A-Z])/, $field; + push @STATISTICS, ( + "ALL($field)" => ["Summary of $friendly", 'TimeAll', $field ], + "SUM($field)" => ["Total $friendly", 'Time', 'SUM', $field ], + "AVG($field)" => ["Average $friendly", 'Time', 'AVG', $field ], + "MIN($field)" => ["Minimum $friendly", 'Time', 'MIN', $field ], + "MAX($field)" => ["Maximum $friendly", 'Time', 'MAX', $field ], + ); +} + + +foreach my $pair (qw( + Created-Started + Created-Resolved + Created-LastUpdated + Starts-Started + Due-Resolved + Started-Resolved +)) { + my ($from, $to) = split /-/, $pair; + push @STATISTICS, ( + "ALL($pair)" => ["Summary of $pair", 'DateTimeIntervalAll', $from, $to ], + "SUM($pair)" => ["Total $pair", 'DateTimeInterval', 'SUM', $from, $to ], + "AVG($pair)" => ["Average $pair", 'DateTimeInterval', 'AVG', $from, $to ], + "MIN($pair)" => ["Minimum $pair", 'DateTimeInterval', 'MIN', $from, $to ], + "MAX($pair)" => ["Maximum $pair", 'DateTimeInterval', 'MAX', $from, $to ], + ); +} + +our %STATISTICS; + +our %STATISTICS_META = ( + Count => { + Function => sub { + my $self = shift; + my $field = shift || 'id'; + + return ( + FUNCTION => 'COUNT', + FIELD => 'id' + ); + }, + }, + Simple => { + Function => sub { + my $self = shift; + my ($function, $field) = @_; + return (FUNCTION => $function, FIELD => $field); + }, + }, + Time => { + Function => sub { + my $self = shift; + my ($function, $field) = @_; + return (FUNCTION => "$function(?)*60", FIELD => $field); + }, + Display => 'DurationAsString', + }, + TimeAll => { + SubValues => sub { return ('Minimum', 'Average', 'Maximum', 'Total') }, + Function => sub { + my $self = shift; + my $field = shift; + return ( + Minimum => { FUNCTION => "MIN(?)*60", FIELD => $field }, + Average => { FUNCTION => "AVG(?)*60", FIELD => $field }, + Maximum => { FUNCTION => "MAX(?)*60", FIELD => $field }, + Total => { FUNCTION => "SUM(?)*60", FIELD => $field }, + ); + }, + Display => 'DurationAsString', + }, + DateTimeInterval => { + Function => sub { + my $self = shift; + my ($function, $from, $to) = @_; + + my $interval = $self->_Handle->DateTimeIntervalFunction( + From => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $from ) }, + To => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $to ) }, + ); + + return (FUNCTION => "$function($interval)"); + }, + Display => 'DurationAsString', + }, + DateTimeIntervalAll => { + SubValues => sub { return ('Minimum', 'Average', 'Maximum', 'Total') }, + Function => sub { + my $self = shift; + my ($from, $to) = @_; + + my $interval = $self->_Handle->DateTimeIntervalFunction( + From => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $from ) }, + To => { FUNCTION => $self->NotSetDateToNullFunction( FIELD => $to ) }, + ); + + return ( + Minimum => { FUNCTION => "MIN($interval)" }, + Average => { FUNCTION => "AVG($interval)" }, + Maximum => { FUNCTION => "MAX($interval)" }, + Total => { FUNCTION => "SUM($interval)" }, + ); + }, + Display => 'DurationAsString', + }, +); + +sub Groupings { + my $self = shift; + my %args = (@_); + + my @fields; + + my @tmp = @GROUPINGS; + while ( my ($field, $type) = splice @tmp, 0, 2 ) { + my $meta = $GROUPINGS_META{ $type } || {}; + unless ( $meta->{'SubFields'} ) { + push @fields, [$field, $field], $field; + } + elsif ( ref( $meta->{'SubFields'} ) eq 'ARRAY' ) { + push @fields, map { ([$field, $_], "$field.$_") } @{ $meta->{'SubFields'} }; + } + elsif ( my $code = $self->FindImplementationCode( $meta->{'SubFields'} ) ) { + push @fields, $code->( $self, \%args ); } - $CustomFields->LimitToGlobal; - while ( my $CustomField = $CustomFields->Next ) { - push @fields, "Custom field '". $CustomField->Name ."'", "CF.{". $CustomField->id ."}"; + else { + $RT::Logger->error( + "$type has unsupported SubFields." + ." Not an array, a method name or a code reference" + ); } } return @fields; } +sub IsValidGrouping { + my $self = shift; + my %args = (@_); + return 0 unless $args{'GroupBy'}; + + my ($key, $subkey) = split /\./, $args{'GroupBy'}, 2; + + %GROUPINGS = @GROUPINGS unless keys %GROUPINGS; + my $type = $GROUPINGS{$key}; + return 0 unless $type; + return 1 unless $subkey; + + my $meta = $GROUPINGS_META{ $type } || {}; + unless ( $meta->{'SubFields'} ) { + return 0; + } + elsif ( ref( $meta->{'SubFields'} ) eq 'ARRAY' ) { + return 1 if grep $_ eq $subkey, @{ $meta->{'SubFields'} }; + } + elsif ( my $code = $self->FindImplementationCode( $meta->{'SubFields'}, 'silent' ) ) { + return 1 if grep $_ eq "$key.$subkey", $code->( $self, \%args ); + } + return 0; +} + +sub Statistics { + my $self = shift; + return map { ref($_)? $_->[0] : $_ } @STATISTICS; +} + 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); + my $column = shift; + + my $info = $self->ColumnInfo( $column ); + unless ( $info ) { + $RT::Logger->error("Unknown column '$column'"); + return $self->CurrentUser->loc('(Incorrect data)'); + } + + if ( $info->{'META'}{'Label'} ) { + my $code = $self->FindImplementationCode( $info->{'META'}{'Label'} ); + return $self->CurrentUser->loc( $code->( $self, %$info ) ) + if $code; + } + + my $res = ''; + if ( $info->{'TYPE'} eq 'statistic' ) { + $res = $info->{'INFO'}[0]; + } + else { + $res = join ' ', grep defined && length, @{ $info }{'KEY', 'SUBKEY'}; + } + return $self->CurrentUser->loc( $res ); } -sub GroupBy { +sub ColumnInfo { my $self = shift; - my %args = ref $_[0]? %{ $_[0] }: (@_); + my $column = shift; - $self->{'_group_by_field'} = $args{'FIELD'}; - %args = $self->_FieldToFunction( %args ); + return $self->{'column_info'}{$column}; +} - $self->SUPER::GroupBy( \%args ); +sub ColumnsList { + my $self = shift; + return sort { $self->{'column_info'}{$a}{'POSITION'} <=> $self->{'column_info'}{$b}{'POSITION'} } + keys %{ $self->{'column_info'} || {} }; } -sub Column { +sub SetupGroupings { my $self = shift; - my %args = (@_); + my %args = ( + Query => undef, + GroupBy => undef, + Function => undef, + @_ + ); + + $self->FromSQL( $args{'Query'} ) if $args{'Query'}; + + # Apply ACL checks + $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks'); + + # See if our query is distinct + if (not $self->{'joins_are_distinct'} and $self->_isJoined) { + # If it isn't, we need to do this in two stages -- first, find + # the distinct matching tickets (with no group by), then search + # within the matching tickets grouped by what is wanted. + my @match = (0); + $self->Columns( 'id' ); + while (my $row = $self->Next) { + push @match, $row->id; + } - if ( $args{'FIELD'} && !$args{'FUNCTION'} ) { - %args = $self->_FieldToFunction( %args ); + # Replace the query with one that matches precisely those + # tickets, with no joins. We then mark it as having been ACL'd, + # since it was by dint of being in the search results above + $self->CleanSlate; + while ( @match > 1000 ) { + my @batch = splice( @match, 0, 1000 ); + $self->Limit( FIELD => 'Id', OPERATOR => 'IN', VALUE => \@batch ); + } + $self->Limit( FIELD => 'Id', OPERATOR => 'IN', VALUE => \@match ); + $self->{'_sql_current_user_can_see_applied'} = 1 + } + + + %GROUPINGS = @GROUPINGS unless keys %GROUPINGS; + + my $i = 0; + + my @group_by = grep defined && length, + ref( $args{'GroupBy'} )? @{ $args{'GroupBy'} } : ($args{'GroupBy'}); + @group_by = ('Status') unless @group_by; + + foreach my $e ( splice @group_by ) { + unless ($self->IsValidGrouping( Query => $args{Query}, GroupBy => $e )) { + RT->Logger->error("'$e' is not a valid grouping for reports; skipping"); + next; + } + my ($key, $subkey) = split /\./, $e, 2; + $e = { $self->_FieldToFunction( KEY => $key, SUBKEY => $subkey ) }; + $e->{'TYPE'} = 'grouping'; + $e->{'INFO'} = $GROUPINGS{ $key }; + $e->{'META'} = $GROUPINGS_META{ $e->{'INFO'} }; + $e->{'POSITION'} = $i++; + push @group_by, $e; + } + $self->GroupBy( map { { + ALIAS => $_->{'ALIAS'}, + FIELD => $_->{'FIELD'}, + FUNCTION => $_->{'FUNCTION'}, + } } @group_by ); + + my %res = (Groups => [], Functions => []); + my %column_info; + + foreach my $group_by ( @group_by ) { + $group_by->{'NAME'} = $self->Column( %$group_by ); + $column_info{ $group_by->{'NAME'} } = $group_by; + push @{ $res{'Groups'} }, $group_by->{'NAME'}; } - return $self->SUPER::Column( %args ); + %STATISTICS = @STATISTICS unless keys %STATISTICS; + + my @function = grep defined && length, + ref( $args{'Function'} )? @{ $args{'Function'} } : ($args{'Function'}); + push @function, 'COUNT' unless @function; + foreach my $e ( @function ) { + $e = { + TYPE => 'statistic', + KEY => $e, + INFO => $STATISTICS{ $e }, + META => $STATISTICS_META{ $STATISTICS{ $e }[1] }, + POSITION => $i++, + }; + unless ( $e->{'INFO'} && $e->{'META'} ) { + $RT::Logger->error("'". $e->{'KEY'} ."' is not valid statistic for report"); + $e->{'FUNCTION'} = 'NULL'; + $e->{'NAME'} = $self->Column( FUNCTION => 'NULL' ); + } + elsif ( $e->{'META'}{'Function'} ) { + my $code = $self->FindImplementationCode( $e->{'META'}{'Function'} ); + unless ( $code ) { + $e->{'FUNCTION'} = 'NULL'; + $e->{'NAME'} = $self->Column( FUNCTION => 'NULL' ); + } + elsif ( $e->{'META'}{'SubValues'} ) { + my %tmp = $code->( $self, @{ $e->{INFO} }[2 .. $#{$e->{INFO}}] ); + $e->{'NAME'} = 'postfunction'. $self->{'postfunctions'}++; + while ( my ($k, $v) = each %tmp ) { + $e->{'MAP'}{ $k }{'NAME'} = $self->Column( %$v ); + @{ $e->{'MAP'}{ $k } }{'FUNCTION', 'ALIAS', 'FIELD'} = + @{ $v }{'FUNCTION', 'ALIAS', 'FIELD'}; + } + } + else { + my %tmp = $code->( $self, @{ $e->{INFO} }[2 .. $#{$e->{INFO}}] ); + $e->{'NAME'} = $self->Column( %tmp ); + @{ $e }{'FUNCTION', 'ALIAS', 'FIELD'} = @tmp{'FUNCTION', 'ALIAS', 'FIELD'}; + } + } + elsif ( $e->{'META'}{'Calculate'} ) { + $e->{'NAME'} = 'postfunction'. $self->{'postfunctions'}++; + } + push @{ $res{'Functions'} }, $e->{'NAME'}; + $column_info{ $e->{'NAME'} } = $e; + } + + $self->{'column_info'} = \%column_info; + + return %res; } =head2 _DoSearch @@ -156,7 +593,14 @@ columns if it makes sense sub _DoSearch { my $self = shift; $self->SUPER::_DoSearch( @_ ); - $self->AddEmptyRows; + if ( $self->{'must_redo_search'} ) { + $RT::Logger->crit( +"_DoSearch is not so successful as it still needs redo search, won't call AddEmptyRows" + ); + } + else { + $self->PostProcessRecords; + } } =head2 _FieldToFunction FIELD @@ -170,280 +614,487 @@ sub _FieldToFunction { my $self = shift; my %args = (@_); - my $field = $args{'FIELD'}; + $args{'FIELD'} ||= $args{'KEY'}; + + my $meta = $GROUPINGS_META{ $GROUPINGS{ $args{'KEY'} } }; + return ('FUNCTION' => 'NULL') unless $meta; + + return %args unless $meta->{'Function'}; + + my $code = $self->FindImplementationCode( $meta->{'Function'} ); + return ('FUNCTION' => 'NULL') unless $code; + + return $code->( $self, %args ); +} + - if ($field =~ /^(.*)(Daily|Monthly|Annually)$/) { - my ($field, $grouping) = ($1, $2); - if ( $grouping =~ /Daily/ ) { - $args{'FUNCTION'} = "SUBSTR($field,1,10)"; +# Gotta skip over RT::Tickets->Next, since it does all sorts of crazy magic we +# don't want. +sub Next { + my $self = shift; + $self->RT::SearchBuilder::Next(@_); + +} + +sub NewItem { + my $self = shift; + my $res = RT::Report::Tickets::Entry->new($self->CurrentUser); + $res->{'report'} = $self; + weaken $res->{'report'}; + return $res; +} + +# This is necessary since normally NewItem (above) is used to intuit the +# correct class. However, since we're abusing a subclass, it's incorrect. +sub _RoleGroupClass { "RT::Ticket" } +sub _SingularClass { "RT::Report::Tickets::Entry" } + +sub SortEntries { + my $self = shift; + + $self->_DoSearch if $self->{'must_redo_search'}; + return unless $self->{'items'} && @{ $self->{'items'} }; + + my @groups = + grep $_->{'TYPE'} eq 'grouping', + map $self->ColumnInfo($_), + $self->ColumnsList; + return unless @groups; + + my @SORT_OPS; + my $by_multiple = sub ($$) { + for my $f ( @SORT_OPS ) { + my $r = $f->($_[0], $_[1]); + return $r if $r; + } + }; + my @data = map [$_], @{ $self->{'items'} }; + + for ( my $i = 0; $i < @groups; $i++ ) { + my $group_by = $groups[$i]; + my $idx = $i+1; + + my $order = $group_by->{'META'}{Sort} || 'label'; + my $method = $order =~ /label$/ ? 'LabelValue' : 'RawValue'; + + unless ($order =~ /^numeric/) { + # Traverse the values being used for labels. + # If they all look like numbers or undef, flag for a numeric sort. + my $looks_like_number = 1; + foreach my $item (@data){ + my $label = $item->[0]->$method($group_by->{'NAME'}); + + $looks_like_number = 0 + unless (not defined $label) + or Scalar::Util::looks_like_number( $label ); + } + $order = "numeric $order" if $looks_like_number; + } + + if ( $order eq 'label' ) { + push @SORT_OPS, sub { $_[0][$idx] cmp $_[1][$idx] }; + $method = 'LabelValue'; } - elsif ( $grouping =~ /Monthly/ ) { - $args{'FUNCTION'} = "SUBSTR($field,1,7)"; + elsif ( $order eq 'numeric label' ) { + my $nv = $self->loc("(no value)"); + # Sort the (no value) elements first, by comparing for them + # first, and falling back to a numeric sort on all other + # values. + push @SORT_OPS, sub { + (($_[0][$idx] ne $nv) <=> ($_[1][$idx] ne $nv)) + || ( $_[0][$idx] <=> $_[1][$idx] ) }; + $method = 'LabelValue'; } - elsif ( $grouping =~ /Annually/ ) { - $args{'FUNCTION'} = "SUBSTR($field,1,4)"; + elsif ( $order eq 'raw' ) { + push @SORT_OPS, sub { ($_[0][$idx]//'') cmp ($_[1][$idx]//'') }; + $method = 'RawValue'; } - } 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"); + elsif ( $order eq 'numeric raw' ) { + push @SORT_OPS, sub { $_[0][$idx] <=> $_[1][$idx] }; + $method = 'RawValue'; } else { - my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf->id, $cf_name); - @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content'); + $RT::Logger->error("Unknown sorting function '$order'"); + next; } + $_->[$idx] = $_->[0]->$method( $group_by->{'NAME'} ) for @data; } - return %args; + $self->{'items'} = [ + map $_->[0], + sort $by_multiple @data + ]; } - -# Override the AddRecord from DBI::SearchBuilder::Unique. id isn't id here -# wedon't want to disambiguate all the items with a count of 1. -sub AddRecord { +sub PostProcessRecords { my $self = shift; - my $record = shift; - push @{$self->{'items'}}, $record; - $self->{'rows'}++; + + my $info = $self->{'column_info'}; + foreach my $column ( values %$info ) { + next unless $column->{'TYPE'} eq 'statistic'; + if ( $column->{'META'}{'Calculate'} ) { + $self->CalculatePostFunction( $column ); + } + elsif ( $column->{'META'}{'SubValues'} ) { + $self->MapSubValues( $column ); + } + } } -1; +sub CalculatePostFunction { + my $self = shift; + my $info = shift; + my $code = $self->FindImplementationCode( $info->{'META'}{'Calculate'} ); + unless ( $code ) { + # TODO: fill in undefs + return; + } + my $column = $info->{'NAME'}; + + my $base_query = $self->Query; + foreach my $item ( @{ $self->{'items'} } ) { + $item->{'values'}{ lc $column } = $code->( + $self, + Query => join( + ' AND ', map "($_)", grep defined && length, $base_query, $item->Query, + ), + ); + $item->{'fetched'}{ lc $column } = 1; + } +} -# Gotta skip over RT::Tickets->Next, since it does all sorts of crazy magic we -# don't want. -sub Next { +sub MapSubValues { my $self = shift; - $self->RT::SearchBuilder::Next(@_); + my $info = shift; + + my $to = $info->{'NAME'}; + my $map = $info->{'MAP'}; + + foreach my $item ( @{ $self->{'items'} } ) { + my $dst = $item->{'values'}{ lc $to } = { }; + while (my ($k, $v) = each %{ $map } ) { + $dst->{ $k } = delete $item->{'values'}{ lc $v->{'NAME'} }; + # This mirrors the logic in RT::Record::__Value When that + # ceases tp use the UTF-8 flag as a character/byte + # distinction from the database, this can as well. + utf8::decode( $dst->{ $k } ) + if defined $dst->{ $k } + and not utf8::is_utf8( $dst->{ $k } ); + delete $item->{'fetched'}{ lc $v->{'NAME'} }; + } + $item->{'fetched'}{ lc $to } = 1; + } +} +sub GenerateDateFunction { + my $self = shift; + my %args = @_; + + my $tz; + if ( RT->Config->Get('ChartsTimezonesInDB') ) { + my $to = $self->CurrentUser->UserObj->Timezone + || RT->Config->Get('Timezone'); + $tz = { From => 'UTC', To => $to } + if $to && lc $to ne 'utc'; + } + + $args{'FUNCTION'} = $RT::Handle->DateTimeFunction( + Type => $args{'SUBKEY'}, + Field => $self->NotSetDateToNullFunction, + Timezone => $tz, + ); + return %args; } -sub NewItem { +sub GenerateCustomFieldFunction { my $self = shift; - return RT::Report::Tickets::Entry->new($RT::SystemUser); # $self->CurrentUser); + my %args = @_; + + my ($name) = ( $args{'SUBKEY'} =~ /^\{(.*)\}$/ ); + my $cf = RT::CustomField->new( $self->CurrentUser ); + $cf->Load($name); + unless ( $cf->id ) { + $RT::Logger->error("Couldn't load CustomField #$name"); + @args{qw(FUNCTION FIELD)} = ('NULL', undef); + } else { + my ($ticket_cf_alias, $cf_alias) = $self->_CustomFieldJoin($cf->id, $cf); + @args{qw(ALIAS FIELD)} = ($ticket_cf_alias, 'Content'); + } + return %args; } +sub GenerateUserFunction { + my $self = shift; + my %args = @_; + + my $column = $args{'SUBKEY'} || 'Name'; + my $u_alias = $self->{"_sql_report_$args{FIELD}_users_$column"} + ||= $self->Join( + TYPE => 'LEFT', + ALIAS1 => 'main', + FIELD1 => $args{'FIELD'}, + TABLE2 => 'Users', + FIELD2 => 'id', + ); + @args{qw(ALIAS FIELD)} = ($u_alias, $column); + return %args; +} -=head2 AddEmptyRows +sub GenerateWatcherFunction { + my $self = shift; + my %args = @_; -If we're grouping on a criterion we know how to add zero-value rows -for, do that. + my $type = $args{'FIELD'}; + $type = '' if $type eq 'Watcher'; -=cut + my $column = $args{'SUBKEY'} || 'Name'; -sub AddEmptyRows { - my $self = shift; - if ( $self->{'_group_by_field'} eq 'Status' ) { - my %has = map { $_->__Value('Status') => 1 } @{ $self->ItemsArrayRef || [] }; + my $u_alias = $self->{"_sql_report_watcher_users_alias_$type"}; + unless ( $u_alias ) { + my ($g_alias, $gm_alias); + ($g_alias, $gm_alias, $u_alias) = $self->_WatcherJoin( Name => $type ); + $self->{"_sql_report_watcher_users_alias_$type"} = $u_alias; + } + @args{qw(ALIAS FIELD)} = ($u_alias, $column); - foreach my $status ( grep !$has{$_}, RT::Queue->new($self->CurrentUser)->StatusArray ) { + return %args; +} - my $record = $self->NewItem; - $record->LoadFromHash( { - id => 0, - status => $status - } ); - $self->AddRecord($record); - } +sub DurationAsString { + my $self = shift; + my %args = @_; + my $v = $args{'VALUE'}; + unless ( ref $v ) { + return $self->loc("(no value)") unless defined $v && length $v; + return RT::Date->new( $self->CurrentUser )->DurationAsString( + $v, Show => 3, Short => 1 + ); } + + my $date = RT::Date->new( $self->CurrentUser ); + my %res = %$v; + foreach my $e ( values %res ) { + $e = $date->DurationAsString( $e, Short => 1, Show => 3 ) + if defined $e && length $e; + $e = $self->loc("(no value)") unless defined $e && length $e; + } + return \%res; } +sub LabelValueCode { + my $self = shift; + my $name = shift; -# 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/; + my $display = $self->ColumnInfo( $name )->{'META'}{'Display'}; + return undef unless $display; + return $self->FindImplementationCode( $display ); +} -# States -use constant VALUE => 1; -use constant AGGREG => 2; -use constant OP => 4; -use constant PAREN => 8; -use constant KEYWORD => 16; -sub _match { +sub FindImplementationCode { + my $self = shift; + my $value = shift; + my $silent = shift; + + my $code; + unless ( $value ) { + $RT::Logger->error("Value is not defined. Should be method name or code reference") + unless $silent; + return undef; + } + elsif ( !ref $value ) { + $code = $self->can( $value ); + unless ( $code ) { + $RT::Logger->error("No method $value in ". (ref $self || $self) ." class" ) + unless $silent; + return undef; + } + } + elsif ( ref( $value ) eq 'CODE' ) { + $code = $value; + } + else { + $RT::Logger->error("$value is not method name or code reference") + unless $silent; + return undef; + } + return $code; +} - # Case insensitive equality - my ( $y, $x ) = @_; - return 1 if $x =~ /^$y$/i; +sub Serialize { + my $self = shift; - # return 1 if ((lc $x) eq (lc $y)); # Why isnt this equiv? - return 0; + my %clone = %$self; +# current user, handle and column_info + delete @clone{'user', 'DBIxHandle', 'column_info'}; + $clone{'items'} = [ map $_->{'values'}, @{ $clone{'items'} || [] } ]; + $clone{'column_info'} = {}; + while ( my ($k, $v) = each %{ $self->{'column_info'} } ) { + $clone{'column_info'}{$k} = { %$v }; + delete $clone{'column_info'}{$k}{'META'}; + } + return \%clone; } -sub _ParseQuery { +sub Deserialize { 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 - use RT::Interface::Web::QueryBuilder::Tree; - $$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, - [ - $self->CurrentUser->loc( -"current: $current, want $want, Error near ->$val<- expecting a $token in '$string'\n" - ), - -1 - ]; - } + my $data = shift; + + $self->CleanSlate; + %$self = (%$self, %$data); + + $self->{'items'} = [ + map { my $r = $self->NewItem; $r->LoadFromHash( $_ ); $r } + @{ $self->{'items'} } + ]; + foreach my $e ( values %{ $self->{column_info} } ) { + $e->{'META'} = $e->{'TYPE'} eq 'grouping' + ? $GROUPINGS_META{ $e->{'INFO'} } + : $STATISTICS_META{ $e->{'INFO'}[1] } + } +} + + +sub FormatTable { + my $self = shift; + my %columns = @_; - # State Machine: - my $parentdepth = $depth; + my (@head, @body, @footer); - # Parens are highest priority - if ( $current & PAREN ) { - if ( $val eq "(" ) { - $depth++; + @head = ({ cells => []}); + foreach my $column ( @{ $columns{'Groups'} } ) { + push @{ $head[0]{'cells'} }, { type => 'head', value => $self->Label( $column ) }; + } - # make a new node that the clauses can be children of - $parentnode = RT::Interface::Web::QueryBuilder::Tree->new( $ea, $parentnode ); + my $i = 0; + while ( my $entry = $self->Next ) { + $body[ $i ] = { even => ($i+1)%2, cells => [] }; + $i++; + } + @footer = ({ even => ++$i%2, cells => []}); + + my $g = 0; + foreach my $column ( @{ $columns{'Groups'} } ) { + $i = 0; + my $last; + while ( my $entry = $self->Next ) { + my $value = $entry->LabelValue( $column ); + if ( !$last || $last->{'value'} ne $value ) { + push @{ $body[ $i++ ]{'cells'} }, $last = { type => 'label', value => $value }; + $last->{even} = $g++ % 2 + unless $column eq $columns{'Groups'}[-1]; } else { - $depth--; - $parentnode = $parentnode->getParent(); - $lastnode = $parentnode; + $i++; + $last->{rowspan} = ($last->{rowspan}||1) + 1; } - - $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; + } + push @{ $footer[0]{'cells'} }, { + type => 'label', + value => $self->loc('Total'), + colspan => scalar @{ $columns{'Groups'} }, + }; + + my $pick_color = do { + my @colors = RT->Config->Get("ChartColors"); + sub { $colors[ $_[0] % @colors - 1 ] } + }; + + my $function_count = 0; + foreach my $column ( @{ $columns{'Functions'} } ) { + $i = 0; + + my $info = $self->ColumnInfo( $column ); + + my @subs = (''); + if ( $info->{'META'}{'SubValues'} ) { + @subs = $self->FindImplementationCode( $info->{'META'}{'SubValues'} )->( + $self + ); } - 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]; + my %total; + unless ( $info->{'META'}{'NoTotals'} ) { + while ( my $entry = $self->Next ) { + my $raw = $entry->RawValue( $column ) || {}; + $raw = { '' => $raw } unless ref $raw; + $total{ $_ } += $raw->{ $_ } foreach grep $raw->{$_}, @subs; } - if ( $class ne 'INT' ) { - $val = "'$val'"; - } - - push @actions, [ $self->CurrentUser->loc("Unknown field: [_1]", $key), -1 ] unless $class; - - $want = PAREN | AGGREG; - } - else { - push @actions, [ $self->CurrentUser->loc("I'm lost"), -1 ]; + @subs = grep $total{$_}, @subs + unless $info->{'META'}{'NoHideEmpty'}; } - if ( $current & VALUE ) { - if ( $key =~ /^CF./ ) { - $key = "'" . $key . "'"; + my $label = $self->Label( $column ); + + unless (@subs) { + while ( my $entry = $self->Next ) { + push @{ $body[ $i++ ]{'cells'} }, { + type => 'value', + value => undef, + query => $entry->Query, + }; } - my $clause = { - Key => $key, - Op => $op, - Value => $val + push @{ $head[0]{'cells'} }, { + type => 'head', + value => $label, + rowspan => scalar @head, + color => $pick_color->(++$function_count), }; + push @{ $footer[0]{'cells'} }, { type => 'value', value => undef }; + next; + } - # explicity add a child to it - $lastnode = RT::Interface::Web::QueryBuilder::Tree->new( $clause, $parentnode ); - $lastnode->getParent()->setNodeValue($ea); + if ( @subs > 1 && @head == 1 ) { + $_->{rowspan} = 2 foreach @{ $head[0]{'cells'} }; + } - ( $ea, $key, $op, $value ) = ( "", "", "", "" ); + if ( @subs == 1 ) { + push @{ $head[0]{'cells'} }, { + type => 'head', + value => $label, + rowspan => scalar @head, + color => $pick_color->(++$function_count), + }; + } else { + push @{ $head[0]{'cells'} }, { type => 'head', value => $label, colspan => scalar @subs }; + push @{ $head[1]{'cells'} }, { type => 'head', value => $_, color => $pick_color->(++$function_count) } + foreach @subs; } - $last = $current; - } # while + while ( my $entry = $self->Next ) { + my $query = $entry->Query; + my $value = $entry->LabelValue( $column ) || {}; + $value = { '' => $value } unless ref $value; + foreach my $e ( @subs ) { + push @{ $body[ $i ]{'cells'} }, { + type => 'value', + value => $value->{ $e }, + query => $query, + }; + } + $i++; + } - push @actions, [ $self->CurrentUser->loc("Incomplete query"), -1 ] - unless ( ( $want | PAREN ) || ( $want | KEYWORD ) ); + unless ( $info->{'META'}{'NoTotals'} ) { + my $total_code = $self->LabelValueCode( $column ); + foreach my $e ( @subs ) { + my $total = $total{ $e }; + $total = $total_code->( $self, %$info, VALUE => $total ) + if $total_code; + push @{ $footer[0]{'cells'} }, { type => 'value', value => $total }; + } + } + else { + foreach my $e ( @subs ) { + push @{ $footer[0]{'cells'} }, { type => 'value', value => undef }; + } + } + } - push @actions, [ $self->CurrentUser->loc("Incomplete Query"), -1 ] - unless ( $last && ( $last | PAREN ) || ( $last || VALUE ) ); + return thead => \@head, tbody => \@body, tfoot => \@footer; +} - # This will never happen, because the parser will complain - push @actions, [ $self->CurrentUser->loc("Mismatched parentheses"), -1 ] - unless $depth == 1; -}; +RT::Base->_ImportOverlays(); 1;