rt 4.0.23
[freeside.git] / rt / share / html / Search / Chart
1 %# BEGIN BPS TAGGED BLOCK {{{
2 %#
3 %# COPYRIGHT:
4 %#
5 %# This software is Copyright (c) 1996-2015 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 $Query => "id > 0"
50 $PrimaryGroupBy => 'Queue'
51 $ChartStyle => 'bar'
52 </%args>
53 <%init>
54 my $chart_class;
55 use GD;
56 use GD::Text;
57
58 if ($ChartStyle eq 'pie') {
59     require GD::Graph::pie;
60     $chart_class = "GD::Graph::pie";
61 } else {
62     require GD::Graph::bars;
63     $chart_class = "GD::Graph::bars";
64 }
65
66 use RT::Report::Tickets;
67 my $tix = RT::Report::Tickets->new( $session{'CurrentUser'} );
68 my %AllowedGroupings = reverse $tix->Groupings( Query => $Query );
69 $PrimaryGroupBy = 'Queue' unless exists $AllowedGroupings{$PrimaryGroupBy};
70 my ($count_name, $value_name) = $tix->SetupGroupings(
71     Query => $Query, GroupBy => $PrimaryGroupBy,
72 );
73
74 my %class = (
75     Queue => 'RT::Queue',
76     Owner => 'RT::User',
77     Creator => 'RT::User',
78     LastUpdatedBy => 'RT::User',
79 );
80 my $class = $class{ $PrimaryGroupBy };
81
82 my %data;
83 my $max_value = 0;
84 my $max_key_length = 0;
85 while ( my $entry = $tix->Next ) {
86     my $key;
87     if ( $class ) {
88         my $q = $class->new( $session{'CurrentUser'} );
89         $q->Load( $entry->LabelValue( $value_name ) );
90         $key = $q->Name;
91     }
92     else {
93         $key = $entry->LabelValue($value_name);
94     }
95     $key ||= '(no value)';
96     
97     my $value = $entry->__Value( $count_name );
98     if ($chart_class eq 'GD::Graph::pie') {
99         $key = loc($key) ." - ". $value;
100     } else {
101         $key = loc($key);
102     }
103     $data{ $key } = $value;
104     $max_value = $value if $max_value < $value;
105     $max_key_length = length $key if $max_key_length < length $key;
106 }
107
108 unless (keys %data) {
109     $data{''} = 0;
110 }
111
112
113 my $chart = $chart_class->new( 600 => 400 );
114 $chart->set( pie_height => 60 ) if $chart_class eq 'GD::Graph::pie';
115 my %font_config = RT->Config->Get('ChartFont');
116 my $font = $font_config{ $session{CurrentUser}->UserObj->Lang || '' }
117   || $font_config{'others'};
118 $chart->set_title_font( $font, 16 ) if $chart->can('set_title_font');
119 $chart->set_legend_font( $font, 16 ) if $chart->can('set_legend_font');
120 $chart->set_x_label_font( $font, 14 ) if $chart->can('set_x_label_font');
121 $chart->set_y_label_font( $font, 14 ) if $chart->can('set_y_label_font');
122 $chart->set_label_font( $font, 14 ) if $chart->can('set_label_font');
123 $chart->set_x_axis_font( $font, 12 ) if $chart->can('set_x_axis_font');
124 $chart->set_y_axis_font( $font, 12 ) if $chart->can('set_y_axis_font');
125 $chart->set_values_font( $font, 12 ) if $chart->can('set_values_font');
126 $chart->set_value_font( $font, 12 ) if $chart->can('set_value_font');
127
128 # Pie charts don't like having no input, so we show a special image
129 # that indicates an error message. Because this is used in an <img>
130 # context, it can't be a simple error message. Without this check,
131 # the chart will just be a non-loading image.
132 if ($tix->Count == 0) {
133     my $plot = GD::Image->new(600 => 400);
134     $plot->colorAllocate(255, 255, 255); # background
135     my $black = $plot->colorAllocate(0, 0, 0);
136
137     require GD::Text::Wrap;
138     my $error = GD::Text::Wrap->new($plot,
139         color => $black,
140         text  => loc("No tickets found."),
141     );
142     $error->set_font( $font, 16 );
143     $error->draw(0, 0);
144
145     $m->comp( 'SELF:Plot', plot => $plot, %ARGS );
146 }
147
148 if ($chart_class eq "GD::Graph::bars") {
149     my $count = keys %data;
150     $chart->set(
151         x_label => $tix->Label( $PrimaryGroupBy ),
152         y_label => loc('Tickets'),
153         show_values => 1,
154         x_label_position => 0.6,
155         y_label_position => 0.6,
156         values_space => -1,
157 # use a top margin enough to display values over the top line if needed
158         t_margin => 18,
159 # the following line to make sure there's enough space for values to show
160         y_max_value => 5*(int($max_value/5) + 2),
161 # if there're too many bars or at least one key is too long, use vertical
162         x_labels_vertical => ( $count * $max_key_length > 60 ) ? 1 : 0,
163         $count > 30 ? ( bar_spacing => 1 ) : ( $count > 20 ? ( bar_spacing => 2 ) : 
164             ( $count > 10 ? ( bar_spacing => 3 ) : ( bar_spacing => 5 ) )
165         ),
166     );
167 }
168
169 # refine values' colors, with both Color::Scheme's help and my own tweak
170 $chart->{dclrs} = [
171     '66cc66', 'ff6666', 'ffcc66', '663399',
172     '3333cc', '339933', '993333', '996633',
173     '33cc33', 'cc3333', 'cc9933', '6633cc',
174 ];
175
176 {
177     no warnings 'redefine';
178     *GD::Graph::pick_data_clr = sub {
179         my $self      = shift;
180         my $color_hex = $self->{dclrs}[ $_[0] % @{ $self->{dclrs} } - 1 ];
181         return map { hex } ( $color_hex =~ /(..)(..)(..)/ );
182     };
183 }
184
185 my $plot = $chart->plot( [ [sort keys %data], [map $data{$_}, sort keys %data] ] ) or die $chart->error;
186 $m->comp( 'SELF:Plot', plot => $plot, %ARGS );
187 </%init>
188
189 <%METHOD Plot>
190 <%ARGS>
191 $plot => undef
192 </%ARGS>
193 <%INIT>
194 my @types = ('png', 'gif');
195 for my $type (@types) {
196     $plot->can($type)
197         or next;
198
199     $r->content_type("image/$type");
200     $m->out( $plot->$type );
201     $m->abort();
202 }
203
204 die "Your GD library appears to support none of the following image types: " . join(', ', @types);
205 </%INIT>
206
207 </%METHOD>