2 # fixscript will replace this line with require innshellvars.pl
4 ##########################################################################
6 # innreport: Perl script to summarize news log files
7 # (with optional HTML output and graphs).
11 # Copyright (c) 1996-1999, Fabien Tassin (fta@sofaraway.org).
13 ##########################################################################
15 # Usage: innreport -f config_file [-[no]options] logfile [logfile2 [...]]
17 # -h (or -help) : this help page
19 # -v : display the version number of INNreport
20 # -f config_file : name of the configuration file
21 # -config : print INNreport configuration information
22 # -g : want graphs [default]
23 # -graph : an alias for option -g
24 # -d directory : directory for Web pages
25 # -dir directory : an alias for option -d
26 # -p directory : pictures path (file space)
27 # -path directory : an alias for option -p
28 # -w directory : pictures path (web space)
29 # -webpath directory : an alias for option -w
30 # -i : name of index page
31 # -index : an alias for option -i
32 # -a : want to archive HTML results
33 # -archive : an alias for option -a
34 # -c number : how many report files to keep (0 = all)
35 # -cycle number : an alias for option -c
36 # -s char : separator for filename
37 # -separator char : an alias for option -s
38 # -unknown : Unknown entries from news log file
39 # -maxunrec : Max number of unrecognized line to display
40 # -casesensitive : Case sensitive
41 # -notdaily : Never perform daily actions
43 # Use no in front of boolean options to unset them.
44 # For example, "-html" is set by default. Use "-nohtml" to remove this
47 ##########################################################################
49 # ABSOLUTELY NO WARRANTY WITH THIS PACKAGE. USE IT AT YOUR OWN RISKS.
51 # Note: You need the Perl graphic library GD.pm if you want the graphs.
52 # GD is available on all good CPAN ftp sites:
53 # ex: [CPAN_DIR]/authors/id/LDS/GD-1.1_.tar.gz (or greater)
55 # <URL:http://www-genome.wi.mit.edu/pub/software/WWW/GD.html>
56 # Note : innreport will create PNG or GIF files depending upon
59 # Documentation: for a short explaination of the different options, you
60 # can read the usage (obtained with the -h or -help switch).
62 # Install: - check the Perl location (first line). Require Perl 5.002
64 # - look at the parameters in the configuration file (section
66 # - copy the configuration file into ${PATHETC}/innreport.conf
67 # - copy the INN module into ${PATHETC}/innreport_inn.pm
68 # - copy this script into ${PATHETC}/innreport
69 # - be sure that the news user can run it (chmod 755 or 750)
70 # - in "scanlog", comment the line containing innlog and add:
71 # ${PATHETC}/innreport -f ${PATHETC}/innreport.conf ${OLD_SYSLOG}
72 # or, if you want to change some options:
73 # ${PATHETC}/innreport -f ${PATHETC}/innreport.conf options ${OLD_SYSLOG}
75 # Report: please report bugs (preferably) to the INN mailing list
76 # (see README) or directly to the author (do not forget to
77 # include the result of the "-config" switch, the parameters
78 # passed on the command line and the INN version).
79 # Please also report unknown entries.
80 # Be sure your are using the latest version of this script before
83 ##########################################################################
85 # Note: References to <ftp://ftp.sofaraway.org/pub/innreport/> have been
86 # removed from the output because this site appears to no longer exist. It
87 # used to be the upstream source for innreport. If there is a new site for
88 # innreport releases, please notify the INN maintainers.
90 # remember to add '-w' on the first line and to uncomment the 'use strict'
91 # below before doing any changes to this file.
95 ## Do you want to create a Web page. Pick DO or DONT.
98 ## Do you want the graphs (need $HTML too). Pick DO or DONT.
101 ## Directory for the Web pages (used only if the previous line is active)
102 my $HTML_dir = "$inn::pathhttp";
104 ## Directory for the pictures (need HTML support) in the file space
105 my $IMG_dir = "$HTML_dir/pics";
107 ## Directory for the pictures (need HTML support) in the Web space
108 ## (can be relative or global)
109 my $IMG_pth = "pics";
111 ## Do you want to archive HTML results (& pics) [ will add a date in each
112 ## name ]. Pick DO or DONT.
115 ## index page will be called:
116 my $index = "index.html";
118 ## How many report files to keep (0 = all) (need $ARCHIVE).
121 ## separator between hours-minutes-seconds in filenames
122 ## (normaly a ":" but some web-browsers (Lynx, MS-IE, Mosaic) can't read it)
123 ## Warning: never use "/". Use only a _valid_ filename char.
126 ## Do you want the "Unknown entries from news log file" report. Pick DO or
128 my $WANT_UNKNOWN = "DO";
130 ## Max number of unrecognized lines to display (if $WANT_UNKNOWN)
132 my $MAX_UNRECOGNIZED = 50;
134 ## Do you want to be case sensitive. Pick DO or DONT.
135 my $CASE_SENSITIVE = "DO";
137 ## Some actions must only be performed daily (once for a log file).
138 ## (ex: unwanted.log with INN). Default value (DONT) means to perform
139 ## these actions each . Pick DO or DONT.
140 my $NOT_DAILY = "DONT";
142 ###############################################
143 ## THERE'S NOTHING TO CHANGE AFTER THIS LINE ##
144 ###############################################
146 my $version = "3.0.2";
147 my %output; # content of the configuration file.
148 my $DEBUG = 0; # set to 1 to verify the structure/content of the conf file.
149 my $start_time = time;
151 # Require Perl 5.002 or greater.
154 use vars qw/$HAVE_GD $GD_FORMAT/;
156 my @old_argv = @ARGV;
158 # Convert DO/DONT into boolean values.
161 foreach $i (\$HTML, \$GRAPH, \$ARCHIVE, \$WANT_UNKNOWN,
162 \$CASE_SENSITIVE, \$NOT_DAILY) {
163 $$i = $$i eq 'DO' ? 1 : 0 ;
189 &Version if $ref{'v'};
191 &Decode_Config_File($ref{'f'}) if defined $ref{'f'};
192 &Usage if $ref{'h'} || $ref{'help'} || !defined $ref{'f'};
194 $HTML = 0 if defined $output{'default'}{'html'};
195 $HTML = 1 if $output{'default'}{'html'} eq 'true';
196 $HTML = 0 if defined $ref{'html'};
197 $HTML = 1 if $ref{'html'};
199 $GRAPH = 0 if defined $output{'default'}{'graph'};
200 $GRAPH = 1 if $HTML && ($output{'default'}{'graph'} eq 'true');
201 $GRAPH = 0 if defined $ref{'g'} || defined $ref{'graph'};
202 $GRAPH = 1 if $HTML && ($ref{'g'} || $ref{'graph'});
204 $HTML_dir = &GetValue ($output{'default'}{'html_dir'})
205 if defined $output{'default'}{'html_dir'};
206 $HTML_dir = $ref{'d'} if defined $ref{'d'};
207 $HTML_dir = $ref{'dir'} if defined $ref{'dir'};
209 $IMG_pth = &GetValue ($output{'default'}{'img_dir'})
210 if defined $output{'default'}{'img_dir'};
211 $IMG_pth = $ref{'w'} if defined $ref{'w'};
212 $IMG_pth = $ref{'webpath'} if defined $ref{'webpath'};
214 $IMG_dir = $HTML_dir . "/" . $IMG_pth
215 if (defined $output{'default'}{'html_dir'} ||
216 defined $ref{'w'} || defined $ref{'webpath'})
218 (defined $output{'default'}{'html_dir'} ||
219 defined $ref{'d'} || defined $ref{'dir'});
221 $IMG_dir = $ref{'p'} if defined $ref{'p'};
222 $IMG_dir = $ref{'path'} if defined $ref{'path'};
224 $index = &GetValue ($output{'default'}{'index'})
225 if defined $output{'default'}{'index'};
226 $index = $ref{'i'} if defined $ref{'i'};
227 $index = $ref{'index'} if defined $ref{'index'};
229 $ARCHIVE = &GetValue ($output{'default'}{'archive'})
230 if defined $output{'default'}{'archive'};
231 $ARCHIVE = $ARCHIVE eq 'true';
232 $ARCHIVE = 0 if defined $ref{'a'} || defined $ref{'archive'};
233 $ARCHIVE = 1 if ($ref{'a'} || $ref{'archive'}) && $HTML;
234 $ARCHIVE = 0 unless $HTML;
236 $CYCLE = &GetValue ($output{'default'}{'cycle'})
237 if defined $output{'default'}{'cycle'};
238 $CYCLE = 0 if $CYCLE eq 'none';
239 $CYCLE = $ref{'c'} if defined $ref{'c'};
240 $CYCLE = $ref{'cycle'} if defined $ref{'cycle'};
242 $SEPARATOR = &GetValue ($output{'default'}{'separator'})
243 if defined $output{'default'}{'separator'};
244 $SEPARATOR = $ref{'s'} if defined $ref{'s'};
245 $SEPARATOR = $ref{'separator'} if defined $ref{'separator'};
247 if (defined $output{'default'}{'unknown'}) {
248 $WANT_UNKNOWN = &GetValue ($output{'default'}{'unknown'});
249 $WANT_UNKNOWN = $WANT_UNKNOWN eq 'true' ? 1 : 0;
251 $WANT_UNKNOWN = 0 if defined $ref{'unknown'};
252 $WANT_UNKNOWN = 1 if $ref{'unknown'};
254 my $WANT_HTML_UNKNOWN = $WANT_UNKNOWN;
255 if (defined $output{'default'}{'html-unknown'}) {
256 $WANT_HTML_UNKNOWN = &GetValue ($output{'default'}{'html-unknown'});
257 $WANT_HTML_UNKNOWN = $WANT_HTML_UNKNOWN eq 'true' ? 1 : 0;
259 $WANT_HTML_UNKNOWN = 0 if defined $ref{'html-unknown'};
260 $WANT_HTML_UNKNOWN = 1 if $ref{'html-unknown'};
262 $NOT_DAILY = 0 if defined $ref{'notdaily'};
263 $NOT_DAILY = 1 if $ref{'notdaily'};
265 $MAX_UNRECOGNIZED = &GetValue ($output{'default'}{'max_unknown'})
266 if defined $output{'default'}{'max_unknown'};
267 $MAX_UNRECOGNIZED = $ref{'maxunrec'} if defined ($ref{'maxunrec'});
269 $CASE_SENSITIVE = &GetValue ($output{'default'}{'casesensitive'})
270 if defined $output{'default'}{'casesensitive'};
271 $CASE_SENSITIVE = 1 if $CASE_SENSITIVE eq 'true';
272 $CASE_SENSITIVE = 0 if defined $ref{'casesensitive'};
273 $CASE_SENSITIVE = 1 if $ref{'casesensitive'};
275 my $CLASS = &GetValue ($output{'default'}{'module'});
276 my $LIBPATH = &GetValue ($output{'default'}{'libpath'});
284 my $gd = new GD::Image(1,1);
285 $GD_FORMAT = "gif" if $gd->can('gif');
286 $GD_FORMAT = "png" if $gd->can('png');
290 undef $GRAPH unless $HTML;
291 if ($GRAPH && !$::HAVE_GD) {
292 print "WARNING: can't make graphs as required.\n" .
293 " Install GD.pm or disable this option.\n\n";
299 $IMG_dir = "." if defined $IMG_dir && $IMG_dir eq '';
300 $IMG_pth .= "/" if $IMG_pth;
301 $IMG_pth =~ s|/+|/|g;
302 $IMG_dir =~ s|/+|/|g;
303 unless (-w $IMG_dir) {
304 print "WARNING: can't write in \"$IMG_dir\" as required by -g " .
305 "switch.\n Option -g removed. Please see the -p switch.\n\n";
309 $HTML_dir = "." if defined $HTML_dir && $HTML_dir eq '';
310 unless (-w $HTML_dir) {
311 print "WARNING: can't write in \"$HTML_dir\" as required by -html " .
312 "switch.\n Option -html and -a removed. Please see the " .
319 # Now, we are sure that HTML and graphs can be made if options are active.
320 &Summary if defined $ref{'config'};
322 my $unrecognize_max = 0;
324 my ($total_line, $total_size) = (0, 0);
325 my ($suffix, $HTML_output, %config, $first_date, $last_date,
326 %prog_type, %prog_size);
328 my $HTML_header = '';
329 my $HTML_footer = '';
334 my $xmax = &GetValue ($output{'default'}{'graph_width'}) # Graph size..
335 if defined $output{'default'}{'graph_width'};
336 $xmax = 550 unless $xmax;
338 my $transparent = &GetValue ($output{'default'}{'transparent'})
339 if defined $output{'default'}{'transparent'};
340 $transparent = (defined $transparent && $transparent eq 'true') ? 1 : 0;
344 my $first_date_cvt = $MIN;
345 my $last_date_cvt = $MAX;
348 #########################################################################
349 my $s = sprintf "use lib qw($LIBPATH); use $CLASS;";
350 eval $s; # initialization
351 die "Can't find/load $CLASS.pm : $@\n" if $@;
355 local $^W = 0 if $] < 5.004; # to avoid a warning for each '+=' first use.
356 LINE: while (!eof ()) {
359 $total_size += $size;
361 # Syslog optimization
368 if ($_ =~ /last message repeated (\d+) times?$/o) {
378 next LINE if $_ eq '';
381 my ($day, $hour, $prog, $left) =
382 $_ =~ m/^(\S+\s+\S+) (\S+) \S+ (\S+): \[ID \d+ \S+\] (.*)$/o;
383 ($day, $hour, $prog, $left) =
384 $_ =~ m/^(\S+\s+\S+) (\S+) \S+ (\S+): (.*)$/o unless $day;
385 ($day, $hour, $prog, $left) =
386 $_ =~ m/^(\S+\s+\S+) (\S+) \d+ \S+ (\S+): (.*)$/o unless $day;
389 ($day, $hour, $res, $left) = $_ =~ m/^(\S+\s+\S+) (\S+)\.\d+ (\S+) (.*)$/o;
391 my $cvtdate = &ConvDate ("$day $hour");
392 if ($cvtdate < $first_date_cvt) {
393 $first_date_cvt = $cvtdate;
394 $first_date = "$day $hour";
396 elsif ($cvtdate > $last_date_cvt) {
397 $last_date_cvt = $cvtdate;
398 $last_date = "$day $hour";
404 # Unrecognize line... skip
405 $unrecognize[$unrecognize_max] = $_
406 unless $unrecognize_max > $MAX_UNRECOGNIZED
407 && $MAX_UNRECOGNIZED > 0;
413 my $cvtdate = &ConvDate ("$day $hour");
414 if ($cvtdate < $first_date_cvt) {
415 $first_date_cvt = $cvtdate;
416 $first_date = "$day $hour";
418 elsif ($cvtdate > $last_date_cvt) {
419 $last_date_cvt = $cvtdate;
420 $last_date = "$day $hour";
427 my ($pid) = $prog =~ s/\[(\d+)\]$//o;
430 # wordX -> word (where X is a digit)
434 $prog_size{$prog} = 0 unless defined $prog_size{$prog}; # stupid warning :(
435 $prog_size{$prog} += $size;
437 # The "heart" of the tool.
441 &{$CLASS."::collect"} ($day, $hour, $prog, $res, $left, $CASE_SENSITIVE);
444 $unrecognize[$unrecognize_max] = $_
445 unless $unrecognize_max > $MAX_UNRECOGNIZED
446 && $MAX_UNRECOGNIZED > 0;
452 &{$CLASS . "::adjust"} ($first_date, $last_date);
457 die "no data. Abort.\n" unless $total_line;
459 my $sec_glob = &ConvDate ("$last_date") - &ConvDate ("$first_date");
461 print "WARNING: bad date (\"$last_date\" or \"$first_date\")\n" .
462 " Please, contact the author of innreport.\n";
463 $sec_glob = 24 * 60 * 60; # one day
469 # Create a new filename (unique and _sortable_)
471 # The filename will contain the first date of the log or the current time.
472 my ($ts, $tm, $th, $dd, $dm, $dy) = localtime;
473 my ($m, $d, $h, $mn, $s) =
474 $first_date =~ /^(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)$/;
476 my $ddm = (index "JanFebMarAprMayJunJulAugSepOctNovDec", $m) / 3;
477 # Adjust the year because syslog doesn't record it. We assume that
478 # it's the current year unless the last date is in the future.
479 my $ld = &ConvDate($last_date);
480 $dy-- if $ld > $ts + 60 * ($tm + 60 * ($th + 24 * ($dd - 1 +
481 substr("000031059090120151181212243273304334", $dm * 3, 3)))) ||
482 $ld < &ConvDate($first_date);
483 ($dm, $dd, $th, $tm, $ts) = ($ddm, $d, $h, $mn, $s);
485 $dm++; # because January = 0 and we prefer 1
486 $dy += 100 if $dy < 90; # Try to pacify the year 2000 !
488 $suffix = sprintf ".%02d.%02d.%02d-%02d$SEPARATOR%02d$SEPARATOR%02d",
489 $dy, $dm, $dd, $th, $tm, $ts;
494 $HTML_output = "$HTML_dir" . "/news-notice" . "$suffix" . ".html";
495 $HTML_output =~ s|/+|/|g;
496 if (defined $output{'default'}{'html_header_file'}) {
497 my $file = &GetValue ($output{'default'}{'html_header_file'});
498 $file = $HTML_dir . "/" . $file;
499 open (F, $file) && do {
505 if (defined $output{'default'}{'html_footer_file'}) {
506 my $file = &GetValue ($output{'default'}{'html_footer_file'});
507 $file = $HTML_dir . "/" . $file;
508 open (F, $file) && do {
516 &Write_all_results ($HTML_output, \%output);
518 &Make_Index ($HTML_dir, $index, "news-notice$suffix.html", \%output)
521 #====================================================================
525 &Rotate ($CYCLE, $HTML_dir, "news-notice", ".html");
529 foreach $report (@{$output{'_order_'}}) {
530 next if $report =~ m/^(default|index)$/;
531 next unless defined $output{$report}{'graph'};
534 while ($GRAPH && defined ${${$output{$report}{'graph'}}[$i]}{'type'}) {
535 my $name = $report . ($i ? $i : '');
536 &Rotate ($CYCLE, $IMG_dir, $name, '.' . $GD_FORMAT);
542 # Code needed by INN only. It must be in innreport_inn.pm to keep things clean.
543 if (!$NOT_DAILY && defined $output{'default'}{'unwanted_log'}) {
544 my $logfile = &GetValue ($output{'default'}{'unwanted_log'});
545 my $logpath = &GetValue ($output{'default'}{'logpath'});
548 &{$CLASS . "::report_unwanted_ng"} ("$logpath/$logfile");
554 ###################################################################
559 # Compare 2 dates (+hour)
561 # ex: "May 12 06" for May 12, 6:00am
563 # The 2 dates are near. The range is less than a few days that's why we
564 # can cheat to determine the order. It is only important if one date
565 # is in January and the other in December.
567 my $date1 = substr ($a, 4, 2) * 24;
568 my $date2 = substr ($b, 4, 2) * 24;
569 $date1 += index("JanFebMarAprMayJunJulAugSepOctNovDec",substr($a,0,3)) * 288;
570 $date2 += index("JanFebMarAprMayJunJulAugSepOctNovDec",substr($b,0,3)) * 288;
571 if ($date1 - $date2 > 300 * 24) {
572 $date2 += 288 * 3 * 12;
574 elsif ($date2 - $date1 > 300 * 24) {
575 $date1 += 288 * 3 * 12;
577 $date1 += substr($a, 7, 2);
578 $date2 += substr($b, 7, 2);
583 # Convert: seconds to hh:mm:ss
588 $temp = sprintf "%02d", $t / 3600;
589 my $chaine = "$temp:";
592 $temp = sprintf "%02d", $t / 60;
596 $chaine .= sprintf "%02d", $t;
600 # Convert: milliseconds to hh:mm:ss:mm
605 $temp = sprintf "%02d", $t / 3600000;
606 my $chaine = "$temp:";
609 $temp = sprintf "%02d", $t / 60000;
613 $temp = sprintf "%02d", $t / 1000;
617 $chaine .= sprintf "%03d", $t;
621 # Rotate the archive files..
623 # Usage: &Rotate ($max_files, "$directory", "prefix", "suffix");
624 my ($max, $rep, $prefix, $suffix) = @_;
625 my ($file, $num, %files);
628 return 1 unless $max;
629 opendir (DIR, "$rep") || die "Error: Cant open directory \"$rep\"\n";
631 FILE : while (defined ($file = readdir (DIR))) {
633 unless $file =~ /^ # e.g. news-notice.1997.05.14-01:34:29.html
634 $prefix # Prefix : news-notice
636 (\d\d)?\d\d # Year : 1997 (or 97)
643 $SEPARATOR # Separator : ":"
645 $SEPARATOR # Separator : ":"
647 $suffix # Suffix : ".html"
653 foreach $file (sort {$b cmp $a} (keys (%files))) {
654 unlink "$rep/$file" if $num++ >= $max && -f "$rep/$file";
659 # convert a date to a number of seconds
661 # usage: $num = &ConvDate ($date);
662 # date format is Aug 22 01:49:40
664 my ($m, $d, $h, $mn, $s) = $T =~ /^(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)$/;
665 my $out = $s + 60 * $mn + 3600 * $h + 86400 * ($d - 1);
667 $m = substr("000031059090120151181212243273304334",
668 index ("JanFebMarAprMayJunJulAugSepOctNovDec", $m), 3);
673 # Compare 2 filenames
676 my ($la, $lb) = ($a, $b);
677 my ($ya) = $la =~ m/news-notice\.(\d+)\./o;
678 $ya += 100 if $ya < 90; # Try to pacify the year 2000 !
679 $ya += 1900 if $ya < 1900; # xx -> xxxx
680 my ($yb) = $lb =~ m/news-notice\.(\d+)\./o;
681 $yb += 100 if $yb < 90; # Try to pacify the year 2000 !
682 $yb += 1900 if $yb < 1900; # xx -> xxxx
684 $la =~ s/news-notice\.(\d+)\./$ya\./;
685 $lb =~ s/news-notice\.(\d+)\./$yb\./;
686 $la =~ s/[\.\-\:html]//g;
687 $lb =~ s/[\.\-\:html]//g;
696 foreach $key (keys (%$h)) {
702 sub ComputeTotalDouble {
706 foreach $key1 (keys (%$h)) {
707 foreach $key2 (keys (%{$$h{$key1}})) {
708 $total += ${$$h{$key1}}{$key2};
714 # make an index for archive pages
716 my ($rep, $index, $filename, $data) = @_;
719 $index =~ s/^\"\s*(.*?)\s*\"$/$1/o;
721 # add requested data at the end of the database.
722 open (DATA, ">> $rep/innreport.db") || die "can't open $rep/innreport.db\n";
724 my $res = "$filename";
725 while (defined ${${$output{'index'}{'column'}}[$i]}{'value'}) {
726 my $data = &GetValue (${${$output{'index'}{'column'}}[$i]}{'value'});
728 my @list = split /\|/, $data;
730 foreach $val (@list) {
731 $res .= ($val eq 'date' ? "|$first_date -- $last_date"
732 : "|" . &EvalExpr($val));
739 # sort the database (reverse order), remove duplicates.
740 open (DATA, "$rep/innreport.db") || die "can't open $rep/innreport.db\n";
743 m/^([^\|]+)\|(.*)$/o;
747 open (DATA, "> $rep/innreport.db") || die "can't open $rep/innreport.db\n";
749 foreach (sort {$b cmp $a} (keys %data)) {
750 print DATA "$_|$data{$_}\n" if $CYCLE == 0 || $i < $CYCLE;
755 my $title = "Daily Usenet report";
756 $title = &GetValue ($output{'default'}{'title'})
757 if defined $output{'default'}{'title'};
758 $title =~ s/\\\"/\"/g;
760 $Title =~ s/<.*?>//g;
762 $body = &GetValue ($output{'default'}{'html_body'})
763 if defined $output{'default'}{'html_body'};
764 $body =~ s/\\\"/\"/go;
765 my $result = sprintf <<EOF;
766 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
768 <TITLE>$Title: index</TITLE>
771 <HR ALIGN=CENTER SIZE=\"4\" WIDTH=\"100%%\">
772 <BR><CENTER><FONT SIZE=\"+2\">
773 <B>$title - archives</B>
776 <HR ALIGN=CENTER SIZE=4 WIDTH=\"100%%\"><P>
782 while (defined ${${$output{'index'}{'graph'}}[$i]}{'title'}) {
783 my $title = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'title'});
784 my $filename = "index$i.$GD_FORMAT";
785 my $color_bg = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'color'});
786 my $unit = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'unit'});
787 my $date_idx = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'value'});
788 $date_idx =~ s/^val(\d+)$/$1/o;
789 my @c = @{${${$output{'index'}{'graph'}}[$i]}{'data'}};
790 my $label_in = &GetValue (${$c[0]}{'name'});
791 my $color_in = &GetValue (${$c[0]}{'color'});
792 my $value_in = &GetValue (${$c[0]}{'value'});
794 $type_in = $value_in =~ s/^byte\((.*?)\)$/$1/o;
795 $value_in =~ s/^val(\d+)$/$1/o;
796 my $label_out = &GetValue (${$c[1]}{'name'});
797 my $color_out = &GetValue (${$c[1]}{'color'});
798 my $value_out = &GetValue (${$c[1]}{'value'});
800 $type_out = $value_out =~ s/^byte\((.*?)\)$/$1/o;
801 $value_out =~ s/^val(\d+)$/$1/o;
802 my (%in, %out, %dates, $k);
803 foreach $k (keys (%data)) {
804 my @res = split /\|/, $data{$k};
805 my ($year) = $k =~ m/^news-notice\.(\d+)\.\d+\.\d+-\d+.\d+.\d+\.html/;
806 next unless $year; # bad filename.. strange.
808 $res[$date_idx - 1] =~ m/^(\w+\s+\d+ \S+) -- (\w+\s+\d+ \S+)$/o;
809 next unless $start; # bad date
810 $start = &ConvDate ($start);
811 $end = &ConvDate ($end);
813 my $inc = $end < $start ? 1 : 0;
814 $start += (($year - 1970) * 365 +
815 int (($year - 1968) / 4)) * 3600 * 24;
817 $end += (($year - 1970) * 365 + int (($year - 1968) / 4)) * 3600 * 24;
818 $in{$start} = $type_in ? &kb2i($res[$value_in - 1])
819 : $res[$value_in - 1];
820 $out{$start} = $type_out ? &kb2i($res[$value_out - 1])
821 : $res[$value_out - 1];
822 $dates{$start} = $end;
824 my ($xmax, $ymax) = (500, 170);
825 &Chrono ("$IMG_dir/$filename", $title, $color_bg, $xmax, $ymax,
826 \%in, \%out, \%dates, $label_in, $label_out,
827 $color_in, $color_out, $unit);
828 $result .= "<IMG WIDTH=\"$xmax\" HEIGHT=\"$ymax\" ";
829 $result .= "SRC=\"$IMG_pth$filename\" ALT=\"Graph\">\n";
835 $result .= "<TABLE BORDER=\"1\"><TR>";
837 while (defined ${${$output{'index'}{'column'}}[$i]}{'title'}) {
838 my $title = &GetValue (${${$output{'index'}{'column'}}[$i]}{'title'});
840 $name = &GetValue (${${$output{'index'}{'column'}}[$i]}{'name'})
841 if defined ${${$output{'index'}{'column'}}[$i]}{'name'};
842 my @list = split /\|/, $name;
844 $result .= sprintf "<TH COLSPAN=%d>$title</TH>", $#list + 1;
847 $result .= "<TH ROWSPAN=\"2\">$title</TH>";
850 $temp .= "<TH>$_</TH>";
854 $result .= "</TR>\n<TR>$temp</TR>\n";
857 foreach (sort {$b cmp $a} (keys %data)) {
858 if ($CYCLE == 0 || $i < $CYCLE) {
859 my @list = split /\|/, $data{$_};
860 my $str = "<TR><TD ALIGN=LEFT>";
861 $str .= "<A HREF=\"$_\">" if -e "$rep/$_";
863 $str .= "</A>" if -e "$rep/$_";;
866 $str .= "<TD ALIGN=RIGHT>";
868 $t =~ s/^\0+//o; # remove garbage, if any.
876 $result .= "</TABLE>\n</CENTER>\n<P><HR>";
877 $result .= "innreport $version (c) 1996-1999 ";
878 $result .= "by Fabien Tassin <<A HREF=\"mailto:fta\@sofaraway.org\">";
879 $result .= "fta\@sofaraway.org</A>>.\n";
880 if (defined ($output{'default'}{'footer'})) {
881 my ($t) = $output{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o;
883 $result .= "<BR>" . $t;
885 $result .= "$HTML_footer\n</BODY>\n</HTML>\n";
886 my $name = $rep . "/" . $index;
887 while ($name =~ m/\/\.\.\//o) {
888 $name =~ s|^\./||o; # ^./xxx => ^xxx
889 $name =~ s|/\./|/|go; # xxx/./yyy => xxx/yyy
890 $name =~ s|/+|/|go; # xxx//yyy => xxx/yyy
891 $name =~ s|^/\.\./|/|o; # ^/../xxx => ^/xxx
892 $name =~ s|^[^/]+/\.\./||o; # ^xxx/../ => ^nothing
893 $name =~ s|/[^/]+/\.\./|/|go; # /yyy/../ => /
896 open (INDEX, "> $name") || die "Error: Unable to create $name\n";
903 my $filename = shift; # filename
904 my $title = shift; # title
905 my $xmax = shift; # width
906 my $n = shift; # Number of hash code tables
911 for $i (0 .. $n - 1) {
912 push @val, shift; # hash code table
914 my $colors = shift; # colors table
915 my $labels = shift; # labels
920 foreach $k (sort keys (%{$val[0]})) {
923 for $i (0 .. $n - 1) {
924 $t += ${$val[$i]}{$k} if defined ${$val[$i]}{$k};
926 $max = $t if $max < $t;
928 $max_size = $t if $max_size < $t;
930 $max = 1 unless $max;
931 $max_size *= gdSmallFont->width;
934 my ($rx, $ry) = (15, 5);
937 my ($mt, $mb) = (40, 40);
938 my $ml = $max_size > 30 ? $max_size + 8 : 30;
940 my $mr = 7 + (length "$max") * gdSmallFont->width;
941 $mr = 30 if $mr < 30;
946 # difference between 2 bars
949 my $ymax = $size * $d + $mt + $mb;
950 my $image = new GD::Image ($xmax, $ymax);
953 if (defined $output{'default'}{'graph_fg'}) {
954 my $t = $output{'default'}{'graph_fg'};
955 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
956 $t =~ m/^[\da-fA-F]{6}$/o ||
957 die "Error in section 'default' section 'graph_fg'. Bad color.\n";
958 my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
959 $black = $image->colorAllocate (@c);
962 $black = $image->colorAllocate ( 0, 0, 0);
964 if (defined $output{'default'}{'graph_bg'}) {
965 my $t = $output{'default'}{'graph_bg'};
966 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
967 $t =~ m/^[\da-fA-F]{6}$/o ||
968 die "Error in section 'default' section 'graph_bg'. Bad color.\n";
969 my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
970 $white = $image->colorAllocate (@c);
973 $white = $image->colorAllocate (255, 255, 255);
975 $image->filledRectangle (0, 0, $xmax, $ymax, $white);
977 for $i (0 .. $n - 1) {
978 $col[$i][0] = $image->colorAllocate
979 ($$colors[$i][0], $$colors[$i][1], $$colors[$i][2]);
980 $col[$i][1] = $image->colorAllocate
981 ($$colors[$i][0] * 3 / 4, $$colors[$i][1] * 3 / 4,
982 $$colors[$i][2] * 3 / 4);
983 $col[$i][2] = $image->colorAllocate
984 ($$colors[$i][0] * 2 / 3, $$colors[$i][1] * 2 / 3,
985 $$colors[$i][2] * 2 / 3);
988 $image->transparent ($white) if $transparent;
990 $image->rectangle (0, 0, $xmax - 1, $size * $d + $mt + $mb - 1, $black);
991 $image->line (0, $mt - 5, $xmax - 1, $mt - 5, $black);
992 for $i (0 .. $n - 1) {
993 $image->string (gdSmallFont, $i * $xmax / $n + $mt - 10 + $rx,
994 ($mt - gdSmallFont->height) / 2, "$$labels[$i]", $black);
995 $image->filledRectangle ($i * $xmax / $n + 10, 8 + $ry / 2,
996 $i * $xmax / $n + $mt - 10, $mt - 12, $col[$i][0]);
997 $image->rectangle ($i * $xmax / $n + 10, 8 + $ry / 2,
998 $i * $xmax / $n + $mt - 10, $mt - 12, $black);
1000 my $poly = new GD::Polygon;
1001 $poly->addPt($i * $xmax / $n + 10, 8 + $ry / 2);
1002 $poly->addPt($i * $xmax / $n + 10 + $rx / 2, 8);
1003 $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, 8);
1004 $poly->addPt($i * $xmax / $n + $mt - 10, 8 + $ry / 2);
1006 $image->filledPolygon($poly, $col[$i][1]);
1007 $image->polygon($poly, $black);
1010 my $poly = new GD::Polygon;
1011 $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, 8);
1012 $poly->addPt($i * $xmax / $n + $mt - 10, 8 + $ry / 2);
1013 $poly->addPt($i * $xmax / $n + $mt - 10, $mt - 12);
1014 $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, $mt - 12 - $ry / 2);
1016 $image->filledPolygon($poly, $col[$i][2]);
1017 $image->polygon($poly, $black);
1021 $image->string (gdMediumBoldFont, ($xmax - gdMediumBoldFont->width *
1022 (length "$title")) / 2, $ymax - gdMediumBoldFont->height - 7,
1025 my $e = $mt - $h + $d;
1026 my $r = ($xmax - $ml - $mr - $rx) / $max;
1029 $image->line ($ml + $rx, $mt, $ml + $rx, $size * $d + $mt - $ry, $black);
1030 $image->line ($ml + $rx + $max * $r, $mt, $ml + $rx + $max * $r,
1031 $size * $d + $mt - $ry, $black);
1032 $image->line ($ml, $mt + $ry, $ml, $size * $d + $mt, $black);
1034 $image->line ($ml + $rx, $size * $d + $mt - $ry,
1035 $ml + $rx - 2 * $rx, $size * $d + $mt + $ry, $black);
1037 $image->line ($ml + $rx, $size * $d + $mt - $ry,
1038 $xmax - $mr / 2, $size * $d + $mt - $ry, $black);
1039 $image->line ($ml, $size * $d + $mt,
1040 $xmax - $mr - $rx, $size * $d + $mt, $black);
1044 for $k (1 .. ($nn - 1)) {
1045 $image->dashedLine ($ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
1046 $mt + 10, $ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
1047 $size * $d + $mt - $ry, $black);
1048 $image->dashedLine ($ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
1049 $size * $d + $mt - $ry,
1050 $ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
1051 $size * $d + $mt, $black);
1052 $image->line ($ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
1054 $ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
1055 $size * $d + $mt + 5, $black);
1056 my $t = sprintf "%d%%", $k * 10;
1057 $image->string (gdSmallFont, $ml + $k * ($xmax - $ml - $mr - $rx) / $nn -
1058 (length "$t") * gdSmallFont->width / 2,
1059 $size * $d + $mt + 6, "$t", $black);
1062 my $t = sprintf "%d%%", 0;
1063 $image->line ($ml, $size * $d + $mt, $ml, $size * $d + $mt + 5, $black);
1064 $image->string (gdSmallFont, $ml - (length "$t") * gdSmallFont->width / 2,
1065 $size * $d + $mt + 6, "$t", $black);
1066 $image->line ($xmax - $mr, $size * $d + $mt - $ry,
1067 $xmax - $mr - $rx, $size * $d + $mt, $black);
1068 $image->line ($xmax - $mr - $rx, $size * $d + $mt,
1069 $xmax - $mr - $rx, $size * $d + $mt + 5, $black);
1070 $t = sprintf "%d%%", 100;
1071 $image->string (gdSmallFont, $xmax - $mr - $rx
1072 - (length "$t") * gdSmallFont->width / 2,
1073 $size * $d + $mt + 6, "$t", $black);
1075 foreach $k (sort {${$val[0]}{$b} <=> ${$val[0]}{$a}} keys (%{$val[0]})) {
1076 $image->string (gdSmallFont, $ml - (length "$k") * gdSmallFont->width - 3,
1077 $e + $h / 2 - gdSmallFont->height / 2, "$k", $black);
1079 $image->line ($ml + ($t + ${$val[0]}{$k}) * $r + $rx - $rx, $e + $h,
1080 $ml + ($t + ${$val[0]}{$k}) * $r + $rx, $e - $ry + $h,
1082 for $i (0 .. $n - 1) {
1083 next unless defined ${$val[$i]}{$k};
1085 my $poly = new GD::Polygon;
1086 $poly->addPt($ml + $t * $r, $e);
1087 $poly->addPt($ml + $t * $r + $rx, $e - $ry);
1088 $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry);
1089 $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r, $e);
1091 $image->filledPolygon($poly, $col[$i][1]);
1092 $image->polygon($poly, $black);
1094 unless (${$val[$i + 1]}{$k} || ${$val[$i]}{$k} == 0) {
1095 my $poly = new GD::Polygon;
1096 $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry);
1097 $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx - $rx, $e);
1098 $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx - $rx, $e + $h);
1099 $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry + $h);
1101 $image->filledPolygon($poly, $col[$i][2]);
1102 $image->polygon($poly, $black);
1104 $image->filledRectangle ($ml + $t * $r, $e,
1105 $ml + ($t + ${$val[$i]}{$k}) * $r, $e + $h,
1107 $image->rectangle ($ml + $t * $r, $e, $ml + ($t + ${$val[$i]}{$k}) * $r,
1109 $t += ${$val[$i]}{$k};
1111 # total length (offered)
1112 $image->filledRectangle ($ml + $t * $r + $rx + 3,
1113 $e - 2 - gdSmallFont->height / 2,
1114 $ml + $t * $r + $rx + 4 +
1115 gdSmallFont->width * length $t,
1116 $e - 6 + gdSmallFont->height / 2, $white);
1117 $image->string (gdSmallFont, $ml + $t * $r + $rx + 5,
1118 $e - 3 - gdSmallFont->height / 2, "$t", $black);
1119 # first value (accepted)
1120 $image->filledRectangle ($ml + $t * $r + $rx + 3,
1121 $e - 4 + gdSmallFont->height / 2,
1122 $ml + $t * $r + $rx + 4 +
1123 gdSmallFont->width * length "${$val[0]}{$k}",
1124 $e - 2 + gdSmallFont->height, $white);
1125 $image->string (gdSmallFont, $ml + $t * $r + $rx + 5,
1126 $e - 5 + gdSmallFont->height / 2, ${$val[0]}{$k}, $black);
1129 open (IMG, "> $filename") || die "Error: Can't open \"$filename\": $!\n";
1130 if ($GD_FORMAT eq 'png') {
1131 print IMG $image->png;
1134 print IMG $image->gif;
1141 my ($filename, $title, $xmax, $factor,
1142 $labelx, $labely, $val1, $labels1) = @_;
1148 # A hugly hack to convert hashes to lists..
1149 # and to adjust the first and the last value...
1150 # this function should be rewritten..
1152 foreach $kk (sort keys (%$val1)) {
1153 if (defined $$val1{$kk}) {
1155 # Arg... the following MUST be removed !!!!!!!!!
1156 $$val1{$kk} = $$val1{$kk} / $innreport_inn::inn_flow_time{$kk} * 3600
1157 if ($innreport_inn::inn_flow_time{$kk} != 3600) &&
1158 ($innreport_inn::inn_flow_time{$kk} != 0);
1159 push @a, $$val1{$kk};
1160 $max = $$val1{$kk} if $$val1{$kk} > $max;
1161 push @b, $$labels1{$kk};
1164 return 0 unless $nb; # strange, no data.
1168 my ($marginl, $marginr, $margint, $marginb, $shx, $shy);
1170 my $image = new GD::Image($xmax, $ymax);
1171 my ($white, $black);
1172 if (defined $output{'default'}{'graph_fg'}) {
1173 my $t = $output{'default'}{'graph_fg'};
1174 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1175 $t =~ m/^[\da-fA-F]{6}$/o ||
1176 die "Error in section 'default' section 'graph_fg'. Bad color.\n";
1177 my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
1178 $black = $image->colorAllocate (@c);
1181 $black = $image->colorAllocate ( 0, 0, 0);
1183 if (defined $output{'default'}{'graph_bg'}) {
1184 my $t = $output{'default'}{'graph_bg'};
1185 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1186 $t =~ m/^[\da-fA-F]{6}$/o ||
1187 die "Error in section 'default' section 'graph_bg'. Bad color.\n";
1188 my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
1189 $white = $image->colorAllocate (@c);
1192 $white = $image->colorAllocate (255, 255, 255);
1194 $image->filledRectangle (0, 0, $xmax, $ymax, $white);
1195 my $gray = $image->colorAllocate (128, 128, 128);
1196 my $red = $image->colorAllocate (255, 0, 0);
1197 my $red2 = $image->colorAllocate (189, 0, 0);
1198 my $red3 = $image->colorAllocate (127, 0, 0);
1199 my $coltxt = $black;
1201 $image->transparent ($white) if $transparent;
1203 my $FontWidth = gdSmallFont->width;
1204 my $FontHeight = gdSmallFont->height;
1213 $max = 1 unless $max;
1219 my $t = log ($max) / log 10;
1220 $t = sprintf "%.0f", $t - 1;
1221 $t = exp ($t * log 10);
1222 $max = sprintf "%.0f", $max / $t * 10 + 0.4;
1223 my $t2 = sprintf "%.0f", $max / $part;
1224 unless ($part * $t2 == $max) {
1225 while ($part * $t2 != $max) {
1227 $t2 = sprintf "%d", $max / $part;
1230 $max = $max * $t / 10;
1234 $image->string (gdMediumBoldFont,
1235 ($xmax - length ($title) * gdMediumBoldFont->width) / 2,
1236 ($margint - $shy - gdMediumBoldFont->height) / 2,
1240 $image->string (gdSmallFont, $marginl / 2, $margint / 2, $labely, $coltxt);
1241 $image->string (gdSmallFont, $xmax - $marginr / 2 -
1242 $FontWidth * length ($labelx), $ymax - $marginb / 2,
1246 $image->line ($marginl, $ymax - $marginb - $shy -
1247 $old_max * ($ymax - $marginb - $margint - $shy) / $max,
1248 $xmax - $marginr, $ymax - $marginb - $shy -
1249 $old_max * ($ymax - $marginb - $margint - $shy) / $max, $red);
1250 $image->line ($marginl, $ymax - $marginb - $shy -
1251 $old_max * ($ymax - $marginb - $margint - $shy) / $max,
1252 $marginl - $shx, $ymax - $marginb -
1253 $old_max * ($ymax - $marginb - $margint - $shy) / $max, $red);
1256 $image->line ($marginl - $shx, $margint + $shy,
1257 $marginl - $shx, $ymax - $marginb, $coltxt);
1258 $image->line ($marginl, $margint,
1259 $marginl, $ymax - $marginb - $shy, $coltxt);
1260 $image->line ($marginl, $margint,
1261 $marginl - $shx, $margint + $shy, $coltxt);
1262 $image->line ($marginl - $shx, $ymax - $marginb,
1263 $marginl, $ymax - $marginb - $shy, $coltxt);
1266 $image->line ($xmax - $marginr, $margint,
1267 $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
1268 $image->line ($xmax - $marginr - $shx, $ymax - $marginb,
1269 $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
1272 $image->line ($marginl - $shx, $ymax - $marginb,
1273 $xmax - $marginr - $shx, $ymax - $marginb, $coltxt);
1274 $image->line ($marginl, $ymax - $marginb - $shy,
1275 $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
1276 $image->fill ($xmax / 2, $ymax - $marginb - $shy / 2, $gray);
1279 $image->line ($marginl, $margint,
1280 $xmax - $marginr, $margint, $coltxt);
1281 $image->setStyle ($coltxt, $coltxt, &GD::gdTransparent,
1282 &GD::gdTransparent, &GD::gdTransparent);
1284 for ($i = 0; $i <= $part; $i++) {
1285 $j = $max * $i / $part ; # Warning to floor
1286 # $j = ($max / $part) * ($i / 10000);
1290 $j = sprintf "%d", $j if $j > 100;
1292 $image->line ($marginl - $shx - 3, $ymax - $marginb -
1293 $i * ($ymax - $marginb - $margint - $shy) / $part,
1294 $marginl - $shx, $ymax - $marginb -
1295 $i * ($ymax - $marginb - $margint - $shy) / $part, $coltxt);
1296 $image->line ($marginl - $shx, $ymax - $marginb -
1297 $i * ($ymax - $marginb - $margint - $shy) / $part,
1298 $marginl, $ymax - $marginb - $shy -
1299 $i * ($ymax - $marginb - $margint - $shy) / $part, gdStyled);
1300 $image->line ($marginl, $ymax - $marginb - $shy -
1301 $i * ($ymax - $marginb - $margint - $shy) / $part,
1302 $xmax - $marginr, $ymax - $marginb - $shy -
1303 $i * ($ymax - $marginb - $margint - $shy) / $part, gdStyled);
1304 $image->string (gdSmallFont,
1305 $marginl - $shx - $FontWidth * length ("$j") - 7,
1307 ($i) * ($ymax - $marginb - $margint - $shy) / ($part) -
1308 $FontHeight / 2, "$j", $coltxt);
1311 # Graduation (right bottom corner)
1312 $image->line ($xmax - $marginr - $shx, $ymax - $marginb,
1313 $xmax - $marginr - $shx, $ymax - $marginb + 3, $coltxt);
1316 my $w = ($xmax - $marginl - $marginr) / $nb;
1318 $$val[$nb - 1] = 0 unless $$val[$nb - 1];
1319 foreach $j (@$val) {
1323 $image->line ($marginl + ($i - 1) * $w - $shx, $ymax - $marginb,
1324 $marginl + ($i - 1) * $w - $shx, $ymax - $marginb + 3,
1326 my $ii = sprintf "%d", $i / $MAX;
1327 $image->string (gdSmallFont,
1328 $marginl + ($i - 0.5) * $w + 1 -
1329 ($FontWidth * length ($$labels[$i-1])) / 2 - $shx,
1330 $ymax - $marginb + 3, $$labels[$i-1], $coltxt)
1331 unless ($w < $FontWidth * length ($$labels[$i-1]))
1332 && ($i != $MAX * $ii);
1335 my $poly = new GD::Polygon;
1336 $poly->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy -
1337 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1338 $poly->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy);
1339 $poly->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb);
1340 $poly->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb -
1341 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1343 $image->filledPolygon($poly, $red3);
1344 $image->polygon($poly, $coltxt);
1347 $image->filledRectangle ($marginl + ($i - 1) * $w + $k - $shx,
1349 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max,
1350 $marginl + ($i) * $w - $k - $shx,
1351 $ymax - $marginb, $red);
1352 $image->rectangle ($marginl + ($i - 1) * $w + $k - $shx,
1354 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max,
1355 $marginl + ($i) * $w - $k - $shx,
1356 $ymax - $marginb, $coltxt);
1358 my $poly2 = new GD::Polygon;
1359 $poly2->addPt($marginl + ($i - 1) * $w + $k, $ymax - $marginb - $shy -
1360 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1361 $poly2->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy -
1362 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1363 $poly2->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb -
1364 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1365 $poly2->addPt($marginl + ($i - 1) * $w + $k - $shx, $ymax - $marginb -
1366 $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1368 $image->rectangle (0, 0, $xmax - 1, $ymax - 1, $coltxt);
1369 $image->filledPolygon($poly2, $red2);
1370 $image->polygon($poly2, $coltxt);
1374 open (IMG, "> $filename") || die "Can't create '$filename'\n";
1375 if ($GD_FORMAT eq 'png') {
1376 print IMG $image->png;
1379 print IMG $image->gif;
1386 my $filename = shift; # filename
1387 my $title = shift; # title
1388 my $color_bg = shift; # background color
1389 my $xmax = shift; # width
1390 my $ymax = shift; # height
1396 my $legend_in = shift;
1397 my $legend_out = shift;
1399 my $color_in = shift;
1400 my $color_out = shift;
1412 foreach $key (sort keys %$dates) {
1413 $x_min = $key if $x_min > $key;
1414 $x_max = $$dates{$key} if $x_max < $$dates{$key};
1415 my $t = $$out{$key} / ($$dates{$key} - $key);
1416 $y_max_out = $t if $y_max_out < $t;
1417 $t = $$in{$key} / ($$dates{$key} - $key);
1418 $y_max_in = $t if $y_max_in < $t;
1420 $y_max = $y_max_out > $y_max_in ? $y_max_out : $y_max_in;
1424 if ($y_max < 4 / 60) {
1428 $y_max = int ($y_max * $factor) + 1;
1429 $y_max += (4 - ($y_max % 4)) % 4;
1434 $y_max = int ($y_max) + 1;
1435 $y_max += (4 - ($y_max % 4)) % 4;
1438 $unit .= "/" . ($factor == 60 ? "min" : "sec");
1440 # min range is 4 weeks.
1441 my $delta = $x_max - $x_min;
1442 $x_min = $x_max - 3024000 if $delta < 3024000;
1443 # between 4 weeks and one year, range is a year.
1444 $x_min = $x_max - 31536000 if ($delta < 31536000 && $delta > 3024000);
1445 # max range is 13 months
1446 $x_min = $x_max - 34128000 if $delta > 34128000;
1447 my $image = new GD::Image ($xmax, $ymax);
1448 my ($white, $black);
1449 if (defined $output{'default'}{'graph_fg'}) {
1450 my $t = $output{'default'}{'graph_fg'};
1451 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1452 $t =~ m/^[\da-fA-F]{6}$/o ||
1453 die "Error in section 'default' section 'graph_fg'. Bad color.\n";
1454 my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
1455 $black = $image->colorAllocate (@c);
1458 $black = $image->colorAllocate ( 0, 0, 0);
1460 if (defined $output{'default'}{'graph_bg'}) {
1461 my $t = $output{'default'}{'graph_bg'};
1462 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1463 $t =~ m/^[\da-fA-F]{6}$/o ||
1464 die "Error in section 'default' section 'graph_bg'. Bad color.\n";
1465 my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
1466 $white = $image->colorAllocate (@c);
1469 $white = $image->colorAllocate (255, 255, 255);
1472 if (defined $color_bg) {
1473 $color_bg =~ m/^\#[\da-fA-F]{6}$/o ||
1474 die "Error in section 'index'. Bad color $color_bg.\n";
1475 my @c = map { hex $_ } ($color_bg =~ m/^\#(..)(..)(..)$/);
1476 $bg = $image->colorAllocate (@c);
1479 $bg = $image->colorAllocate (255, 255, 206);
1482 if (defined $color_in) {
1483 $color_in =~ m/^\#[\da-fA-F]{6}$/o ||
1484 die "Error in section 'index'. Bad color $color_in.\n";
1485 my @c = map { hex $_ } ($color_in =~ m/^\#(..)(..)(..)$/);
1486 $col_in = $image->colorAllocate (@c);
1489 $col_in = $image->colorAllocate ( 80, 159, 207);
1492 my @col_out = ( 0, 0, 255);
1493 if (defined $color_out) {
1494 $color_out =~ m/^\#[\da-fA-F]{6}$/o ||
1495 die "Error in section 'index'. Bad color $color_out.\n";
1496 my @c = map { hex $_ } ($color_out =~ m/^\#(..)(..)(..)$/);
1497 $col_out = $image->colorAllocate (@c);
1501 $col_out = $image->colorAllocate (@col_out);
1504 my $white2 = $image->colorAllocate (255, 255, 255);
1505 my $gray = $image->colorAllocate (192, 192, 192);
1506 my $red = $image->colorAllocate (255, 0, 0);
1507 my $coltxt = $black;
1509 my $size = 22; # legend
1511 my ($max_in, $max_out) = (0, 0); # min
1512 my ($min_in, $min_out) = (1E10, 1E10); # max
1513 my ($t_in, $t_out) = (0, 0); # time
1514 my ($s_in, $s_out) = (0, 0); # sum
1516 $image->filledRectangle (0, 0, $xmax, $ymax, $gray);
1517 $image->transparent ($gray) if $transparent;
1519 my $FontWidth = gdSmallFont->width;
1520 my $FontHeight = gdSmallFont->height;
1521 $image->setStyle ($black, &GD::gdTransparent, &GD::gdTransparent);
1523 my $marginl = 13 + $FontWidth * length (sprintf "%d", $y_max * $factor);
1524 my $marginr = 15 + 4 * $FontWidth; # "100%"
1525 my $margint = 2 * $FontHeight + gdMediumBoldFont->height;
1526 my $marginb = 2 * $FontHeight + $size;
1527 my $xratio = ($xmax - $marginl - $marginr) / ($x_max - $x_min);
1528 my $yratio = ($ymax - $margint - $marginb) / ($y_max - $y_min);
1530 my $frame = new GD::Polygon;
1531 $frame->addPt(2, $margint - $FontHeight -3);
1532 $frame->addPt($xmax - 2, $margint - $FontHeight -3);
1533 $frame->addPt($xmax - 2, $ymax - 3);
1534 $frame->addPt(2, $ymax - 3);
1535 $image->filledPolygon($frame, $white2);
1536 $image->polygon($frame, $black);
1538 $image->filledRectangle ($marginl, $margint,
1539 $xmax - $marginr, $ymax - $marginb, $bg);
1540 my $brush = new GD::Image(1, 2);
1541 my $b_col = $brush->colorAllocate(@col_out);
1542 $brush->line(0, 0, 0, 1, $b_col);
1543 $image->setBrush($brush);
1544 my ($old_x, $old_y_in, $old_y_out);
1545 foreach $key (sort keys %$dates) {
1546 next if $key < $x_min;
1547 my $delta = $$dates{$key} - $key;
1548 $min_in = $$in{$key} / $delta if $min_in > $$in{$key} / $delta;
1549 $max_in = $$in{$key} / $delta if $max_in < $$in{$key} / $delta;
1550 $min_out = $$out{$key} / $delta if $min_out > $$out{$key} / $delta;
1551 $max_out = $$out{$key} / $delta if $max_out < $$out{$key} / $delta;
1553 $s_in += $$in{$key};
1554 $s_out += $$out{$key};
1556 my $tt_in = $$in{$key} / ($$dates{$key} - $key) * $yratio;
1557 my $tt_out = $$out{$key} / ($$dates{$key} - $key) * $yratio;
1558 my $new_x = $marginl + ($key - $x_min) * $xratio;
1559 $image->filledRectangle ($marginl + ($key - $x_min) * $xratio,
1560 $ymax - $marginb - $tt_in,
1561 $marginl + ($$dates{$key} - $x_min) * $xratio,
1562 $ymax - $marginb, $col_in);
1563 if (defined $old_x) {
1564 $old_x = $new_x if $old_x > $new_x;
1565 my $poly = new GD::Polygon;
1566 $poly->addPt($old_x, $old_y_in);
1567 $poly->addPt($new_x, $ymax - $marginb - $tt_in);
1568 $poly->addPt($new_x, $ymax - $marginb);
1569 $poly->addPt($old_x, $ymax - $marginb);
1570 $image->filledPolygon($poly, $col_in);
1572 $image->line ($marginl + ($key - $x_min) * $xratio,
1573 $ymax - $marginb - $tt_out,
1574 $marginl + ($$dates{$key} - $x_min) * $xratio,
1575 $ymax - $marginb - $tt_out, &GD::gdBrushed);
1576 $image->line ($old_x, $old_y_out, $new_x,
1577 $ymax - $marginb - $tt_out, $col_out) if defined $old_x;
1578 $old_x = $marginl + ($$dates{$key} - $x_min) * $xratio;
1579 $old_y_in = $ymax - $marginb - $tt_in;
1580 $old_y_out = $ymax - $marginb - $tt_out;
1585 $image->rectangle ($marginl, $margint,
1586 $xmax - $marginr, $ymax - $marginb, $black);
1589 foreach $i (0, 25, 50, 75, 100) {
1590 my $t = $ymax - $margint - $marginb;
1591 $image->line ($marginl, $ymax - $marginb - $i / 100 * $t,
1592 $xmax - $marginr, $ymax - $marginb - $i / 100 * $t,
1594 $image->line ($xmax - $marginr, $ymax - $marginb - $i / 100 * $t,
1595 $xmax - $marginr + 3, $ymax - $marginb - $i / 100 * $t,
1597 $image->line ($marginl - 3, $ymax - $marginb - $i / 100 * $t,
1598 $marginl, $ymax - $marginb - $i / 100 * $t,
1600 $image->string (&GD::gdSmallFont, $xmax - $marginr + 8, - $FontHeight / 2 +
1601 $ymax - $marginb - $i / 100 * $t, "$i%", $black);
1602 my $s = sprintf "%d", $y_max * $i / 100 * $factor;
1603 $image->string (&GD::gdSmallFont, $marginl - 5 - $FontWidth * length $s,
1605 $ymax - $marginb - $i / 100 * $t, $s, $black);
1608 my $w = 604800; # number of seconds in a week
1609 my $y = 31536000; # number of seconds in a 365 days year
1610 my $mm = 2592000; # number of seconds in a 30 days month
1611 if ($x_max - $x_min <= 3024000) { # less than five weeks
1613 # 1/1/1990 is a monday. Use this as a basis.
1614 my $d = 631152000; # number of seconds between 1/1/1970 and 1/1/1990
1615 my $n = int ($x_min / $y);
1616 my $t = $x_min - $n * $y - int (($n - 2) / 4) * 24 * 3600;
1617 my $f = int ($t / $w);
1618 $n = $d + int (($x_min - $d) / $w) * $w;
1619 while ($n < $x_max) {
1620 $t = $marginl + ($n - $x_min) * $xratio;
1622 $image->line ($t, $margint, $t, $ymax - $marginb, &GD::gdStyled);
1623 $image->line ($t, $ymax - $marginb, $t, $ymax - $marginb + 2, $black);
1625 $image->string (&GD::gdSmallFont, $FontWidth * 7 / 2 + $t,
1626 $ymax - $marginb + 4, (sprintf "Week %02d", $f), $black)
1627 if ($n + $w / 2 > $x_min) && ($n + $w / 2 < $x_max);
1632 if $n - $y * $t - int (($t - 2) / 4) * 24 * 3600 < $w && $f > 50;
1635 $n = int ($x_min / $y);
1636 $t = $n * $y + int (($n - 2) / 4) * 24 * 3600;
1639 while ($t < $x_max) {
1640 $x = $marginl + ($t - $x_min) * $xratio;
1641 $image->line ($x, $margint, $x, $ymax - $marginb + 2, $red)
1644 $t += $d if $i == 0 || $i == 2 || $i == 4 ||
1645 $i == 6 || $i == 7 || $i == 9 || $i == 11; # 31 days months
1646 if ($i == 1) { # february ?
1648 $t += $d unless (1970 + int ($t / $y)) % 4;
1651 $i = 0 if $i == 12; # Happy New Year !!
1656 my $n = int ($x_min / $y);
1657 my $t = $n * $y + int (($n - 2) / 4) * 24 * 3600;
1658 my @m = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
1659 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
1660 my $d = 86400; # 1 day
1663 while ($t < $x_max) {
1664 $x = $marginl + ($t - $x_min) * $xratio;
1666 $image->line ($x, $margint, $x, $ymax - $marginb, &GD::gdStyled);
1667 $image->line ($x, $ymax - $marginb, $x,
1668 $ymax - $marginb + 2, $black);
1669 $image->line ($x, $margint, $x, $ymax - $marginb, $red) unless $i;
1671 $image->string (&GD::gdSmallFont,
1672 $mm * $xratio / 2 - $FontWidth * 3 / 2 +
1673 $x, $ymax - $marginb + 4, (sprintf "%s", $m[$i]),
1675 if ($t + 2 * $w > $x_min) && ($x_max > 2 * $w + $t);
1677 $t += $d if ($i == 0 || $i == 2 || $i == 4 ||
1678 $i == 6 || $i == 7 || $i == 9 || $i == 11); # 31 days months
1679 if ($i == 1) { # february ?
1681 $t += $d unless (1970 + int ($t / $y)) % 4;
1684 $i = 0 if $i == 12; # Happy New Year !!
1688 # Add the little red arrow
1689 my $poly = new GD::Polygon;
1690 $poly->addPt($xmax - $marginr - 2, $ymax - $marginb - 3);
1691 $poly->addPt($xmax - $marginr + 4, $ymax - $marginb);
1692 $poly->addPt($xmax - $marginr - 2, $ymax - $marginb + 3);
1693 $image->filledPolygon($poly, $red);
1696 $image->string (&GD::gdMediumBoldFont,
1697 $xmax / 2 - $FontWidth * length ($title) / 2, 4,
1701 my $y_in = $ymax - $size - $FontHeight + 5;
1702 $image->string (&GD::gdSmallFont, $marginl, $y_in, $legend_in, $col_in);
1703 $image->string (&GD::gdSmallFont, $xmax / 4, $y_in,
1704 (sprintf "Min: %5.1f $unit", $min_in * $factor), $black);
1705 $image->string (&GD::gdSmallFont, $xmax / 2, $y_in,
1706 (sprintf "Avg: %5.1f $unit", $s_in / $t_in * $factor), $black);
1707 $image->string (&GD::gdSmallFont, 3 * $xmax / 4, $y_in,
1708 (sprintf "Max: %5.1f $unit", $max_in * $factor), $black);
1710 my $y_out = $ymax - $size + 5;
1711 $image->string (&GD::gdSmallFont, $marginl, $y_out, $legend_out, $col_out);
1712 $image->string (&GD::gdSmallFont, $xmax / 4, $y_out,
1713 (sprintf "Min: %5.1f $unit", $min_out * $factor), $black);
1714 $image->string (&GD::gdSmallFont, $xmax / 2, $y_out,
1715 (sprintf "Avg: %5.1f $unit", $s_out / $t_out * $factor), $black);
1716 $image->string (&GD::gdSmallFont, 3 * $xmax / 4, $y_out,
1717 (sprintf "Max: %5.1f $unit", $max_out * $factor), $black);
1719 open (IMG, "> $filename") || die "Error: Can't open \"$filename\": $!\n";
1720 if ($GD_FORMAT eq 'png') {
1721 print IMG $image->png;
1724 print IMG $image->gif;
1730 sub Write_all_results {
1731 my $HTML_output = shift;
1735 my $title = $$h{'default'}{'title'} ?
1736 $$h{'default'}{'title'} : "Daily Usenet report";
1737 $title =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1738 $title =~ s/\\\"/\"/go;
1740 $Title =~ s/<.*?>//go;
1743 $Title =~ s/\&/&/go;
1744 $Title =~ s/\</</go;
1745 $Title =~ s/\>/>/go;
1746 print "$Title from $first_date to $last_date\n\n";
1750 my $body = defined $output{'default'}{'html_body'} ?
1751 $output{'default'}{'html_body'} : '';
1752 $body =~ s/^\"\s*(.*?)\s*\"$/ $1/o;
1753 $body =~ s/\\\"/\"/go;
1754 open (HTML, "> $HTML_output") || die "Error: cant open $HTML_output\n";
1756 print HTML "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n" .
1757 "<HTML>\n<HEAD>\n<TITLE>$Title: $first_date</TITLE>\n" .
1758 "<!-- innreport $version -->\n</HEAD>\n<BODY $body>\n" .
1759 "$HTML_header\n<CENTER><H1>$title</H1>\n" .
1760 "<H3>$first_date -- $last_date</H3>\n</CENTER>\n<P><HR><P>\n";
1763 print HTML "<UL>\n";
1764 foreach $k (@{$$h{'_order_'}}) {
1765 next if $k =~ m/^(default|index)$/;
1766 my ($data) = $$h{$k}{'data'} =~ m/^\"\s*(.*?)\s*\"$/o;
1767 $data =~ s/^\%/\%$CLASS\:\:/ unless $data eq '%prog_type';
1769 { local $^W = 0; no strict; %data = eval $data }
1770 my ($string) = $$h{$k}{'title'} =~ m/^\"\s*(.*?)\s*\"$/o;
1771 $string =~ s/\s*:$//o;
1774 ($want) = $$h{$k}{'skip'} =~ m/^\"?\s*(.*?)\s*\"?$/o
1775 if defined $$h{$k}{'skip'};
1776 $want = $want eq 'true' ? 0 : 1;
1777 print HTML "<LI><A HREF=\"#$k\">$string</A>\n" if %data && $want;
1779 print HTML "</UL><P><HR><P>\n";
1781 if (@unrecognize && $WANT_UNKNOWN) {
1782 my $mm = $#unrecognize;
1783 print HTML "<A NAME=\"unrecognize\">" if $HTML && $WANT_HTML_UNKNOWN;
1784 print "Unknown entries from news log file:\n";
1785 print HTML "<STRONG>Unknown entries from news log file:</STRONG></A><P>\n"
1786 if $HTML && $WANT_HTML_UNKNOWN;
1787 $mm = $MAX_UNRECOGNIZED - 1
1788 if $MAX_UNRECOGNIZED > 0 && $mm > $MAX_UNRECOGNIZED - 1;
1789 if ($mm < $unrecognize_max && $unrecognize_max > 0) {
1790 printf HTML "First %d / $unrecognize_max lines (%3.1f%%)<BR>\n", $mm + 1,
1791 ($mm + 1) / $unrecognize_max * 100 if $HTML && $WANT_HTML_UNKNOWN;
1792 printf "First %d / $unrecognize_max lines (%3.1f%%)\n", $mm + 1,
1793 ($mm + 1) / $unrecognize_max * 100;
1798 chomp $unrecognize[$l]; # sometimes, the last line need a CR
1799 print "$unrecognize[$l]\n"; # so, we always add one
1800 if ($HTML && $WANT_HTML_UNKNOWN) {
1801 $unrecognize[$l] =~ s/&/\&/g;
1802 $unrecognize[$l] =~ s/</\</g;
1803 $unrecognize[$l] =~ s/>/\>/g;
1804 print HTML "$unrecognize[$l]<BR>\n";
1808 print HTML "<P><HR><P>\n" if $HTML && $WANT_HTML_UNKNOWN;
1811 close HTML if $HTML;
1812 foreach $k (@{$$h{'_order_'}}) {
1813 next if $k =~ m/^(default|index)$/;
1814 &Write_Results($HTML_output, $k, $h);
1817 open (HTML, ">> $HTML_output") || die "Error: cant open $HTML_output\n";
1819 innreport $version (c) 1996-1999 by Fabien Tassin
1820 <<A HREF="mailto:fta\@sofaraway.org">fta\@sofaraway.org</A>>.
1822 if (defined $$h{'default'}{'footer'}) {
1823 my ($t) = $$h{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o;
1825 print HTML "<BR>" . $t;
1827 print HTML "\n$HTML_footer";
1828 printf HTML "\n<!-- Running time: %s -->", second2time(time - $start_time);
1829 print HTML "\n</BODY>\n</HTML>\n";
1835 my $HTML_output = shift;
1838 my %output = %$data;
1839 return 0 unless defined $output{$report}; # no data to write
1840 return 0 if defined $output{$report}{'skip'} &&
1841 $output{$report}{'skip'} =~ m/^true$/io;
1842 my ($TEXT, $HTML, $DOUBLE);
1844 # Need a text report ?
1845 $TEXT = defined $output{$report}{'text'} ? $output{$report}{'text'} :
1846 (defined $output{'default'}{'text'} ? $output{'default'}{'text'} : '');
1847 die "Error in config file. Field 'text' is mandatory.\n" unless $TEXT;
1848 $TEXT = ($TEXT =~ m/^true$/io) ? 1 : 0;
1850 # Need an html report ?
1852 $HTML = defined $output{$report}{'html'} ? $output{$report}{'html'} :
1853 (defined $output{'default'}{'html'} ? $output{'default'}{'html'} : '');
1854 die "Error in config file. Field 'html' is mandatory.\n" unless $HTML;
1855 $HTML = ($HTML =~ m/^true$/io) ? 1 : 0;
1858 $DOUBLE = defined $output{$report}{'double'} ?
1859 $output{$report}{'double'} : 0;
1860 $DOUBLE = ($DOUBLE =~ m/^true$/io) ? 1 : 0;
1862 # Want to truncate the report ?
1863 my $TOP = defined $output{$report}{'top'} ? $output{$report}{'top'} : -1;
1864 my $TOP_HTML = defined $output{$report}{'top_html'} ?
1865 $output{$report}{'top_html'} : $TOP;
1866 my $TOP_TEXT = defined $output{$report}{'top_text'} ?
1867 $output{$report}{'top_text'} : $TOP;
1871 my $t = $output{$report}{'data'} ||
1872 die "Error in section $report. Need a 'data' field.\n";
1873 $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1874 $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
1876 return unless %d; # nothing to report. exit.
1877 return unless keys (%d); # nothing to report. exit.
1880 my $t = defined $output{$report}{'sort'} ? $output{$report}{'sort'} :
1883 $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1884 $t =~ s/([\$\%\@])/$1${CLASS}\:\:/go;
1885 $t =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|num)/$1$2/go;
1886 $t =~ s/\{\$${CLASS}\:\:(a|b)\}/\{\$$1\}/go;
1887 $t =~ s/\$${CLASS}\:\:(a|b)/\$$1/go;
1892 open (HTML, ">> $HTML_output") || die "Error: cant open $HTML_output\n";
1894 print "\n" if $TEXT;
1895 my ($key, $key1, $key2);
1896 if (defined $output{$report}{'title'}) {
1897 my $t = $output{$report}{'title'};
1898 $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1900 print HTML "<A NAME=\"$report\">";
1902 $html =~ s/(:?)$/ [Top $TOP_HTML]$1/o if $TOP_HTML > 0;
1903 $html =~ s|^(.*)$|<STRONG>$1</STRONG>|;
1904 print HTML "$html</A>\n<P>\n<CENTER>\n<TABLE BORDER=\"1\">\n";
1906 $t =~ s/(:?)$/ [Top $TOP_TEXT]$1/o if $TOP_TEXT > 0;
1907 print "$t\n" if $TEXT;
1910 $numbering = 1 if defined $output{$report}{'numbering'} &&
1911 $output{$report}{'numbering'} =~ m/^true$/o;
1917 foreach $i (@{$output{$report}{'column'}}) {
1920 my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
1921 $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
1922 my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
1923 $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
1925 $v1 = defined ($$i{'format_name'}) ? $$i{'format_name'} :
1926 (defined ($$i{'format'}) ? $$i{'format'} : "%s");
1927 $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1929 $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1930 $s .= sprintf $v1 . " ", $v2 if $wtext && !($DOUBLE && $first == 1);
1931 if ($HTML && $whtml) {
1933 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?(\w)/\%$1/g;
1934 my $temp = $first ? "CENTER" : "LEFT";
1935 $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
1936 $html .= sprintf "<TH ALIGN=\"$temp\">$v1</TH>", $v2;
1941 print "$s\n" if $TEXT;
1944 print HTML "<TR>$html</TR>\n<TR><TD></TD></TR>\n";
1951 foreach $key1 (sort keys (%d)) {
1958 foreach $key2 (sort {$d{$key1}{$b} <=> $d{$key1}{$a}}
1959 keys (%{$d{$key1}})) {
1962 foreach $i (@{$output{$report}{'column'}}) {
1965 my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
1966 $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
1967 my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
1968 $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
1970 # is it the primary key ?
1972 $p = 1 if defined $$i{'primary'} && $$i{'primary'} =~ m/true/;
1975 $v1 = defined ($$i{'format'}) ? $$i{'format'} : "%s";
1976 $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1980 $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1983 $r = &EvalExpr ($v2, $key2, $num, $key1);
1984 die "Error in section $report column $$i{'name'}. " .
1985 "Invalid 'value' value.\n" unless defined $r;
1987 $res[$first] += $r if $v1 =~ m/\%-?(?:\d+(?:\.\d+)?)?d/o;
1989 $s .= sprintf $v1. "\n", $r unless $done || !$wtext;
1990 if ($HTML && $whtml) {
1992 $html .= "<TD></TD>";
1995 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
1996 $html .= $numbering ? "<TH ALIGN=\"CENTER\">$num_d</TH>" : '';
1998 $html .= sprintf "<TD ALIGN=\"LEFT\">$v1</TD></TR>\n", $r;
1999 $html .= "<TR><TD></TD>";
2005 $s .= " " if $first == 1;
2006 $s .= sprintf $v1 . " ", $r;
2008 if ($HTML && $whtml) {
2009 $html .= $numbering ? "<TD></TD>" : '' if $first == 1;
2010 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2011 my $temp = $first > 1 ? "RIGHT" : "LEFT";
2012 $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2020 print "$s\n" if $TEXT && ($num <= $TOP_TEXT || $TOP_TEXT == -1);
2021 if ($HTML && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
2023 print HTML "<TR>$html</TR>\n";
2031 if ($TOP_TEXT != -1 && $TOP_HTML != -1) {
2032 foreach $i (@{$output{$report}{'column'}}) {
2033 if (defined $$i{'primary'} && $$i{'primary'} =~ m/true/o) {
2036 $html .= "<TD></TD>" if $HTML;
2037 $html .= "<TD></TD>" if $HTML && $numbering;
2041 $v1 = defined ($$i{'format_total'}) ? $$i{'format_total'} :
2042 (defined ($$i{'format'}) ? $$i{'format'} : "%s");
2043 $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2044 my $r = $first == 1 ? $num : $res[$first];
2045 $s .= sprintf $v1 . " ", $r;
2047 my $temp = $first > 1 ? "RIGHT" : "LEFT";
2048 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2049 $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first > 1;
2050 $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2056 print "$s\n" if $TEXT;
2057 print HTML "<TR>$html</TR>\n" if $HTML;
2060 print "\n" if $TEXT;
2061 print HTML "<TR><TD></TD></TR>\n" if $HTML;
2066 foreach $i (@{$output{$report}{'column'}}) {
2067 my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
2068 $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
2069 my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
2070 $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
2073 $v1 = defined $$i{'format_total'} ? $$i{'format_total'} :
2074 (defined $$i{'format'} ? $$i{'format'} : "%s");
2075 $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2076 $v2 = $$i{'total'} ||
2077 die "Error in section $report column $$i{'name'}. " .
2078 "Need a 'total' field.\n";
2079 $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2082 $r = &EvalExpr ($v2, $key2, $num, 1);
2083 die "Error in section $report column $$i{'name'}. " .
2084 "Invalid 'total' value.\n" unless defined $r;
2086 $s .= sprintf $v1 . " ", $r if $wtext && $first != 1;
2087 if ($HTML && $whtml) {
2088 my $temp = $first ? "RIGHT" : "LEFT";
2089 $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
2090 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2091 $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first;
2092 $html .= $first == 1 ? "<TD></TD>" :
2093 sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2099 print "$s\n" if $TEXT;
2100 print HTML "<TR>$html</TR>\n</TABLE>\n</CENTER>\n<P>\n<HR>\n" if $HTML;
2103 # foreach $key (sort { local $^W = 0; no strict; eval $h } (keys (%d)))
2104 foreach $key ((eval "sort {local \$^W = 0; no strict; $h} (keys (%d))")) {
2105 next unless defined $key;
2106 next unless defined $d{$key}; # to avoid problems after some undef()
2108 next unless $num <= $TOP_HTML || $TOP_HTML == -1 ||
2109 $num <= $TOP_TEXT || $TOP_TEXT == -1;
2111 foreach $i (@{$output{$report}{'column'}}) {
2112 my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
2113 $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
2114 my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
2115 $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
2118 $v1 = defined ($$i{'format'}) ? $$i{'format'} : "%s";
2119 $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2121 $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2124 $r = &EvalExpr ($v2, $key, $num);
2125 die "Error in section $report column $$i{'name'}. " .
2126 "Invalid 'value' value.\n" unless defined $r;
2128 $s .= sprintf $v1 . " ", $r
2129 if $wtext && (($num <= $TOP_TEXT) || ($TOP_TEXT == -1));
2130 if ($HTML && $whtml && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
2131 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2132 $html .= "<TH ALIGN=\"CENTER\">$num</TH>" if $numbering && !$first;
2133 my $temp = $first ? "RIGHT" : "LEFT";
2134 $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2139 print "$s\n" if $TEXT && ($num <= $TOP_TEXT || $TOP_TEXT == -1);
2141 if ($HTML && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
2142 print HTML "<TR>$html</TR>\n";
2146 print "\n" if $TEXT;
2147 print HTML "<TR><TD></TD></TR>\n" if $HTML;
2149 foreach $i (@{$output{$report}{'column'}}) {
2150 my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
2151 $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
2152 my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
2153 $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
2156 $v1 = defined ($$i{'format_total'}) ? $$i{'format_total'} :
2157 (defined ($$i{'format'}) ? $$i{'format'} : "%s");
2158 $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2159 $v2 = $$i{'total'} ||
2160 die "Error in section $report column $$i{'name'}. " .
2161 "Need a 'total' field.\n";
2162 $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2165 $r = &EvalExpr ($v2, $key, $num);
2166 die "Error in section $report column $$i{'name'}. " .
2167 "Invalid 'total' value.\n" unless defined $r;
2169 $s .= sprintf $v1 . " ", $r if $wtext;
2170 if ($HTML && $whtml) {
2171 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2172 my $temp = $first ? "RIGHT" : "LEFT";
2173 $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
2174 $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first;
2175 $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2180 print "$s\n" if $TEXT;
2182 print HTML "<TR>$html</TR>\n";
2183 print HTML "</TABLE>\n</CENTER><P>\n";
2186 while ($GRAPH && defined ${${$output{$report}{'graph'}}[$i]}{'type'}) {
2187 my $type = ${${$output{$report}{'graph'}}[$i]}{'type'};
2188 my ($title) = ${${$output{$report}{'graph'}}[$i]}{'title'} =~
2189 m/^\"\s*(.*?)\s*\"$/o;
2190 if ($type eq 'histo3d') {
2191 my (@values, @colors, @labels);
2194 foreach $j (@{${${$output{$report}{'graph'}}[$i]}{'data'}}) {
2196 my ($h) = $$j{'value'} =~ m/^\"\s*(.*?)\s*\"$/o;
2198 $h =~ s/^\%/\%$CLASS\:\:/ unless $h eq '%prog_type';
2199 { local $^W = 0; no strict; %hh = eval $h }
2201 my ($t) = $$j{'name'} =~ m/^\"\s*(.*?)\s*\"$/o;
2203 $t = $$j{'color'} ||
2204 die "Error in section $report section 'graph'. " .
2205 "No color specified for 'value' $$j{'value'}.\n";
2206 $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
2207 $t =~ m/^[\da-fA-F]{6}$/o ||
2208 die "Error in section $report section 'graph'. " .
2209 "Bad color for 'value' $$j{'value'}.\n";
2210 my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
2213 $suffix = '' unless defined $suffix;
2214 my $s = ($i ? $i : '') . $suffix;
2215 print HTML "<CENTER><IMG ALT=\"$title\" ";
2217 my $y = &Graph3d ("$IMG_dir/$report$s.$GD_FORMAT",
2218 $title, $xmax, $num, @values, \@colors, \@labels);
2219 open (HTML, ">> $HTML_output") ||
2220 die "Error: cant open $HTML_output\n";
2221 print HTML "WIDTH=\"$xmax\" HEIGHT=\"$y\" ";
2222 print HTML "SRC=\"$IMG_pth$report$s.$GD_FORMAT\"></CENTER>\n";
2224 elsif ($type eq 'histo') {
2225 my (%values, %labels);
2227 ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'factor'}
2228 || die "Error in section $report section 'graph'. " .
2229 "No factor specified for 'value' " .
2230 ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
2232 $factor =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2234 ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'}
2235 || die "Error in section $report section 'graph'. " .
2236 "No name specified for value.\n";
2237 $labelx =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2239 ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'}
2240 || die "Error in section $report section 'graph'. " .
2241 "No name specified for value.\n";
2242 $labely =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2243 my $t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'value'}
2244 || die "Error in section $report section 'graph'. " .
2245 "No 'value' specified for " .
2246 ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'} .
2248 $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2249 $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
2250 { local $^W = 0; no strict; %labels = eval $t }
2252 $t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'value'} ||
2253 die "Error in section $report section 'graph'. " .
2254 "No 'value' specified for " .
2255 ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
2257 $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2258 $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
2259 { local $^W = 0; no strict; %values = eval $t }
2260 my $s = ($i ? $i : '') . $suffix;
2264 $r = &Histo ("$IMG_dir/$report$s.$GD_FORMAT", $title, $xmax,
2265 $factor, $labelx, $labely, \%values, \%labels);
2266 open (HTML, ">> $HTML_output") ||
2267 die "Error: cant open $HTML_output\n";
2268 print HTML "<CENTER><IMG ALT=\"$title\" WIDTH=\"$xmax\" " .
2269 "SRC=\"$IMG_pth$report$s.$GD_FORMAT\"></CENTER>\n" if $r;
2272 elsif ($type eq 'piechart') {
2273 print "Sorry, graph type 'piechart' not supported yet..\n";
2276 die "Error in section $report section 'graph'. " .
2277 "Invalid 'type' value.\n"
2282 print HTML "\n<HR>\n";
2285 close HTML if $HTML;
2290 my ($key, $num, $key1) = @_;
2294 $v =~ s/^\"(.*?)\"$/$1/o;
2297 $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotalDouble\(\\%/og;
2300 $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotal\(\\%/og;
2301 # $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%([^\)]*)\)/$1&ComputeTotal\("$2"\)/og;
2303 $v =~ s/([^a-zA-Z_\-]?)bytes\s*\(\s*/$1&NiceByte\(/og;
2304 $v =~ s/([^a-zA-Z_\-]?)time\s*\(\s*/$1&second2time\(/og;
2305 $v =~ s/([^a-zA-Z_\-]?)time_ms\s*\(\s*/$1&ms2time\(/og;
2306 # $v =~ s/([\$\%\@])/$1${CLASS}\:\:/og;
2307 $v =~ s/([\$\%\@])([^{\s\d])/$1${CLASS}\:\:$2/og;
2308 $v =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|sec_glob|num)/$1$2/og;
2310 # eval { local $^W = 0; no strict; ($r) = eval $v; };
2311 eval " local \$^W = 0; no strict; (\$r) = $v; ";
2312 $r = 0 unless defined $r;
2320 $size = 0 unless defined $size;
2321 $t = $size / 1024 / 1024 / 1024 > 1 ?
2322 sprintf "%.1f GB", $size / 1024 / 1024 / 1024 :
2323 ($size / 1024 / 1024 > 1 ? sprintf "%.1f MB", $size / 1024 / 1024 :
2324 sprintf "%.1f KB", $size / 1024);
2330 my ($i, $u) = $s =~ m/^(\S+) (\S+)$/;
2331 $i *= 1024 * 8 if $u =~ m/MB/o;
2332 $i *= 1024 * 1024 * 8 if $u =~ m/GB/o;
2336 sub Decode_Config_File {
2338 my ($line, $section);
2342 open (FILE, "$file") || die "Can\'t open config file \"$file\". Abort.\n";
2343 while (defined ($line = <FILE>)) {
2346 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2347 die "Error in $file line $linenum: must be 'section' instead of '$info'\n"
2348 unless ($info eq 'section');
2349 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2350 die "Error in $file line $linenum: invalid section name '$info'\n"
2351 unless $info =~ /^\w+$/;
2352 print "section $info {\n" if $DEBUG;
2354 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2355 die "Error in $file line $linenum: must be a '{' instead of '$info'\n"
2356 unless ($info eq '{');
2357 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2358 push @list, $section;
2359 while ($info ne '}') { # it is a block
2361 my $keyword = $info;
2362 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2364 if ($info eq '{') { # it is a sub-block
2366 $output{$section}{$keyword} = \@a unless $output{$section}{$keyword};
2368 print "\t$keyword {\n" if $DEBUG;
2369 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2370 my @sublist; # to store the "data" blocks
2372 while ($info ne '}') {
2374 my $subkeyword = $info;
2375 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2376 my $subvalue = $info;
2378 # it is a sub-sub-block
2380 print "\t\t$subkeyword {\n" if $DEBUG;
2382 $hash{$subkeyword} = \@b unless ${hash}{$subkeyword};
2383 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2384 while ($info ne '}') {
2386 my $subsubkeyword = $info;
2387 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2388 my $subsubvalue = $info;
2390 die "Error in $file line $linenum: too many blocks.\n";
2393 ($info, $linenum, $line) =
2394 &read_conf ($linenum, $line, \*FILE);
2395 die "Error in $file line $linenum: must be a ';' instead " .
2396 "of '$info'\n" unless ($info eq ';');
2397 print "\t\t\t$subsubkeyword\t$subsubvalue;\n" if $DEBUG;
2398 $subhash{$subsubkeyword} = $subsubvalue;
2399 ($info, $linenum, $line) =
2400 &read_conf ($linenum, $line, \*FILE);
2403 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2404 die "Error in $file line $linenum: must be a ';' instead of " .
2405 "'$info'\n" unless $info eq ';';
2406 push @{$hash{$subkeyword}} , \%subhash;
2407 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2408 print "\t\t};\n" if $DEBUG;
2411 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2412 die "Error in $file line $linenum: must be a ';' instead " .
2413 "of '$info'\n" unless $info eq ';';
2414 print "\t\t$subkeyword\t$subvalue;\n" if $DEBUG;
2415 $hash{$subkeyword} = $subvalue;
2416 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2419 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2420 die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
2421 unless $info eq ';';
2422 push @{$output{$section}{$keyword}}, \%hash;
2423 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2424 print "\t};\n" if $DEBUG;
2427 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2428 die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
2429 unless $info eq ';';
2430 print "\t$keyword\t$value;\n" if $DEBUG;
2431 $output{$section}{$keyword} = $value;
2432 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2435 die "Error in $file line $linenum: must be a '}' instead of '$info'\n"
2436 unless $info eq '}';
2437 ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2438 die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
2439 unless $info eq ';';
2440 print "};\n\n" if $DEBUG;
2443 $output{'_order_'} = \@list;
2447 my ($linenum, $line, $file) = @_;
2450 $line =~ s,^\s+,,o; # remove useless blanks
2451 $line =~ s,^(\#|//).*$,,o; # remove comments (at the beginning)
2452 while (($line =~ m/^$/o || $line =~ m/^\"[^\"]*$/o) && !(eof (FILE))) {
2453 $line .= <FILE>; # read one line
2455 $line =~ s,^\s*,,om; # remove useless blanks
2456 $line =~ s,^(\#|//).*$,,om; # remove comments (at the beginning)
2458 $line =~ s/^( # at the beginning
2459 [{};] # match '{', '}', or ';'
2461 \" # a double quoted string
2465 [^{};\"\s]+ # a word
2468 if (defined $info && $info) {
2472 warn "Syntax error in conf file line $linenum.\n";
2474 return ($info, $linenum, $line);
2479 my ($r) = $v =~ m/^(?:\"\s*)?(.*?)(?:\s*\")?$/so;
2484 my ($base) = $0 =~ /([^\/]+)$/;
2485 print "Usage: $base -f innreport.conf [-[no]options]\n";
2486 print " where options are:\n";
2487 print " -h (or -help) this help page\n";
2488 print " -v display the version number of INNreport\n";
2489 print " -config print INNreport configuration information\n";
2490 print " -html HTML output";
2491 print " [default]" if ($HTML);
2493 print " -g want graphs";
2494 print " [default]" if ($GRAPH);
2496 print " -graph an alias for option -g\n";
2497 print " -d directory directory for Web pages";
2498 print "\n [default=$HTML_dir]"
2499 if (defined ($HTML_dir));
2501 print " -dir directory an alias for option -d\n";
2502 print " -p directory pictures path (file space)";
2503 print "\n [default=$IMG_dir]"
2504 if (defined ($IMG_dir));
2506 print " -path directory an alias for option -p\n";
2507 print " -w directory pictures path (web space)";
2508 print " [default=$IMG_pth]" if (defined ($IMG_pth));
2510 print " -webpath directory an alias for option -w\n";
2512 print " -i file Name of index file";
2513 print " [default=$index]" if (defined ($index));
2515 print " -index file an alias for option -i\n";
2516 print " -a want to archive HTML results";
2517 print " [default]" if ($ARCHIVE);
2519 print " -archive an alias for option -a\n";
2520 print " -c number how many report files to keep (0 = all)\n";
2521 print " [default=$CYCLE]"
2522 if (defined ($CYCLE));
2524 print " -cycle number an alias for option -c\n";
2525 print " -s char separator for filename";
2526 print " [default=\"$SEPARATOR\"]\n";
2527 print " -separator char an alias for option -s\n";
2528 print " -unknown \"Unknown entries from news log file\"\n";
2530 print " [default]" if ($WANT_UNKNOWN);
2532 print " -html-unknown Same as above, but in generated HTML output.";
2533 print " [default]" if ($WANT_UNKNOWN);
2535 print " -maxunrec Max number of unrecognized lines to display\n";
2536 print " [default=$MAX_UNRECOGNIZED]"
2537 if (defined ($MAX_UNRECOGNIZED));
2539 print " -notdaily Never perform daily actions";
2540 print " [default]" if $NOT_DAILY;
2542 print " -casesensitive Case sensitive";
2543 print " [default]" if ($CASE_SENSITIVE);
2545 print "Use no in front of boolean options to unset them.\n";
2546 print "For example, \"-html\" is set by default. Use \"-nohtml\" to remove this\n";
2552 print "\nThis is INNreport version $version\n\n";
2553 print "Copyright 1996-1999, Fabien Tassin <fta\@sofaraway.org>\n";
2560 # Convert empty arguments into null string ("")
2562 foreach (@old_argv) {
2563 $old_argv[$i] = '""' if $_ eq '';
2567 # Display the summary
2568 print "\nSummary of my INNreport (version $version) configuration:\n";
2569 print " General options:\n";
2570 print " command line='@old_argv' (please, check this value)\n";
2571 print " html=" . ($HTML?"yes":"no") . ", graph=" .
2572 ($GRAPH?"yes":"no") . ", haveGD=" .
2573 ($::HAVE_GD?"yes":"no") . "\n";
2574 print " archive=" . ($ARCHIVE?"yes":"no") .
2575 ", cycle=$CYCLE, separator=\"" . $SEPARATOR . "\"\n";
2576 print " case_sensitive=" .
2577 ($CASE_SENSITIVE?"yes":"no") . ", want_unknown=" .
2578 ($WANT_UNKNOWN?"yes":"no") .
2579 ", max_unrecog=$MAX_UNRECOGNIZED\n";
2581 print " html_dir=$HTML_dir\n";
2582 print " img_dir=$IMG_dir\n";
2583 print " img_pth=$IMG_pth\n";
2584 print " index=$index\n";
2585 print " Platform:\n";
2586 print " perl version $::Config{baserev} "
2587 . "patchlevel $::Config{patchlevel} "
2588 . "subversion $::Config{subversion}\n";
2589 print " libperl=$::Config{libperl}, useshrplib=$::Config{useshrplib}, "
2590 . "bincompat3=$::Config{bincompat3}\n";
2591 print " osname=$::Config{osname}, osvers=$::Config{osvers}, "
2592 . "archname=$::Config{archname}\n";
2593 print " uname=$::Config{myuname}\n\n";
2598 ######################### End of File ##########################