7 use Yaala::Html qw#head foot escape navbar get_filename get_title#;
8 use Yaala::Data::Core qw#receive get_values#;
9 use Yaala::Data::Setup qw#$SELECTS#;
10 use Yaala::Data::Convert qw#convert#;
11 use Yaala::Config qw#get_config#;
12 use Yaala::Report::Core qw#$OUTPUTDIR#;
13 use Yaala::Report::GDGraph qw#generate_graph $GRAPH_WIDTH $GRAPH_HEIGHT#;
15 @Yaala::Report::EXPORT_OK = qw#generate#;
16 @Yaala::Report::ISA = ('Exporter');
18 my $VERSION = '$Id: Combined.pm,v 1.10 2003/12/07 14:53:30 octo Exp $';
19 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
24 while (scalar (@{$sel->[1]}) > 3)
26 my $ignore = pop (@{$sel->[1]});
27 print STDERR $/, __FILE__, ": With the combined output only ",
28 "three fields are supported. ",
29 "Field ``$ignore'' will be ignored.";
40 if (scalar (@{$sel->[1]}) == 1)
42 generate_1D_page ($sel);
44 elsif (scalar (@{$sel->[1]}) == 2)
46 generate_2D_page ($sel);
48 elsif (scalar (@{$sel->[1]}) == 3)
50 generate_3D_page ($sel);
58 generate_index_page ();
66 my ($key) = @{$sel->[1]};
68 my $filename = get_filename ($sel);
69 my $title = get_title ($sel);
71 open (FH, '> ' . $OUTPUTDIR . $filename) or die ('open: ' . $!);
73 print FH head ($title, $title);
74 print FH navbar ($sel);
76 print FH generate_1D_table ($sel, $key);
85 my ($key1, $key2) = @{$sel->[1]};
87 my $filename = get_filename ($sel);
88 my $title = get_title ($sel);
90 open (FH, '> ' . $OUTPUTDIR . $filename) or die ('open: ' . $!);
92 print FH head ($title, $title);
93 print FH navbar ($sel);
95 print FH generate_2D_table ($sel, $key1, $key2);
104 my ($key1, $key2, $key3) = @{$sel->[1]};
106 my $filename = get_filename ($sel);
107 my $title = get_title ($sel);
109 open (FH, '> ' . $OUTPUTDIR . $filename) or die ('open: ' . $!);
111 print FH head ($title, $title);
112 print FH navbar ($sel);
114 print FH generate_1D_table ($sel, $key3, 1);
116 my @vals3 = get_values ($sel, $key3);
121 print FH generate_2D_table ($sel, $key1, $key2, $key3, $val3);
128 sub generate_index_page
130 open (FH, '> ' . $OUTPUTDIR . 'index.html') or die ('open: ' . $!);
132 print FH head ("yaala $::VERSION", "yaala $::VERSION - Index");
135 if (scalar (keys (%$::EXTRA)))
137 print FH "\n<hr>\n<table>\n";
138 for (keys (%$::EXTRA))
141 my $val = $::EXTRA->{$key};
143 print FH qq# <tr>\n <th class="top">$key</th>\n <td>$val</td>\n </tr>\n#;
145 print FH "</table>\n";
149 print FH "\n<!-- no \%::EXTRA -->\n";
156 sub generate_1D_table
162 if (@_) { $do_links = shift; }
164 my @aggs = @{$sel->[0]};
166 my @vals = get_values ($sel, $key);
167 @vals = sort (@vals);
169 my %grand_total = ();
172 $grand_total{$_} = receive ($sel, $_, {});
175 my $text = "\n<hr>\n";
177 my $graph_file = generate_graph ($sel, $key);
180 $text .= qq#<p><img src="$graph_file" width="$GRAPH_WIDTH" height="$GRAPH_HEIGHT" alt="[graph]" /></p>\n#;
183 $text .= "<table>\n <tr>\n"
184 . ' <th colspan="' . (1 + (2 * scalar (@aggs))) . '">'
185 . ucfirst ($key) . "</th>\n </tr>\n";
187 if (scalar (@aggs) > 1)
189 $text .= qq# <tr>\n <th class="subhdr">Aggregation</th>\n#;
190 $text .= qq# <th colspan="2" class="subhdr"># . ucfirst ($_) . "</th>\n" for (@aggs);
198 $text .= qq# <tr>\n <th class="subhdr">#;
203 $text .= qq(<a href="#$tmpval">);
215 my $sum = receive ($sel, $agg, {$key => $val});
216 my $print_sum = convert ($agg, $sum);
218 $text .= qq#</th>\n <td>$print_sum</td>\n#
219 . " <td>" . sprintf ("%.1f%%", 100 * $sum / $grand_total{$agg}) . "</td>\n";
223 $text .= qq# <tr>\n <th class="subhdr">Total</td>\n#;
227 my $print_sum = convert ($agg, $grand_total{$agg});
229 $text .= qq# <td class="total">$print_sum</td>\n#
230 . qq# <td class="total">100.0%</td>\n#
232 $text .= qq#</tr>\n</table>\n#;
237 sub generate_2D_table
247 if (scalar (@_) >= 2)
253 my @aggs = @{$sel->[0]};
254 my $num_aggs = scalar (@aggs);
256 my @vals1 = get_values ($sel, $key1);
257 my @vals2 = get_values ($sel, $key2);
259 @vals1 = sort (@vals1);
260 @vals2 = sort (@vals2);
262 my %grand_total = ();
268 $query->{$key3} = $val3;
270 $grand_total{$_} = receive ($sel, $_, $query);
278 $text = qq#\n<hr id="$tmpval" />\n#;
282 $text = qq#\n<hr />\n#;
285 my $graph_file = generate_graph ($sel, $key1, $key3, $val3);
288 $text .= qq#<p><img src="$graph_file" width="$GRAPH_WIDTH" height="$GRAPH_HEIGHT" alt="[graph]" />\n#;
290 $graph_file = generate_graph ($sel, $key2, $key3, $val3);
291 $text .= qq# <img src="$graph_file" width="$GRAPH_WIDTH" height="$GRAPH_HEIGHT" alt="[graph]" /></p>\n#;
294 $text .= qq#<table>\n#;
298 $text .= " <caption>$val3</caption>\n";
301 my $agg_column_width = '';
304 $agg_column_width = qq# colspan="$num_aggs"#;
308 $text .= qq# <tr>\n <td colspan="2" rowspan="# . ($num_aggs > 1 ? '3' : '2')
309 . qq#" class="blank"><img src="logo.png" /></td>\n#
310 . ' <th colspan="' . ($num_aggs * scalar (@vals2)) . qq#"># . ucfirst ($key2) . "</th>\n"
311 . qq# <th rowspan="2"$agg_column_width>Total</th>\n#
312 . qq# <th rowspan="2"$agg_column_width>Percent</th>\n#
319 $text .= qq# <th class="subhdr"$agg_column_width>$_</th>\n#;
321 $text .= qq# </tr>\n#;
323 # third line (if appropriate only)
328 my $tmp = join ('', map { qq# <th class="subhdr">$_</th>\n# } (@aggs));
329 $text .= $tmp x (2 + scalar (@vals2));
333 $text .= qq# <tr>\n <th rowspan="# . scalar (@vals1)
334 . qq#"># . ucfirst ($key1) . "</th>\n";
336 my $this_is_the_first_line = 1;
341 $text .= " <tr>\n" unless ($this_is_the_first_line);
342 $this_is_the_first_line = 0;
344 $text .= qq# <th class="subhdr">$val1</th>\n#;
350 my $query = { $key1 => $val1, $key2 => $val2 };
353 $query->{$key3} = $val3;
360 my $this_val = receive ($sel, $agg, $query);
361 my $print_val = convert ($agg, $this_val);
363 $text .= ' <td>' . ($print_val ? $print_val : ' ') . "</td>\n";
367 my $query = { $key1 => $val1 };
370 $query->{$key3} = $val3;
376 my $this_val = receive ($sel, $_, $query);
377 my $print_val = convert ($_, $this_val);
379 $text .= ' <td class="total">' . ($print_val ? $print_val : ' ') . "</td>\n";
380 $tmp .= ' <td class="total">'
381 . ($this_val ? sprintf ("%.1f%%", 100 * $this_val / $grand_total{$_}) : ' ')
384 $text .= $tmp . " </tr>\n";
386 # TODO 2003-05-10 13:00
387 $text .= qq# <tr>\n <th colspan="2">Total</th>\n#;
388 my @percentages = ();
393 my $query = { $key2 => $val2 };
396 $query->{$key3} = $val3;
403 my $this_val = receive ($sel, $agg, $query);
404 my $print_val = convert ($agg, $this_val);
406 $text .= ' <td class="total">' . ($print_val ? $print_val : ' ') . "</td>\n";
408 my $pc = ($this_val ? sprintf ("%.1f%%", 100 * $this_val / $grand_total{$agg}) : ' ');
409 push (@percentages, $pc);
417 my $print_val = convert ($agg, $grand_total{$agg});
418 $text .= ' <td class="total">' . ($print_val ? $print_val : ' ') . "</td>\n";
421 $text .= qq# <td class="blank"$agg_column_width> </td>\n#
424 . qq# <th colspan="2">Percent</th>\n#;
425 $text .= qq# <td class="total">$_</td>\n# for (@percentages);
426 $text .= qq# <td class="blank" colspan="# . (2 * $num_aggs) . qq#"> </td>\n#