1 package Yaala::Report::GDGraph;
5 use vars qw#$GRAPH_WIDTH $GRAPH_HEIGHT#;
8 use Yaala::Data::Core qw#get_values receive#;
9 use Yaala::Config qw#get_config#;
10 use Yaala::Html qw#get_filename get_title#;
11 use Yaala::Report::Core qw#$OUTPUTDIR#;
13 @Yaala::Report::GDGraph::EXPORT_OK = qw#generate_graph $GRAPH_WIDTH $GRAPH_HEIGHT#;
14 @Yaala::Report::GDGraph::ISA = ('Exporter');
19 our $HAVE_GD_GRAPH = 0;
23 my $VERSION = '$Id: GDGraph.pm,v 1.9 2003/12/07 14:53:30 octo Exp $';
24 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
26 eval "use GD::Graph::bars;";
30 print STDERR ' - GD::Graph is installed' if ($::DEBUG);
34 print STDERR ' - GD::Graph is NOT installed' if ($::DEBUG);
37 $WANT_GRAPHS = $HAVE_GD_GRAPH;
39 if (get_config ('graph_height'))
41 my $height = get_config ('graph_height');
44 if (($height > 100) and ($height < 1000))
46 $GRAPH_HEIGHT = $height;
50 print STDERR $/, __FILE__, ": ``$height'' is not a valid value for ``graph_height'' and will be ignored.";
54 if (get_config ('graph_width'))
56 my $width = get_config ('graph_width');
59 if (($width > 100) and ($width < 1000))
61 $GRAPH_WIDTH = $width;
62 $MAX_VALUES = int ($GRAPH_WIDTH / 20);
66 print STDERR $/, __FILE__, ": ``$width'' is not a valid value for ``graph_width'' and will be ignored.";
70 if (get_config ('print_graphs'))
72 my $want = lc (get_config ('print_graphs'));
73 if ($want eq 'no' or $want eq 'false' or $want eq 'off')
77 elsif ($want eq 'yes' or $want eq 'true' or $want eq 'on')
81 print STDERR $/, __FILE__, ": You've set ``print_graphs'' to ``$want''.",
82 $/, __FILE__, ' However, the graphs cannot be genereted, because GD::Graph cannot be found.',
83 $/, __FILE__, ' Please go to your nearest CPAN-mirror and install it first.',
84 $/, __FILE__, ' This config-option will be ignored.';
87 elsif ($want eq 'auto' or $want eq 'automatic')
89 # do nothing.. Already been done.
93 print STDERR $/, __FILE__, ": You've set ``print_graphs'' to ``$want''.",
94 $/, __FILE__, ' This value is not understood and is being ignored.';
100 print STDERR $/, __FILE__, ': Size: ', $GRAPH_WIDTH, 'x', $GRAPH_HEIGHT,
101 "; Max number of values: $MAX_VALUES";
111 my $where_key = shift;
112 my $where_val = shift;
114 return ('') unless ($HAVE_GD_GRAPH and $WANT_GRAPHS);
116 if (!defined ($where_key) or !defined ($where_val)
117 or !$where_key or !$where_val)
123 my @aggs = @{$sel->[0]};
124 my $num_aggs = scalar (@aggs);
126 my $filename = get_filename ($sel);
128 my $replacement = "__$key";
131 $replacement .= "__$where_key" . "_$where_val";
133 $replacement =~ s/\W+/_/g;
134 $replacement .= '.png';
136 $filename =~ s/\.html$/$replacement/;
139 my @key_values = get_values ($sel, $key);
140 @key_values = sort (@key_values);
142 my @agg_values = get_agg_values ($sel, $key, \@key_values, $where_key, $where_val);
144 if (scalar (@key_values) > $MAX_VALUES)
146 discard_values (\@key_values, \@agg_values);
151 next if (length ($_) < 20);
153 substr ($_, 17) = ' ..';
156 my @data_set = (\@key_values, @agg_values);
158 my $title = join (', ', map { ucfirst ($_) } (@aggs)) . ' by ' . ucfirst ($key);
159 if ($where_val) { $title .= ' for ' . $where_val; }
161 print STDERR $/, __FILE__, qq#: Generating image "$title" [$filename]#
162 if ($::DEBUG & 0x100);
164 my $graph = GD::Graph::bars->new ($GRAPH_WIDTH, $GRAPH_HEIGHT);
168 x_label => ucfirst ($key),
169 y_label => 'Percent',
171 x_labels_vertical => 1,
172 x_label_position => 1,
175 # logo => 'reports/logo.png',
181 dclrs => [ qw(lgray gray dgray) ],
182 borderclrs => [ qw(black black black) ],
185 axislabelclr => 'black',
186 legendclr => 'black',
187 valuesclr => 'black',
193 $graph->set (legend_placement => 'BR');
194 $graph->set_legend (map { ucfirst ($_) } (@aggs));
197 if (open (IMG, "> $OUTPUTDIR$filename"))
200 print IMG $graph->plot(\@data_set)->png;
205 print STDERR $/, __FILE__, ": Unable to open ``$filename'': $!";
214 my $key_array = shift;
215 my $val_array = shift;
217 my @orig_sort = @$key_array;
218 my $num_values = scalar (@$key_array);
220 return (1) if ($num_values < $MAX_VALUES);
222 my %vals_by_key = ();
226 for ($i = 0; $i < $num_values; $i++)
228 my $key = shift (@$key_array);
234 my $tmp = shift (@$_);
239 $vals_by_key{$key} = \@vals;
240 $tmp_hash{$key} = $sum;
243 my @small_sorted = sort { $tmp_hash{$b} <=> $tmp_hash{$a} } (keys (%tmp_hash));
245 for ($i = 0; $i < $MAX_VALUES; $i++)
247 shift (@small_sorted);
253 if (grep { $_ eq $this_key } (@small_sorted))
255 #$other += $tmp_hash{$this_key};
259 push (@$key_array, $this_key);
260 my $vals = $vals_by_key{$this_key};
263 my $val = shift (@$vals);
274 my $key_values = shift;
285 my @aggs = @{$sel->[0]};
297 #if (scalar (@aggs) > 1)
300 if ($where_key) { $query{$where_key} = $where_val; }
302 $grand_total = receive ($sel, $agg, {});
307 my %query = ($key => $_);
308 if ($where_key) { $query{$where_key} = $where_val; }
310 my $sum = receive ($sel, $agg, \%query);
314 $sum = 100 * $sum / $grand_total;
319 if ($sum > $max_val{$agg})
321 $max_val{$agg} = $sum;
325 push (@agg_values, \@tmp);
328 return (@agg_values);