Upgrade to 4.2.2
[usit-rt.git] / share / html / Search / Chart
CommitLineData
84fb5b46
MKG
1%# BEGIN BPS TAGGED BLOCK {{{
2%#
3%# COPYRIGHT:
4%#
320f0092 5%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
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>
af59614d 49$Cache => undef
84fb5b46 50$Query => "id > 0"
af59614d 51@GroupBy => ()
84fb5b46 52$ChartStyle => 'bars'
af59614d
MKG
53@ChartFunction => 'COUNT'
54$Width => undef
55$Height => undef
84fb5b46
MKG
56</%args>
57<%init>
84fb5b46
MKG
58use GD;
59use GD::Text;
60
af59614d
MKG
61my %font_config = RT->Config->Get('ChartFont');
62my $font = $font_config{ $session{CurrentUser}->UserObj->Lang || '' }
63 || $font_config{'others'};
64
65s/\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
70my $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};
84fb5b46
MKG
102
103use RT::Report::Tickets;
af59614d 104my $report = RT::Report::Tickets->new( $session{'CurrentUser'} );
84fb5b46 105
af59614d
MKG
106my %columns;
107if ( $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 );
84fb5b46 117
af59614d
MKG
118 $report->SortEntries;
119}
120
121my @data = ([],[]);
84fb5b46 122my $max_value = 0;
af59614d 123my $min_value;
84fb5b46 124my $max_key_length = 0;
af59614d
MKG
125while ( 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;
84fb5b46 140 }
84fb5b46 141
af59614d
MKG
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 }
84fb5b46
MKG
149}
150
af59614d 151$ChartStyle = 'bars' if @data > 2;
84fb5b46 152
af59614d
MKG
153my $chart_class;
154if ($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}
84fb5b46
MKG
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.
af59614d
MKG
166unless ( $report->Count ) {
167 return $plot_error->(loc("No tickets found."));
84fb5b46
MKG
168}
169
af59614d
MKG
170my $chart = $chart_class->new( $Width => $Height );
171
172my %chart_options;
84fb5b46 173if ($chart_class eq "GD::Graph::bars") {
af59614d
MKG
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'} } ),
84fb5b46 400 x_label_position => 0.6,
af59614d 401 y_label => $report->Label( $columns{'Functions'}[0] ),
84fb5b46 402 y_label_position => 0.6,
84fb5b46
MKG
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
af59614d
MKG
406 y_max_value => $max_value,
407 y_min_value => $min_value,
84fb5b46 408# if there're too many bars or at least one key is too long, use vertical
af59614d 409 bargroup_spacing => $chart_options{'bar_spacing'}*5,
84fb5b46
MKG
410 );
411}
af59614d
MKG
412else {
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
420if ($chart->get('width') != $Width || $chart->get('height') != $Height ) {
421 $chart = $chart_class->new( $Width => $Height );
422}
84fb5b46 423
af59614d
MKG
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
437foreach 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") ];
84fb5b46
MKG
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
af59614d
MKG
456if (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}
84fb5b46
MKG
462</%init>
463
464<%METHOD Plot>
465<%ARGS>
466$plot => undef
467</%ARGS>
468<%INIT>
469my @types = ('png', 'gif');
470for 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
479die "Your GD library appears to support none of the following image types: " . join(', ', @types);
480</%INIT>
481
482</%METHOD>