]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | %# BEGIN BPS TAGGED BLOCK {{{ |
2 | %# | |
3 | %# COPYRIGHT: | |
4 | %# | |
5 | %# This software is Copyright (c) 1996-2012 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 => 'bars' | |
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> |