]>
Commit | Line | Data |
---|---|---|
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 |
58 | use GD; |
59 | use GD::Text; | |
60 | ||
af59614d MKG |
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 | }; | |
84fb5b46 MKG |
102 | |
103 | use RT::Report::Tickets; | |
af59614d | 104 | my $report = RT::Report::Tickets->new( $session{'CurrentUser'} ); |
84fb5b46 | 105 | |
af59614d MKG |
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 | ); | |
84fb5b46 | 117 | |
af59614d MKG |
118 | $report->SortEntries; |
119 | } | |
120 | ||
121 | my @data = ([],[]); | |
84fb5b46 | 122 | my $max_value = 0; |
af59614d | 123 | my $min_value; |
84fb5b46 | 124 | my $max_key_length = 0; |
af59614d MKG |
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; | |
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 |
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 | } | |
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 |
166 | unless ( $report->Count ) { |
167 | return $plot_error->(loc("No tickets found.")); | |
84fb5b46 MKG |
168 | } |
169 | ||
af59614d MKG |
170 | my $chart = $chart_class->new( $Width => $Height ); |
171 | ||
172 | my %chart_options; | |
84fb5b46 | 173 | if ($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 |
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 | } | |
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 | ||
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") ]; | |
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 |
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 | } | |
84fb5b46 MKG |
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> |