%# BEGIN BPS TAGGED BLOCK {{{ %# %# COPYRIGHT: %# %# 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 %# 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> $Cache => undef $Query => "id > 0" @GroupBy => () $ChartStyle => 'bar+table+sql' @ChartFunction => 'COUNT' $Width => undef $Height => undef <%init> use GD; use GD::Text; my %font_config = RT->Config->Get('ChartFont'); my $font = $font_config{ $session{CurrentUser}->UserObj->Lang || '' } || $font_config{'others'}; s/\D//g for grep defined, $Width, $Height; $Width ||= 600; $Height ||= ($ChartStyle =~ /\bpie\b/ ? $Width : 400); $Height = $Width if $ChartStyle =~ /\bpie\b/; my $plot_error = sub { my $text = shift; my ($plot, $error); my $create_plot = sub { my ($width, $height) = @_; my $plot = GD::Image->new($width => $height); $plot->colorAllocate(255, 255, 255); # background my $black = $plot->colorAllocate(0, 0, 0); require GD::Text::Wrap; my $error = GD::Text::Wrap->new($plot, color => $black, text => $text, align => "left", width => $width - 20, preserve_nl => 1, ); $error->set_font( $font, 16 ); return ($plot, $error); }; ($plot, $error) = $create_plot->($Width, $Height); my $text_height = ($error->get_bounds(0, 0))[3]; # GD requires us to replot it all with the new height ($plot, $error) = $create_plot->($Width, $text_height + 20); $error->draw(10, 10); $m->comp( 'SELF:Plot', plot => $plot, %ARGS ); }; use RT::Report::Tickets; my $report = RT::Report::Tickets->new( $session{'CurrentUser'} ); my %columns; if ( $Cache and my $data = delete $session{'charts_cache'}{ $Cache } ) { %columns = %{ $data->{'columns'} }; $report->Deserialize( $data->{'report'} ); $session{'i'}++; } else { %columns = $report->SetupGroupings( Query => $Query, GroupBy => \@GroupBy, Function => \@ChartFunction, ); $report->SortEntries; } my @data = ([],[]); my $max_value = 0; my $min_value; my $max_key_length = 0; while ( my $entry = $report->Next ) { push @{ $data[0] }, [ map $entry->LabelValue( $_ ), @{ $columns{'Groups'} } ]; my @values; foreach my $column ( @{ $columns{'Functions'} } ) { my $v = $entry->RawValue( $column ); unless ( ref $v ) { push @values, $v; next; } my @subs = $report->FindImplementationCode( $report->ColumnInfo( $column )->{'META'}{'SubValues'} )->( $report ); push @values, map $v->{$_}, @subs; } my $i = 0; push @{ $data[++$i] }, $_ foreach @values; foreach my $v ( @values ) { $max_value = $v if $max_value < $v; $min_value = $v if !defined $min_value || $min_value > $v; } } $ChartStyle =~ s/\bpie\b/bar/ if @data > 2; my $chart_class; if ($ChartStyle =~ /\bpie\b/) { require GD::Graph::pie; $chart_class = "GD::Graph::pie"; } else { require GD::Graph::bars; $chart_class = "GD::Graph::bars"; } # Pie charts don't like having no input, so we show a special image # that indicates an error message. Because this is used in an # context, it can't be a simple error message. Without this check, # the chart will just be a non-loading image. unless ( $report->Count ) { return $plot_error->(loc("No tickets found.")); } my $chart = $chart_class->new( $Width => $Height ); my %chart_options; if ($chart_class eq "GD::Graph::bars") { my $count = @{ $data[0] }; $chart_options{'bar_spacing'} = $count > 30 ? 1 : $count > 20 ? 2 : $count > 10 ? 3 : 5 ; if ( my $code = $report->LabelValueCode( $columns{'Functions'}[0] ) ) { my %info = %{ $report->ColumnInfo( $columns{'Functions'}[0] ) }; $chart_options{'values_format'} = $chart_options{'y_number_format'} = sub { return $code->($report, %info, VALUE => shift ); }; } $report->GotoFirstItem; # normalize min/max values to graph boundaries { my $integer = 1; $integer = 0 for grep $_ ne int $_, $min_value, $max_value; $max_value *= $max_value > 0 ? 1.1 : 0.9 if $max_value; $min_value *= $min_value > 0 ? 0.9 : 1.1 if $min_value; if ($integer) { $max_value = int($max_value + ($max_value > 0? 1 : 0) ); $min_value = int($min_value + ($min_value < 0? -1 : 0) ); my $span = abs($max_value - $min_value); $max_value += 5 - ($span % 5); } $chart_options{'y_label_skip'} = 2; $chart_options{'y_tick_number'} = 10; } my $text_size = sub { my ($size, $text) = (@_); my $font_handle = GD::Text::Align->new( $chart->get('graph'), valign => 'top', 'halign' => 'center', ); $font_handle->set_font($font, $size); $font_handle->set_text($text); return $font_handle; }; my $fitter = sub { my %args = @_; foreach my $font_size ( @{$args{'sizes'}} ) { my $line_height = $text_size->($font_size, 'Q')->get('height'); my $keyset_height = $line_height; if ( ref $args{data}->[0] ) { $keyset_height = $text_size->($font_size, join "\n", ('Q')x scalar @{ $args{data}->[0] }) ->get('height'); } my $status = 1; foreach my $e ( @{ $args{data} } ) { $status = $args{'cb'}->( element => $e, size => $font_size, line_height => $line_height, keyset_height => $keyset_height, ); last unless $status; } next unless $status; return $font_size; } return 0; }; # try to fit in labels on X axis values, aka key { # we have several labels layouts: # 1) horizontal, one line per label # 2) horizontal, multi-line - doesn't work, GD::Chart bug # 3) vertical, one line # 4) vertical, multi-line my %can = ( 'horizontal, one line' => 1, 'vertical, one line' => 1, 'vertical, multi line' => @{$data[0][0]} > 1, ); my $x_space_for_label = $Width*0.8/($count+1.5); my $y_space_for_label = $Height*0.4; my $found_solution = $fitter->( sizes => [12,11,10], data => $data[0], cb => sub { my %args = @_; # if horizontal space doesn't allow us to fit one vertical line, # then we need smaller font return 0 if $args{'line_height'} > $x_space_for_label; my $width = $text_size->( $args{'size'}, join ' - ', @{ $args{'element'} } ) ->get('width'); if ( $width > $x_space_for_label ) { $can{'horizontal, one line'} = 0; } if ( $width > $y_space_for_label ) { $can{'vertical, one line'} = 0; } if ( $args{'keyset_height'} >= $x_space_for_label ) { $can{'vertical, multi line'} = 0; } if ( $can{'vertical, multi line'} ) { my $width = $text_size->( $args{'size'}, join "\n", @{ $args{'element'} } ) ->get('width'); if ( $width > $y_space_for_label ) { $can{'vertical, multi line'} = 0; } } return 0 unless grep $_, values %can; return 1; }, ); if ( $found_solution ) { $chart_options{'x_axis_font'} = [$font, $found_solution]; if ( $can{'horizontal, one line'} ) { $chart_options{'x_labels_vertical'} = 0; $_ = join ' - ', @$_ foreach @{$data[0]}; } elsif ( $can{'vertical, multi line'} ) { $chart_options{'x_labels_vertical'} = 1; $_ = join "\n", @$_ foreach @{$data[0]}; } else { $chart_options{'x_labels_vertical'} = 1; $_ = join " - ", @$_ foreach @{$data[0]}; } } else { my $font_handle = $text_size->(10, 'Q'); my $line_height = $font_handle->get('height'); if ( $line_height > $x_space_for_label ) { $Width *= $line_height/$x_space_for_label; $Width = int( $Width+1 ); } $_ = join " - ", @$_ foreach @{$data[0]}; my $max_text_width = 0; foreach (@{$data[0]}) { $font_handle->set_text($_); my $width = $font_handle->get('width'); $max_text_width = $width if $width > $max_text_width; } if ( $max_text_width > $Height*0.4 ) { $Height = int($max_text_width / 0.4 + 1); } $chart_options{'x_labels_vertical'} = 1; $chart_options{'x_axis_font'} = [$font, 10]; } } # use the same size for y axis labels { $chart_options{'y_axis_font'} = $chart_options{'x_axis_font'}; } # try to fit in values above bars { # 0.8 is guess, labels for ticks on Y axis can be wider # 1.5 for paddings around bars that GD::Graph adds my $x_space_for_label = $Width*0.8/($count*(@data - 1)+1.5); my %can = ( 'horizontal, one line' => 1, 'vertical, one line' => 1, ); my %seen; my $found_solution = $fitter->( sizes => [ grep $_ <= $chart_options{'x_axis_font'}[1], 12, 11, 10, 9 ], data => [ map {@$_} @data[1..(@data-1)] ], cb => sub { my %args = @_; # if horizontal space doesn't allow us to fit one vertical line, # then we need smaller font return 0 if $args{'line_height'} > $x_space_for_label; my $value = $args{'element'}; $value = $chart_options{'values_format'}->($value) if $chart_options{'values_format'}; return 1 if $seen{$value}++; my $width = $text_size->( $args{'size'}, $value )->get('width'); if ( $width > $x_space_for_label ) { $can{'horizontal, one line'} = 0; } my $y_space_for_label; if ($max_value == $min_value) { $y_space_for_label = 0; } else { $y_space_for_label = $Height * 0.6 *( 1 - ($args{'element'}-$min_value)/($max_value-$min_value) ); } if ( $width > $y_space_for_label ) { $can{'vertical, one line'} = 0; } return 0 unless grep $_, values %can; return 1; }, ); $chart_options{'show_values'} = 1; $chart_options{'hide_overlapping_values'} = 1; if ( $found_solution ) { $chart_options{'values_font'} = [ $font, $found_solution ], $chart_options{'values_space'} = 2; $chart_options{'values_vertical'} = $can{'horizontal, one line'} ? 0 : 1; } else { $chart_options{'values_font'} = [ $font, 9 ], $chart_options{'values_space'} = 1; $chart_options{'values_vertical'} = 1; } } %chart_options = ( %chart_options, x_label => join( ' - ', map $report->Label( $_ ), @{ $columns{'Groups'} } ), x_label_position => 0.6, y_label => $report->Label( $columns{'Functions'}[0] ), y_label_position => 0.6, # use a top margin enough to display values over the top line if needed t_margin => 18, # the following line to make sure there's enough space for values to show y_max_value => $max_value, y_min_value => $min_value, # if there're too many bars or at least one key is too long, use vertical bargroup_spacing => $chart_options{'bar_spacing'}*5, ); } else { my $i = 0; while ( my $entry = $report->Next ) { push @{ $data[0][$i++] }, $entry->LabelValue( $columns{'Functions'}[0] ); } $_ = join ' - ', @$_ foreach @{$data[0]}; } if ($chart->get('width') != $Width || $chart->get('height') != $Height ) { $chart = $chart_class->new( $Width => $Height ); } %chart_options = ( '3d' => 0, title_font => [ $font, 16 ], legend_font => [ $font, 16 ], x_label_font => [ $font, 14 ], y_label_font => [ $font, 14 ], label_font => [ $font, 14 ], y_axis_font => [ $font, 12 ], values_font => [ $font, 12 ], value_font => [ $font, 12 ], %chart_options, ); foreach my $opt ( grep /_font$/, keys %chart_options ) { my $v = delete $chart_options{$opt}; next unless my $can = $chart->can("set_$opt"); $can->($chart, @$v); } $chart->set(%chart_options) if keys %chart_options; $chart->{dclrs} = [ RT->Config->Get("ChartColors") ]; { no warnings 'redefine'; *GD::Graph::pick_data_clr = sub { my $self = shift; my $color_hex = $self->{dclrs}[ $_[0] % @{ $self->{dclrs} } - 1 ]; return map { hex } ( $color_hex =~ /(..)(..)(..)/ ); }; } if (my $plot = eval { $chart->plot( \@data ) }) { $m->comp( 'SELF:Plot', plot => $plot, %ARGS ); } else { my $error = join "\n", grep defined && length, $chart->error, $@; $plot_error->(loc("Error plotting chart: [_1]", $error)); } <%METHOD Plot> <%ARGS> $plot => undef <%INIT> my @types = ('png', 'gif'); for my $type (@types) { $plot->can($type) or next; $r->content_type("image/$type"); $m->out( $plot->$type ); $m->abort(); } die "Your GD library appears to support none of the following image types: " . join(', ', @types);