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: Classic.pm,v 1.10 2003/12/07 14:53:30 octo Exp $';
19 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
22 if (get_config ('classic_skip_empty'))
24 my $conf = lc (get_config ('classic_skip_empty'));
25 if ($conf eq 'no' or $conf eq 'false') { $skip_empty = 0; }
35 my @keys = @{$sel->[1]};
37 generate_sub_index ($sel);
42 generate_sub_page ($sel, $key);
46 generate_index_page ();
56 my @vals = get_values ($sel, $key);
58 my $filename = get_filename ($sel);
59 $filename =~ s/\.html$/__$key.html/;
60 my $title = get_title ($sel);
62 open (FH, '> ' . $OUTPUTDIR . $filename) or die ('open: ' . $!);
64 print FH head ($title, $title);
65 print FH '<h2>', ucfirst ($key), "</h2>\n";
66 print FH qq#<a id="top_of_page"></a>\n#;
67 print FH navbar ($sel);
68 print FH own_navbar ($sel, $key);
70 my $graph_file = generate_graph ($sel, $key);
73 print FH qq#<p><img src="$graph_file" width="$GRAPH_WIDTH" #,
74 qq#height="$GRAPH_HEIGHT" alt="[graph]" /></p>\n#;
80 print FH generate_table ($sel, $key, $val);
87 sub generate_sub_index
91 my $filename = get_filename ($sel);
92 my $title = get_title ($sel);
94 open (FH, '> ' . $OUTPUTDIR . $filename) or die ('open: ' . $!);
96 print FH head ($title, $title);
97 print FH navbar ($sel);
98 print FH own_navbar ($sel);
100 print FH "<table>\n";
104 my @vals = get_values ($sel, $key);
105 my $num_vals = scalar (@vals);
107 print FH " <tr>\n <th>", ucfirst ($key), "</th>\n",
108 " <td>$num_vals entr", ($num_vals == 1 ? 'y' : 'ies'),
111 print FH "</table>\n\n";
117 sub generate_index_page
119 open (FH, '> ' . $OUTPUTDIR . 'index.html') or die ('open: ' . $!);
121 print FH head ("yaala $::VERSION", "yaala $::VERSION - Index");
124 if (scalar (keys (%$::EXTRA)))
126 print FH "\n<hr>\n<table>\n";
127 for (keys (%$::EXTRA))
130 my $val = $::EXTRA->{$key};
132 print FH qq# <tr>\n <th class="top">$key</th>\n <td>$val</td>\n </tr>\n#;
134 print FH "</table>\n";
138 print FH "\n<!-- no \%::EXTRA -->\n";
151 my @aggs = @{$sel->[0]};
152 my $num_aggs = scalar (@aggs);
154 my @keys = grep { $_ ne $key } (@{$sel->[1]});
155 @keys = sort (@keys);
159 $link_val =~ s/\W//g;
161 my $text = qq#\n<hr />\n<table id="$link_val">\n <tr>\n#;
162 $text .= ' <th colspan="' . (2 + (2 * $num_aggs)) . '">' . ucfirst ($val) . "</th>\n </tr>\n";
163 $text .= qq# <tr>\n <th class="subhdr">Field</th>\n#
164 . qq# <th class="subhdr">Value</th>\n#;
166 my %grand_total = ();
169 $text .= qq# <th class="subhdr"># . ucfirst ($_) . "</th>\n"
170 . qq# <th class="subhdr">Percent</th>\n#;
172 $grand_total{$_} = receive ($sel, $_, {$key => $val});
179 my @second_vals = get_values ($sel, $second_key);
185 my $num_vals = scalar (@second_vals);
187 for (sort (@second_vals))
190 my $skipped_cells = 0;
193 if (!$first_line) { $tmp_text2 = " <tr>\n"; }
194 $tmp_text2 .= qq# <td>$this_val</td>\n#;
201 if (!defined ($sub_total{$agg})
202 or ($sub_total{$agg} != $grand_total{$agg}))
204 $sum = receive ($sel, $agg, {$key => $val, $second_key => $this_val});
205 $sub_total{$agg} += $sum;
208 if (!$sum and $skip_empty)
213 my $print_sum = convert ($agg, $sum);
215 my $percent = ($sum ? sprintf ("%.1f%%", 100 * $sum / $grand_total{$agg}) : ' ');
217 $tmp_text2 .= " <td>"
218 . ($print_sum ? $print_sum : ' ' )
220 . qq# <td>$percent</td>\n#;
223 $tmp_text2 .= " </tr>\n";
225 if ($skipped_cells == $num_aggs)
232 $tmp_text .= $tmp_text2;
236 $text .= qq# <tr>\n <th class="subhdr"#
237 . ($num_vals > 1 ? qq# rowspan="$num_vals"# : '')
238 . '>' . ucfirst ($second_key) . "</th>\n"
242 $text .= qq# <tr>\n <th class="subhdr">Total</th>\n#
243 . qq# <td class="total"> </td>\n#;
246 my $print_sum = convert ($_, $grand_total{$_});
248 $text .= qq# <td class="total">$print_sum</td>\n#
249 . qq# <td class="total">100.0%</td>\n#;
251 $text .= qq# </tr>\n</table>\n#
252 . qq(<p>[ <a href="#top_of_page">top</a> ]</p>\n);
262 if (!defined ($key)) { $key = ''; }
264 my $base_filename = get_filename ($sel);
265 my $text = qq#<p class="navbar">\n#;
270 my $this_filename = $base_filename;
271 $this_filename =~ s/\.html$/__$this_key.html/;
273 if ($this_key eq $key)
275 $text .= ' <span>[ ' . ucfirst ($key) . " ]</span>\n";
279 $text .= qq# <span>[ <a href="$this_filename"># . ucfirst ($this_key) . "</a> ]</span>\n";
287 my @vals = get_values ($sel, $key);
289 $text .= qq#<p class="navbar">\n#;
293 my $print_val = convert ($key, $_);
294 $link_val =~ s/\W//g;
296 $text .= qq( <span>[ <a href="#$link_val">$print_val</a> ]</span>\n);