Master to 4.2.8
[usit-rt.git] / share / html / Search / Chart
1 %# BEGIN BPS TAGGED BLOCK {{{
2 %#
3 %# COPYRIGHT:
4 %#
5 %# This software is Copyright (c) 1996-2014 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'
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 eq 'pie' ? $Width : 400);
68 $Height = $Width if $ChartStyle eq 'pie';
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 = 'bar' if @data > 2;
152
153 my $chart_class;
154 if ($ChartStyle eq 'pie') {
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 = $Height * 0.6
375                     *( 1 - ($args{'element'}-$min_value)/($max_value-$min_value) );
376                 if ( $width > $y_space_for_label ) {
377                     $can{'vertical, one line'} = 0;
378                 }
379                 return 0 unless grep $_, values %can;
380                 return 1;
381             },
382         );
383         $chart_options{'show_values'} = 1;
384         $chart_options{'hide_overlapping_values'} = 1;
385         if ( $found_solution ) {
386             $chart_options{'values_font'} = [ $font, $found_solution ],
387             $chart_options{'values_space'} = 2;
388             $chart_options{'values_vertical'} =
389                 $can{'horizontal, one line'} ? 0 : 1;
390         } else {
391             $chart_options{'values_font'} = [ $font, 9 ],
392             $chart_options{'values_space'} = 1;
393             $chart_options{'values_vertical'} = 1;
394         }
395     }
396
397     %chart_options = (
398         %chart_options,
399         x_label => join( ' - ', map $report->Label( $_ ), @{ $columns{'Groups'} } ),
400         x_label_position => 0.6,
401         y_label => $report->Label( $columns{'Functions'}[0] ),
402         y_label_position => 0.6,
403 # use a top margin enough to display values over the top line if needed
404         t_margin => 18,
405 # the following line to make sure there's enough space for values to show
406         y_max_value => $max_value,
407         y_min_value => $min_value,
408 # if there're too many bars or at least one key is too long, use vertical
409         bargroup_spacing => $chart_options{'bar_spacing'}*5,
410     );
411 }
412 else {
413     my $i = 0;
414     while ( my $entry = $report->Next ) {
415         push @{ $data[0][$i++] }, $entry->LabelValue( $columns{'Functions'}[0] );
416     }
417     $_ = join ' - ', @$_ foreach @{$data[0]};
418 }
419
420 if ($chart->get('width') != $Width || $chart->get('height') != $Height ) {
421     $chart = $chart_class->new( $Width => $Height );
422 }
423
424 %chart_options = (
425     '3d'         => 0,
426     title_font   => [ $font, 16 ],
427     legend_font  => [ $font, 16 ],
428     x_label_font => [ $font, 14 ],
429     y_label_font => [ $font, 14 ],
430     label_font   => [ $font, 14 ],
431     y_axis_font  => [ $font, 12 ],
432     values_font  => [ $font, 12 ],
433     value_font   => [ $font, 12 ],
434     %chart_options,
435 );
436
437 foreach my $opt ( grep /_font$/, keys %chart_options ) {
438     my $v = delete $chart_options{$opt};
439     next unless my $can = $chart->can("set_$opt");
440
441     $can->($chart, @$v);
442 }
443 $chart->set(%chart_options) if keys %chart_options;
444
445 $chart->{dclrs} = [ RT->Config->Get("ChartColors") ];
446
447 {
448     no warnings 'redefine';
449     *GD::Graph::pick_data_clr = sub {
450         my $self      = shift;
451         my $color_hex = $self->{dclrs}[ $_[0] % @{ $self->{dclrs} } - 1 ];
452         return map { hex } ( $color_hex =~ /(..)(..)(..)/ );
453     };
454 }
455
456 if (my $plot = eval { $chart->plot( \@data ) }) {
457     $m->comp( 'SELF:Plot', plot => $plot, %ARGS );
458 } else {
459     my $error = join "\n", grep defined && length, $chart->error, $@;
460     $plot_error->(loc("Error plotting chart: [_1]", $error));
461 }
462 </%init>
463
464 <%METHOD Plot>
465 <%ARGS>
466 $plot => undef
467 </%ARGS>
468 <%INIT>
469 my @types = ('png', 'gif');
470 for my $type (@types) {
471     $plot->can($type)
472         or next;
473
474     $r->content_type("image/$type");
475     $m->out( $plot->$type );
476     $m->abort();
477 }
478
479 die "Your GD library appears to support none of the following image types: " . join(', ', @types);
480 </%INIT>
481
482 </%METHOD>