rt/share/html/Search/Chart

   1 %# BEGIN BPS TAGGED BLOCK {{{
   2 %#
   3 %# COPYRIGHT:
   4 %#
   5 %# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
   6 %#                                          <sales@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 <%args>
  49 $Cache => undef
  50 $Query => "id > 0"
  51 @GroupBy => ()
  52 $ChartStyle => 'bar+table+sql'
  53 @ChartFunction => 'COUNT'
  54 $Width  => undef
  55 $Height => undef
  56 </%args>
  57 <%init>
  58 use GD;
  59 use GD::Text;
  60
  61 my %font_config = RT->Config->Get('ChartFont');
  62 my $font = $font_config{ $session{CurrentUser}->UserObj->Lang || '' }
  63     || $font_config{'others'};
  64
  65 s/\D//g for grep defined, $Width, $Height;
  66 $Width  ||= 600;
  67 $Height ||= ($ChartStyle =~ /\bpie\b/ ? $Width : 400);
  68 $Height = $Width if $ChartStyle =~ /\bpie\b/;
  69
  70 my $plot_error = sub {
  71     my $text = shift;
  72     my ($plot, $error);
  73
  74     my $create_plot = sub {
  75         my ($width, $height) = @_;
  76
  77         my $plot = GD::Image->new($width => $height);
  78         $plot->colorAllocate(255, 255, 255); # background
  79         my $black = $plot->colorAllocate(0, 0, 0);
  80
  81         require GD::Text::Wrap;
  82         my $error = GD::Text::Wrap->new($plot,
  83             color       => $black,
  84             text        => $text,
  85             align       => "left",
  86             width       => $width - 20,
  87             preserve_nl => 1,
  88         );
  89         $error->set_font( $font, 16 );
  90         return ($plot, $error);
  91     };
  92
  93     ($plot, $error) = $create_plot->($Width, $Height);
  94     my $text_height = ($error->get_bounds(0, 0))[3];
  95
  96     # GD requires us to replot it all with the new height
  97     ($plot, $error) = $create_plot->($Width, $text_height + 20);
  98
  99     $error->draw(10, 10);
 100     $m->comp( 'SELF:Plot', plot => $plot, %ARGS );
 101 };
 102
 103 use RT::Report::Tickets;
 104 my $report = RT::Report::Tickets->new( $session{'CurrentUser'} );
 105
 106 my %columns;
 107 if ( $Cache and my $data = delete $session{'charts_cache'}{ $Cache } ) {
 108     %columns = %{ $data->{'columns'} };
 109     $report->Deserialize( $data->{'report'} );
 110     $session{'i'}++;
 111 } else {
 112     %columns = $report->SetupGroupings(
 113         Query => $Query,
 114         GroupBy => \@GroupBy,
 115         Function => \@ChartFunction,
 116     );
 117
 118     $report->SortEntries;
 119 }
 120
 121 my @data = ([],[]);
 122 my $max_value = 0;
 123 my $min_value;
 124 my $max_key_length = 0;
 125 while ( my $entry = $report->Next ) {
 126     push @{ $data[0] }, [ map $entry->LabelValue( $_ ), @{ $columns{'Groups'} } ];
 127
 128     my @values;
 129     foreach my $column ( @{ $columns{'Functions'} } ) {
 130         my $v = $entry->RawValue( $column );
 131         unless ( ref $v ) {
 132             push @values, $v;
 133             next;
 134         }
 135
 136         my @subs = $report->FindImplementationCode(
 137             $report->ColumnInfo( $column )->{'META'}{'SubValues'}
 138         )->( $report );
 139         push @values, map $v->{$_}, @subs;
 140     }
 141
 142     my $i = 0;
 143     push @{ $data[++$i] }, $_ foreach @values;
 144
 145     foreach my $v ( @values ) {
 146         $max_value = $v if $max_value < $v;
 147         $min_value = $v if !defined $min_value || $min_value > $v;
 148     }
 149 }
 150
 151 $ChartStyle =~ s/\bpie\b/bar/ if @data > 2;
 152
 153 my $chart_class;
 154 if ($ChartStyle =~ /\bpie\b/) {
 155     require GD::Graph::pie;
 156     $chart_class = "GD::Graph::pie";
 157 } else {
 158     require GD::Graph::bars;
 159     $chart_class = "GD::Graph::bars";
 160 }
 161
 162 # Pie charts don't like having no input, so we show a special image
 163 # that indicates an error message. Because this is used in an <img>
 164 # context, it can't be a simple error message. Without this check,
 165 # the chart will just be a non-loading image.
 166 unless ( $report->Count ) {
 167     return $plot_error->(loc("No tickets found."));
 168 }
 169
 170 my $chart = $chart_class->new( $Width => $Height );
 171
 172 my %chart_options;
 173 if ($chart_class eq "GD::Graph::bars") {
 174     my $count = @{ $data[0] };
 175     $chart_options{'bar_spacing'} =
 176         $count > 30 ? 1
 177         : $count > 20 ? 2
 178         : $count > 10 ? 3
 179         : 5
 180     ;
 181     if ( my $code = $report->LabelValueCode( $columns{'Functions'}[0] ) ) {
 182         my %info = %{ $report->ColumnInfo( $columns{'Functions'}[0] ) };
 183         $chart_options{'values_format'} = $chart_options{'y_number_format'} = sub {
 184             return $code->($report, %info, VALUE => shift );
 185         };
 186     }
 187     $report->GotoFirstItem;
 188
 189     # normalize min/max values to graph boundaries
 190     {
 191         my $integer = 1;
 192         $integer = 0 for grep $_ ne int $_, $min_value, $max_value;
 193
 194         $max_value *= $max_value > 0 ? 1.1 : 0.9
 195             if $max_value;
 196         $min_value *= $min_value > 0 ? 0.9 : 1.1
 197             if $min_value;
 198
 199         if ($integer) {
 200             $max_value = int($max_value + ($max_value > 0? 1 : 0) );
 201             $min_value = int($min_value + ($min_value < 0? -1 : 0) );
 202
 203             my $span = abs($max_value - $min_value);
 204             $max_value += 5 - ($span % 5);
 205         }
 206         $chart_options{'y_label_skip'} = 2;
 207         $chart_options{'y_tick_number'} = 10;
 208     }
 209     my $text_size = sub {
 210         my ($size, $text) = (@_);
 211         my $font_handle = GD::Text::Align->new(
 212             $chart->get('graph'), valign => 'top', 'halign' => 'center',
 213         );
 214         $font_handle->set_font($font, $size);
 215         $font_handle->set_text($text);
 216         return $font_handle;
 217     };
 218
 219     my $fitter = sub {
 220         my %args = @_;
 221
 222         foreach my $font_size ( @{$args{'sizes'}} ) {
 223             my $line_height = $text_size->($font_size, 'Q')->get('height');
 224
 225             my $keyset_height = $line_height;
 226             if ( ref $args{data}->[0] ) {
 227                 $keyset_height = $text_size->($font_size, join "\n", ('Q')x scalar @{ $args{data}->[0] })
 228                     ->get('height');
 229             }
 230
 231             my $status = 1;
 232             foreach my $e ( @{ $args{data} } ) {
 233                 $status = $args{'cb'}->(
 234                     element => $e,
 235                     size => $font_size,
 236                     line_height => $line_height,
 237                     keyset_height => $keyset_height,
 238                 );
 239                 last unless $status;
 240             }
 241             next unless $status;
 242
 243             return $font_size;
 244         }
 245         return 0;
 246     };
 247
 248     # try to fit in labels on X axis values, aka key
 249     {
 250         # we have several labels layouts:
 251         # 1) horizontal, one line per label
 252         # 2) horizontal, multi-line - doesn't work, GD::Chart bug
 253         # 3) vertical, one line
 254         # 4) vertical, multi-line
 255         my %can = (
 256             'horizontal, one line' => 1,
 257             'vertical, one line' => 1,
 258             'vertical, multi line' => @{$data[0][0]} > 1,
 259         );
 260
 261         my $x_space_for_label = $Width*0.8/($count+1.5);
 262         my $y_space_for_label = $Height*0.4;
 263
 264         my $found_solution = $fitter->(
 265             sizes => [12,11,10],
 266             data  => $data[0],
 267             cb => sub {
 268                 my %args = @_;
 269
 270                 # if horizontal space doesn't allow us to fit one vertical line,
 271                 # then we need smaller font
 272                 return 0 if $args{'line_height'} > $x_space_for_label;
 273
 274                 my $width = $text_size->( $args{'size'}, join ' - ', @{ $args{'element'} } )
 275                     ->get('width');
 276
 277                 if ( $width > $x_space_for_label ) {
 278                     $can{'horizontal, one line'} = 0;
 279                 }
 280                 if ( $width > $y_space_for_label ) {
 281                     $can{'vertical, one line'} = 0;
 282                 }
 283                 if ( $args{'keyset_height'} >= $x_space_for_label ) {
 284                     $can{'vertical, multi line'} = 0;
 285                 }
 286                 if ( $can{'vertical, multi line'} ) {
 287                     my $width = $text_size->( $args{'size'}, join "\n", @{ $args{'element'} } )
 288                         ->get('width');
 289                     if ( $width > $y_space_for_label ) {
 290                         $can{'vertical, multi line'} = 0;
 291                     }
 292                 }
 293                 return 0 unless grep $_, values %can;
 294                 return 1;
 295             },
 296         );
 297         if ( $found_solution ) {
 298             $chart_options{'x_axis_font'} = [$font, $found_solution];
 299
 300             if ( $can{'horizontal, one line'} ) {
 301                 $chart_options{'x_labels_vertical'} = 0;
 302                 $_ = join ' - ', @$_ foreach @{$data[0]};
 303             }
 304             elsif ( $can{'vertical, multi line'} ) {
 305                 $chart_options{'x_labels_vertical'} = 1;
 306                 $_ = join "\n", @$_ foreach @{$data[0]};
 307             }
 308             else {
 309                 $chart_options{'x_labels_vertical'} = 1;
 310                 $_ = join " - ", @$_ foreach @{$data[0]};
 311             }
 312         }
 313         else {
 314             my $font_handle = $text_size->(10, 'Q');
 315             my $line_height = $font_handle->get('height');
 316             if ( $line_height > $x_space_for_label ) {
 317                 $Width *= $line_height/$x_space_for_label;
 318                 $Width = int( $Width+1 );
 319             }
 320
 321             $_ = join " - ", @$_ foreach @{$data[0]};
 322
 323             my $max_text_width = 0;
 324             foreach (@{$data[0]}) {
 325                 $font_handle->set_text($_);
 326                 my $width = $font_handle->get('width');
 327                 $max_text_width = $width if $width > $max_text_width;
 328             }
 329             if ( $max_text_width > $Height*0.4 ) {
 330                 $Height = int($max_text_width / 0.4 + 1);
 331             }
 332
 333             $chart_options{'x_labels_vertical'} = 1;
 334             $chart_options{'x_axis_font'} = [$font, 10];
 335         }
 336     }
 337
 338     # use the same size for y axis labels
 339     {
 340         $chart_options{'y_axis_font'} = $chart_options{'x_axis_font'};
 341     }
 342
 343     # try to fit in values above bars
 344     {
 345         # 0.8 is guess, labels for ticks on Y axis can be wider
 346         # 1.5 for paddings around bars that GD::Graph adds
 347         my $x_space_for_label = $Width*0.8/($count*(@data - 1)+1.5);
 348
 349         my %can = (
 350             'horizontal, one line' => 1,
 351             'vertical, one line' => 1,
 352         );
 353
 354         my %seen;
 355         my $found_solution = $fitter->(
 356             sizes => [ grep $_ <= $chart_options{'x_axis_font'}[1], 12, 11, 10, 9 ],
 357             data => [ map {@$_} @data[1..(@data-1)] ],
 358             cb => sub {
 359                 my %args = @_;
 360
 361                 # if horizontal space doesn't allow us to fit one vertical line,
 362                 # then we need smaller font
 363                 return 0 if $args{'line_height'} > $x_space_for_label;
 364
 365                 my $value = $args{'element'};
 366                 $value = $chart_options{'values_format'}->($value)
 367                     if $chart_options{'values_format'};
 368                 return 1 if $seen{$value}++;
 369
 370                 my $width = $text_size->( $args{'size'}, $value )->get('width');
 371                 if ( $width > $x_space_for_label ) {
 372                     $can{'horizontal, one line'} = 0;
 373                 }
 374                 my $y_space_for_label;
 375                 if ($max_value == $min_value) {
 376                     $y_space_for_label = 0;
 377                 }
 378                 else {
 379                     $y_space_for_label = $Height * 0.6
 380                         *( 1 - ($args{'element'}-$min_value)/($max_value-$min_value) );
 381                 }
 382                 if ( $width > $y_space_for_label ) {
 383                     $can{'vertical, one line'} = 0;
 384                 }
 385                 return 0 unless grep $_, values %can;
 386                 return 1;
 387             },
 388         );
 389         $chart_options{'show_values'} = 1;
 390         $chart_options{'hide_overlapping_values'} = 1;
 391         if ( $found_solution ) {
 392             $chart_options{'values_font'} = [ $font, $found_solution ],
 393             $chart_options{'values_space'} = 2;
 394             $chart_options{'values_vertical'} =
 395                 $can{'horizontal, one line'} ? 0 : 1;
 396         } else {
 397             $chart_options{'values_font'} = [ $font, 9 ],
 398             $chart_options{'values_space'} = 1;
 399             $chart_options{'values_vertical'} = 1;
 400         }
 401     }
 402
 403     %chart_options = (
 404         %chart_options,
 405         x_label => join( ' - ', map $report->Label( $_ ), @{ $columns{'Groups'} } ),
 406         x_label_position => 0.6,
 407         y_label => $report->Label( $columns{'Functions'}[0] ),
 408         y_label_position => 0.6,
 409 # use a top margin enough to display values over the top line if needed
 410         t_margin => 18,
 411 # the following line to make sure there's enough space for values to show
 412         y_max_value => $max_value,
 413         y_min_value => $min_value,
 414 # if there're too many bars or at least one key is too long, use vertical
 415         bargroup_spacing => $chart_options{'bar_spacing'}*5,
 416     );
 417 }
 418 else {
 419     my $i = 0;
 420     while ( my $entry = $report->Next ) {
 421         push @{ $data[0][$i++] }, $entry->LabelValue( $columns{'Functions'}[0] );
 422     }
 423     $_ = join ' - ', @$_ foreach @{$data[0]};
 424 }
 425
 426 if ($chart->get('width') != $Width || $chart->get('height') != $Height ) {
 427     $chart = $chart_class->new( $Width => $Height );
 428 }
 429
 430 %chart_options = (
 431     '3d'         => 0,
 432     title_font   => [ $font, 16 ],
 433     legend_font  => [ $font, 16 ],
 434     x_label_font => [ $font, 14 ],
 435     y_label_font => [ $font, 14 ],
 436     label_font   => [ $font, 14 ],
 437     y_axis_font  => [ $font, 12 ],
 438     values_font  => [ $font, 12 ],
 439     value_font   => [ $font, 12 ],
 440     %chart_options,
 441 );
 442
 443 foreach my $opt ( grep /_font$/, keys %chart_options ) {
 444     my $v = delete $chart_options{$opt};
 445     next unless my $can = $chart->can("set_$opt");
 446
 447     $can->($chart, @$v);
 448 }
 449 $chart->set(%chart_options) if keys %chart_options;
 450
 451 $chart->{dclrs} = [ RT->Config->Get("ChartColors") ];
 452
 453 {
 454     no warnings 'redefine';
 455     *GD::Graph::pick_data_clr = sub {
 456         my $self      = shift;
 457         my $color_hex = $self->{dclrs}[ $_[0] % @{ $self->{dclrs} } - 1 ];
 458         return map { hex } ( $color_hex =~ /(..)(..)(..)/ );
 459     };
 460 }
 461
 462 if (my $plot = eval { $chart->plot( \@data ) }) {
 463     $m->comp( 'SELF:Plot', plot => $plot, %ARGS );
 464 } else {
 465     my $error = join "\n", grep defined && length, $chart->error, $@;
 466     $plot_error->(loc("Error plotting chart: [_1]", $error));
 467 }
 468 </%init>
 469
 470 <%METHOD Plot>
 471 <%ARGS>
 472 $plot => undef
 473 </%ARGS>
 474 <%INIT>
 475 my @types = ('png', 'gif');
 476 for my $type (@types) {
 477     $plot->can($type)
 478         or next;
 479
 480     $r->content_type("image/$type");
 481     $m->out( $plot->$type );
 482     $m->abort();
 483 }
 484
 485 die "Your GD library appears to support none of the following image types: " . join(', ', @types);
 486 </%INIT>
 487
 488 </%METHOD>