--- /dev/null
+#! /usr/bin/perl
+# fixscript will replace this line with require innshellvars.pl
+
+##########################################################################
+#
+# innreport: Perl script to summarize news log files
+# (with optional HTML output and graphs).
+#
+# version: 3.0.2
+#
+# Copyright (c) 1996-1999, Fabien Tassin (fta@sofaraway.org).
+#
+##########################################################################
+#
+# Usage: innreport -f config_file [-[no]options] logfile [logfile2 [...]]
+# where options are:
+# -h (or -help) : this help page
+# -html : HTML output
+# -v : display the version number of INNreport
+# -f config_file : name of the configuration file
+# -config : print INNreport configuration information
+# -g : want graphs [default]
+# -graph : an alias for option -g
+# -d directory : directory for Web pages
+# -dir directory : an alias for option -d
+# -p directory : pictures path (file space)
+# -path directory : an alias for option -p
+# -w directory : pictures path (web space)
+# -webpath directory : an alias for option -w
+# -i : name of index page
+# -index : an alias for option -i
+# -a : want to archive HTML results
+# -archive : an alias for option -a
+# -c number : how many report files to keep (0 = all)
+# -cycle number : an alias for option -c
+# -s char : separator for filename
+# -separator char : an alias for option -s
+# -unknown : Unknown entries from news log file
+# -maxunrec : Max number of unrecognized line to display
+# -casesensitive : Case sensitive
+# -notdaily : Never perform daily actions
+#
+# Use no in front of boolean options to unset them.
+# For example, "-html" is set by default. Use "-nohtml" to remove this
+# feature.
+#
+##########################################################################
+#
+# ABSOLUTELY NO WARRANTY WITH THIS PACKAGE. USE IT AT YOUR OWN RISKS.
+#
+# Note: You need the Perl graphic library GD.pm if you want the graphs.
+# GD is available on all good CPAN ftp sites:
+# ex: [CPAN_DIR]/authors/id/LDS/GD-1.1_.tar.gz (or greater)
+# or directly to:
+# <URL:http://www-genome.wi.mit.edu/pub/software/WWW/GD.html>
+# Note : innreport will create PNG or GIF files depending upon
+# the GD version.
+#
+# Documentation: for a short explaination of the different options, you
+# can read the usage (obtained with the -h or -help switch).
+#
+# Install: - check the Perl location (first line). Require Perl 5.002
+# or greater.
+# - look at the parameters in the configuration file (section
+# 'default')
+# - copy the configuration file into ${PATHETC}/innreport.conf
+# - copy the INN module into ${PATHETC}/innreport_inn.pm
+# - copy this script into ${PATHETC}/innreport
+# - be sure that the news user can run it (chmod 755 or 750)
+# - in "scanlog", comment the line containing innlog and add:
+# ${PATHETC}/innreport -f ${PATHETC}/innreport.conf ${OLD_SYSLOG}
+# or, if you want to change some options:
+# ${PATHETC}/innreport -f ${PATHETC}/innreport.conf options ${OLD_SYSLOG}
+#
+# Report: please report bugs (preferably) to the INN mailing list
+# (see README) or directly to the author (do not forget to
+# include the result of the "-config" switch, the parameters
+# passed on the command line and the INN version).
+# Please also report unknown entries.
+# Be sure your are using the latest version of this script before
+# any report.
+#
+##########################################################################
+
+# Note: References to <ftp://ftp.sofaraway.org/pub/innreport/> have been
+# removed from the output because this site appears to no longer exist. It
+# used to be the upstream source for innreport. If there is a new site for
+# innreport releases, please notify the INN maintainers.
+
+# remember to add '-w' on the first line and to uncomment the 'use strict'
+# below before doing any changes to this file.
+
+use strict;
+
+## Do you want to create a Web page. Pick DO or DONT.
+my $HTML = "DO";
+
+## Do you want the graphs (need $HTML too). Pick DO or DONT.
+my $GRAPH = "DO";
+
+## Directory for the Web pages (used only if the previous line is active)
+my $HTML_dir = "$inn::pathhttp";
+
+## Directory for the pictures (need HTML support) in the file space
+my $IMG_dir = "$HTML_dir/pics";
+
+## Directory for the pictures (need HTML support) in the Web space
+## (can be relative or global)
+my $IMG_pth = "pics";
+
+## Do you want to archive HTML results (& pics) [ will add a date in each
+## name ]. Pick DO or DONT.
+my $ARCHIVE = "DO";
+
+## index page will be called:
+my $index = "index.html";
+
+## How many report files to keep (0 = all) (need $ARCHIVE).
+my $CYCLE = 0;
+
+## separator between hours-minutes-seconds in filenames
+## (normaly a ":" but some web-browsers (Lynx, MS-IE, Mosaic) can't read it)
+## Warning: never use "/". Use only a _valid_ filename char.
+my $SEPARATOR = ".";
+
+## Do you want the "Unknown entries from news log file" report. Pick DO or
+## DONT.
+my $WANT_UNKNOWN = "DO";
+
+## Max number of unrecognized lines to display (if $WANT_UNKNOWN)
+## (-1 = no limit)
+my $MAX_UNRECOGNIZED = 50;
+
+## Do you want to be case sensitive. Pick DO or DONT.
+my $CASE_SENSITIVE = "DO";
+
+## Some actions must only be performed daily (once for a log file).
+## (ex: unwanted.log with INN). Default value (DONT) means to perform
+## these actions each . Pick DO or DONT.
+my $NOT_DAILY = "DONT";
+
+###############################################
+## THERE'S NOTHING TO CHANGE AFTER THIS LINE ##
+###############################################
+
+my $version = "3.0.2";
+my %output; # content of the configuration file.
+my $DEBUG = 0; # set to 1 to verify the structure/content of the conf file.
+my $start_time = time;
+
+# Require Perl 5.002 or greater.
+require 5.002;
+use Getopt::Long;
+use vars qw/$HAVE_GD $GD_FORMAT/;
+
+my @old_argv = @ARGV;
+
+# Convert DO/DONT into boolean values.
+{
+ my $i;
+ foreach $i (\$HTML, \$GRAPH, \$ARCHIVE, \$WANT_UNKNOWN,
+ \$CASE_SENSITIVE, \$NOT_DAILY) {
+ $$i = $$i eq 'DO' ? 1 : 0 ;
+ }
+}
+
+my %ref;
+GetOptions (\%ref,
+ qw(-h -help
+ -html!
+ -config
+ -f=s
+ -g! -graph!
+ -d=s -dir=s
+ -p=s -path=s
+ -w=s -webpath=s
+ -i=s -index=s
+ -a! -archive!
+ -c=i -cycle=i
+ -s=s -separator=s
+ -unknown!
+ -html-unknown!
+ -maxunrec=i
+ -casesensitive!
+ -notdaily!
+ -v
+ ));
+
+&Version if $ref{'v'};
+
+&Decode_Config_File($ref{'f'}) if defined $ref{'f'};
+&Usage if $ref{'h'} || $ref{'help'} || !defined $ref{'f'};
+
+$HTML = 0 if defined $output{'default'}{'html'};
+$HTML = 1 if $output{'default'}{'html'} eq 'true';
+$HTML = 0 if defined $ref{'html'};
+$HTML = 1 if $ref{'html'};
+
+$GRAPH = 0 if defined $output{'default'}{'graph'};
+$GRAPH = 1 if $HTML && ($output{'default'}{'graph'} eq 'true');
+$GRAPH = 0 if defined $ref{'g'} || defined $ref{'graph'};
+$GRAPH = 1 if $HTML && ($ref{'g'} || $ref{'graph'});
+
+$HTML_dir = &GetValue ($output{'default'}{'html_dir'})
+ if defined $output{'default'}{'html_dir'};
+$HTML_dir = $ref{'d'} if defined $ref{'d'};
+$HTML_dir = $ref{'dir'} if defined $ref{'dir'};
+
+$IMG_pth = &GetValue ($output{'default'}{'img_dir'})
+ if defined $output{'default'}{'img_dir'};
+$IMG_pth = $ref{'w'} if defined $ref{'w'};
+$IMG_pth = $ref{'webpath'} if defined $ref{'webpath'};
+
+$IMG_dir = $HTML_dir . "/" . $IMG_pth
+ if (defined $output{'default'}{'html_dir'} ||
+ defined $ref{'w'} || defined $ref{'webpath'})
+ &&
+ (defined $output{'default'}{'html_dir'} ||
+ defined $ref{'d'} || defined $ref{'dir'});
+
+$IMG_dir = $ref{'p'} if defined $ref{'p'};
+$IMG_dir = $ref{'path'} if defined $ref{'path'};
+
+$index = &GetValue ($output{'default'}{'index'})
+ if defined $output{'default'}{'index'};
+$index = $ref{'i'} if defined $ref{'i'};
+$index = $ref{'index'} if defined $ref{'index'};
+
+$ARCHIVE = &GetValue ($output{'default'}{'archive'})
+ if defined $output{'default'}{'archive'};
+$ARCHIVE = $ARCHIVE eq 'true';
+$ARCHIVE = 0 if defined $ref{'a'} || defined $ref{'archive'};
+$ARCHIVE = 1 if ($ref{'a'} || $ref{'archive'}) && $HTML;
+$ARCHIVE = 0 unless $HTML;
+
+$CYCLE = &GetValue ($output{'default'}{'cycle'})
+ if defined $output{'default'}{'cycle'};
+$CYCLE = 0 if $CYCLE eq 'none';
+$CYCLE = $ref{'c'} if defined $ref{'c'};
+$CYCLE = $ref{'cycle'} if defined $ref{'cycle'};
+
+$SEPARATOR = &GetValue ($output{'default'}{'separator'})
+ if defined $output{'default'}{'separator'};
+$SEPARATOR = $ref{'s'} if defined $ref{'s'};
+$SEPARATOR = $ref{'separator'} if defined $ref{'separator'};
+
+if (defined $output{'default'}{'unknown'}) {
+ $WANT_UNKNOWN = &GetValue ($output{'default'}{'unknown'});
+ $WANT_UNKNOWN = $WANT_UNKNOWN eq 'true' ? 1 : 0;
+}
+$WANT_UNKNOWN = 0 if defined $ref{'unknown'};
+$WANT_UNKNOWN = 1 if $ref{'unknown'};
+
+my $WANT_HTML_UNKNOWN = $WANT_UNKNOWN;
+if (defined $output{'default'}{'html-unknown'}) {
+ $WANT_HTML_UNKNOWN = &GetValue ($output{'default'}{'html-unknown'});
+ $WANT_HTML_UNKNOWN = $WANT_HTML_UNKNOWN eq 'true' ? 1 : 0;
+}
+$WANT_HTML_UNKNOWN = 0 if defined $ref{'html-unknown'};
+$WANT_HTML_UNKNOWN = 1 if $ref{'html-unknown'};
+
+$NOT_DAILY = 0 if defined $ref{'notdaily'};
+$NOT_DAILY = 1 if $ref{'notdaily'};
+
+$MAX_UNRECOGNIZED = &GetValue ($output{'default'}{'max_unknown'})
+ if defined $output{'default'}{'max_unknown'};
+$MAX_UNRECOGNIZED = $ref{'maxunrec'} if defined ($ref{'maxunrec'});
+
+$CASE_SENSITIVE = &GetValue ($output{'default'}{'casesensitive'})
+ if defined $output{'default'}{'casesensitive'};
+$CASE_SENSITIVE = 1 if $CASE_SENSITIVE eq 'true';
+$CASE_SENSITIVE = 0 if defined $ref{'casesensitive'};
+$CASE_SENSITIVE = 1 if $ref{'casesensitive'};
+
+my $CLASS = &GetValue ($output{'default'}{'module'});
+my $LIBPATH = &GetValue ($output{'default'}{'libpath'});
+
+umask 022;
+
+BEGIN {
+ eval "use GD;";
+ $HAVE_GD = $@ eq '';
+ if ($HAVE_GD) {
+ my $gd = new GD::Image(1,1);
+ $GD_FORMAT = "gif" if $gd->can('gif');
+ $GD_FORMAT = "png" if $gd->can('png');
+ }
+ $HAVE_GD;
+};
+undef $GRAPH unless $HTML;
+if ($GRAPH && !$::HAVE_GD) {
+ print "WARNING: can't make graphs as required.\n" .
+ " Install GD.pm or disable this option.\n\n";
+ undef $GRAPH;
+}
+
+if ($HTML) {
+ if ($GRAPH) {
+ $IMG_dir = "." if defined $IMG_dir && $IMG_dir eq '';
+ $IMG_pth .= "/" if $IMG_pth;
+ $IMG_pth =~ s|/+|/|g;
+ $IMG_dir =~ s|/+|/|g;
+ unless (-w $IMG_dir) {
+ print "WARNING: can't write in \"$IMG_dir\" as required by -g " .
+ "switch.\n Option -g removed. Please see the -p switch.\n\n";
+ undef $GRAPH;
+ }
+ }
+ $HTML_dir = "." if defined $HTML_dir && $HTML_dir eq '';
+ unless (-w $HTML_dir) {
+ print "WARNING: can't write in \"$HTML_dir\" as required by -html " .
+ "switch.\n Option -html and -a removed. Please see the " .
+ "-d switch.\n\n";
+ undef $HTML;
+ $ARCHIVE = 0;
+ }
+}
+
+# Now, we are sure that HTML and graphs can be made if options are active.
+&Summary if defined $ref{'config'};
+
+my $unrecognize_max = 0;
+my @unrecognize;
+my ($total_line, $total_size) = (0, 0);
+my ($suffix, $HTML_output, %config, $first_date, $last_date,
+ %prog_type, %prog_size);
+
+my $HTML_header = '';
+my $HTML_footer = '';
+
+my $MIN = 1E10;
+my $MAX = -1;
+
+my $xmax = &GetValue ($output{'default'}{'graph_width'}) # Graph size..
+ if defined $output{'default'}{'graph_width'};
+$xmax = 550 unless $xmax;
+
+my $transparent = &GetValue ($output{'default'}{'transparent'})
+ if defined $output{'default'}{'transparent'};
+$transparent = (defined $transparent && $transparent eq 'true') ? 1 : 0;
+
+my $repeated = 1;
+
+my $first_date_cvt = $MIN;
+my $last_date_cvt = $MAX;
+
+
+#########################################################################
+my $s = sprintf "use lib qw($LIBPATH); use $CLASS;";
+eval $s; # initialization
+die "Can't find/load $CLASS.pm : $@\n" if $@;
+
+my $save_line = <>;
+$_ = $save_line;
+local $^W = 0 if $] < 5.004; # to avoid a warning for each '+=' first use.
+LINE: while (!eof ()) {
+ $total_line++;
+ my $size = length;
+ $total_size += $size;
+
+ # Syslog optimization
+ if ($repeated) {
+ $repeated--;
+ $_ = $save_line;
+ }
+ else {
+ $_ = <>;
+ if ($_ =~ /last message repeated (\d+) times?$/o) {
+ $repeated = $1;
+ $_ = $save_line;
+ }
+ else {
+ $save_line = $_;
+ }
+ }
+
+ # skip empty lines
+ next LINE if $_ eq '';
+
+ my $res;
+ my ($day, $hour, $prog, $left) =
+ $_ =~ m/^(\S+\s+\S+) (\S+) \S+ (\S+): \[ID \d+ \S+\] (.*)$/o;
+ ($day, $hour, $prog, $left) =
+ $_ =~ m/^(\S+\s+\S+) (\S+) \S+ (\S+): (.*)$/o unless $day;
+ ($day, $hour, $prog, $left) =
+ $_ =~ m/^(\S+\s+\S+) (\S+) \d+ \S+ (\S+): (.*)$/o unless $day;
+
+ unless ($day) {
+ ($day, $hour, $res, $left) = $_ =~ m/^(\S+\s+\S+) (\S+)\.\d+ (\S+) (.*)$/o;
+ if ($day) {
+ my $cvtdate = &ConvDate ("$day $hour");
+ if ($cvtdate < $first_date_cvt) {
+ $first_date_cvt = $cvtdate;
+ $first_date = "$day $hour";
+ }
+ elsif ($cvtdate > $last_date_cvt) {
+ $last_date_cvt = $cvtdate;
+ $last_date = "$day $hour";
+ }
+ $prog = "inn";
+ }
+ else {
+ next if $_ =~ /^$/;
+ # Unrecognize line... skip
+ $unrecognize[$unrecognize_max] = $_
+ unless $unrecognize_max > $MAX_UNRECOGNIZED
+ && $MAX_UNRECOGNIZED > 0;
+ $unrecognize_max++;
+ next LINE;
+ }
+ }
+ else {
+ my $cvtdate = &ConvDate ("$day $hour");
+ if ($cvtdate < $first_date_cvt) {
+ $first_date_cvt = $cvtdate;
+ $first_date = "$day $hour";
+ }
+ elsif ($cvtdate > $last_date_cvt) {
+ $last_date_cvt = $cvtdate;
+ $last_date = "$day $hour";
+ }
+ }
+
+ ########
+ ## Program name
+ # word[7164] -> word
+ my ($pid) = $prog =~ s/\[(\d+)\]$//o;
+ # word: -> word
+ $prog =~ s/:$//o;
+ # wordX -> word (where X is a digit)
+ $prog =~ s/\d+$//o;
+
+ $prog_type{$prog}++;
+ $prog_size{$prog} = 0 unless defined $prog_size{$prog}; # stupid warning :(
+ $prog_size{$prog} += $size;
+
+ # The "heart" of the tool.
+ {
+ no strict;
+ next LINE if
+ &{$CLASS."::collect"} ($day, $hour, $prog, $res, $left, $CASE_SENSITIVE);
+ }
+
+ $unrecognize[$unrecognize_max] = $_
+ unless $unrecognize_max > $MAX_UNRECOGNIZED
+ && $MAX_UNRECOGNIZED > 0;
+ $unrecognize_max++;
+}
+
+{
+ no strict;
+ &{$CLASS . "::adjust"} ($first_date, $last_date);
+}
+
+$| = 1;
+
+die "no data. Abort.\n" unless $total_line;
+
+my $sec_glob = &ConvDate ("$last_date") - &ConvDate ("$first_date");
+unless ($sec_glob) {
+ print "WARNING: bad date (\"$last_date\" or \"$first_date\")\n" .
+ " Please, contact the author of innreport.\n";
+ $sec_glob = 24 * 60 * 60; # one day
+}
+
+$HTML_output = '';
+
+if ($HTML) {
+ # Create a new filename (unique and _sortable_)
+ if ($ARCHIVE) {
+ # The filename will contain the first date of the log or the current time.
+ my ($ts, $tm, $th, $dd, $dm, $dy) = localtime;
+ my ($m, $d, $h, $mn, $s) =
+ $first_date =~ /^(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)$/;
+ if ($m) {
+ my $ddm = (index "JanFebMarAprMayJunJulAugSepOctNovDec", $m) / 3;
+ # Adjust the year because syslog doesn't record it. We assume that
+ # it's the current year unless the last date is in the future.
+ my $ld = &ConvDate($last_date);
+ $dy-- if $ld > $ts + 60 * ($tm + 60 * ($th + 24 * ($dd - 1 +
+ substr("000031059090120151181212243273304334", $dm * 3, 3)))) ||
+ $ld < &ConvDate($first_date);
+ ($dm, $dd, $th, $tm, $ts) = ($ddm, $d, $h, $mn, $s);
+ }
+ $dm++; # because January = 0 and we prefer 1
+ $dy += 100 if $dy < 90; # Try to pacify the year 2000 !
+ $dy += 1900;
+ $suffix = sprintf ".%02d.%02d.%02d-%02d$SEPARATOR%02d$SEPARATOR%02d",
+ $dy, $dm, $dd, $th, $tm, $ts;
+ }
+ else {
+ $suffix = '';
+ }
+ $HTML_output = "$HTML_dir" . "/news-notice" . "$suffix" . ".html";
+ $HTML_output =~ s|/+|/|g;
+ if (defined $output{'default'}{'html_header_file'}) {
+ my $file = &GetValue ($output{'default'}{'html_header_file'});
+ $file = $HTML_dir . "/" . $file;
+ open (F, $file) && do {
+ local $/ = undef;
+ $HTML_header = <F>;
+ close F;
+ };
+ }
+ if (defined $output{'default'}{'html_footer_file'}) {
+ my $file = &GetValue ($output{'default'}{'html_footer_file'});
+ $file = $HTML_dir . "/" . $file;
+ open (F, $file) && do {
+ local $/ = undef;
+ $HTML_footer = <F>;
+ close F;
+ };
+ }
+}
+
+&Write_all_results ($HTML_output, \%output);
+
+&Make_Index ($HTML_dir, $index, "news-notice$suffix.html", \%output)
+ if $HTML && $index;
+
+#====================================================================
+
+if ($ARCHIVE) {
+ # rotate html files
+ &Rotate ($CYCLE, $HTML_dir, "news-notice", ".html");
+
+ # rotate pictures
+ my $report;
+ foreach $report (@{$output{'_order_'}}) {
+ next if $report =~ m/^(default|index)$/;
+ next unless defined $output{$report}{'graph'};
+
+ my $i = 0;
+ while ($GRAPH && defined ${${$output{$report}{'graph'}}[$i]}{'type'}) {
+ my $name = $report . ($i ? $i : '');
+ &Rotate ($CYCLE, $IMG_dir, $name, '.' . $GD_FORMAT);
+ $i++;
+ }
+ }
+}
+
+# Code needed by INN only. It must be in innreport_inn.pm to keep things clean.
+if (!$NOT_DAILY && defined $output{'default'}{'unwanted_log'}) {
+ my $logfile = &GetValue ($output{'default'}{'unwanted_log'});
+ my $logpath = &GetValue ($output{'default'}{'logpath'});
+ {
+ no strict;
+ &{$CLASS . "::report_unwanted_ng"} ("$logpath/$logfile");
+ }
+}
+
+################
+# End of report.
+###################################################################
+
+######
+# Misc...
+
+# Compare 2 dates (+hour)
+sub DateCompare {
+ # ex: "May 12 06" for May 12, 6:00am
+ local $[ = 0;
+ # The 2 dates are near. The range is less than a few days that's why we
+ # can cheat to determine the order. It is only important if one date
+ # is in January and the other in December.
+
+ my $date1 = substr ($a, 4, 2) * 24;
+ my $date2 = substr ($b, 4, 2) * 24;
+ $date1 += index("JanFebMarAprMayJunJulAugSepOctNovDec",substr($a,0,3)) * 288;
+ $date2 += index("JanFebMarAprMayJunJulAugSepOctNovDec",substr($b,0,3)) * 288;
+ if ($date1 - $date2 > 300 * 24) {
+ $date2 += 288 * 3 * 12;
+ }
+ elsif ($date2 - $date1 > 300 * 24) {
+ $date1 += 288 * 3 * 12;
+ }
+ $date1 += substr($a, 7, 2);
+ $date2 += substr($b, 7, 2);
+ $date1 - $date2;
+}
+
+
+# Convert: seconds to hh:mm:ss
+sub second2time {
+ my $temp;
+ my $t = shift;
+ # Hours
+ $temp = sprintf "%02d", $t / 3600;
+ my $chaine = "$temp:";
+ $t %= 3600;
+ # Min
+ $temp = sprintf "%02d", $t / 60;
+ $chaine .= "$temp:";
+ $t %= 60;
+ # Sec
+ $chaine .= sprintf "%02d", $t;
+ return $chaine;
+}
+
+# Convert: milliseconds to hh:mm:ss:mm
+sub ms2time {
+ my $temp;
+ my $t = shift;
+ # Hours
+ $temp = sprintf "%02d", $t / 3600000;
+ my $chaine = "$temp:";
+ $t %= 3600000;
+ # Min
+ $temp = sprintf "%02d", $t / 60000;
+ $chaine .= "$temp:";
+ $t %= 60000;
+ # Sec
+ $temp = sprintf "%02d", $t / 1000;
+ $chaine .= "$temp.";
+ $t %= 1000;
+ # Millisec
+ $chaine .= sprintf "%03d", $t;
+ return $chaine;
+}
+
+# Rotate the archive files..
+sub Rotate {
+ # Usage: &Rotate ($max_files, "$directory", "prefix", "suffix");
+ my ($max, $rep, $prefix, $suffix) = @_;
+ my ($file, $num, %files);
+ local ($a, $b);
+
+ return 1 unless $max;
+ opendir (DIR, "$rep") || die "Error: Cant open directory \"$rep\"\n";
+
+ FILE : while (defined ($file = readdir (DIR))) {
+ next FILE
+ unless $file =~ /^ # e.g. news-notice.1997.05.14-01:34:29.html
+ $prefix # Prefix : news-notice
+ \. # dot : .
+ (\d\d)?\d\d # Year : 1997 (or 97)
+ \. # dot : .
+ \d\d # Month : 05
+ \. # dot : .
+ \d\d # Day : 14
+ - # Separator : -
+ \d\d # Hour : 01
+ $SEPARATOR # Separator : ":"
+ \d\d # Minute : 34
+ $SEPARATOR # Separator : ":"
+ \d\d # Second : 29
+ $suffix # Suffix : ".html"
+ $/x;
+ $files{$file}++;
+ }
+ closedir DIR;
+ $num = 0;
+ foreach $file (sort {$b cmp $a} (keys (%files))) {
+ unlink "$rep/$file" if $num++ >= $max && -f "$rep/$file";
+ }
+ return 1;
+}
+
+# convert a date to a number of seconds
+sub ConvDate {
+ # usage: $num = &ConvDate ($date);
+ # date format is Aug 22 01:49:40
+ my $T = shift;
+ my ($m, $d, $h, $mn, $s) = $T =~ /^(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)$/;
+ my $out = $s + 60 * $mn + 3600 * $h + 86400 * ($d - 1);
+
+ $m = substr("000031059090120151181212243273304334",
+ index ("JanFebMarAprMayJunJulAugSepOctNovDec", $m), 3);
+ $out += $m * 86400;
+ return $out;
+}
+
+# Compare 2 filenames
+sub filenamecmp {
+ local $[ = 0;
+ my ($la, $lb) = ($a, $b);
+ my ($ya) = $la =~ m/news-notice\.(\d+)\./o;
+ $ya += 100 if $ya < 90; # Try to pacify the year 2000 !
+ $ya += 1900 if $ya < 1900; # xx -> xxxx
+ my ($yb) = $lb =~ m/news-notice\.(\d+)\./o;
+ $yb += 100 if $yb < 90; # Try to pacify the year 2000 !
+ $yb += 1900 if $yb < 1900; # xx -> xxxx
+
+ $la =~ s/news-notice\.(\d+)\./$ya\./;
+ $lb =~ s/news-notice\.(\d+)\./$yb\./;
+ $la =~ s/[\.\-\:html]//g;
+ $lb =~ s/[\.\-\:html]//g;
+
+ $lb <=> $la;
+}
+
+sub ComputeTotal {
+ my $h = shift;
+ my $total = 0;
+ my $key;
+ foreach $key (keys (%$h)) {
+ $total += $$h{$key};
+ }
+ $total;
+}
+
+sub ComputeTotalDouble {
+ my $h = shift;
+ my $total = 0;
+ my ($key1, $key2);
+ foreach $key1 (keys (%$h)) {
+ foreach $key2 (keys (%{$$h{$key1}})) {
+ $total += ${$$h{$key1}}{$key2};
+ }
+ }
+ $total;
+}
+
+# make an index for archive pages
+sub Make_Index {
+ my ($rep, $index, $filename, $data) = @_;
+ my %output = %$data;
+
+ $index =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+
+ # add requested data at the end of the database.
+ open (DATA, ">> $rep/innreport.db") || die "can't open $rep/innreport.db\n";
+ my $i = 0;
+ my $res = "$filename";
+ while (defined ${${$output{'index'}{'column'}}[$i]}{'value'}) {
+ my $data = &GetValue (${${$output{'index'}{'column'}}[$i]}{'value'});
+ $data =~ s/\n//sog;
+ my @list = split /\|/, $data;
+ my $val;
+ foreach $val (@list) {
+ $res .= ($val eq 'date' ? "|$first_date -- $last_date"
+ : "|" . &EvalExpr($val));
+ }
+ $i++;
+ }
+ print DATA "$res\n";
+ close DATA;
+
+ # sort the database (reverse order), remove duplicates.
+ open (DATA, "$rep/innreport.db") || die "can't open $rep/innreport.db\n";
+ my %data;
+ while (<DATA>) {
+ m/^([^\|]+)\|(.*)$/o;
+ $data{$1} = $2;
+ }
+ close DATA;
+ open (DATA, "> $rep/innreport.db") || die "can't open $rep/innreport.db\n";
+ $i = 0;
+ foreach (sort {$b cmp $a} (keys %data)) {
+ print DATA "$_|$data{$_}\n" if $CYCLE == 0 || $i < $CYCLE;
+ $i++;
+ }
+ close DATA;
+
+ my $title = "Daily Usenet report";
+ $title = &GetValue ($output{'default'}{'title'})
+ if defined $output{'default'}{'title'};
+ $title =~ s/\\\"/\"/g;
+ my $Title = $title;
+ $Title =~ s/<.*?>//g;
+ my $body = '';
+ $body = &GetValue ($output{'default'}{'html_body'})
+ if defined $output{'default'}{'html_body'};
+ $body =~ s/\\\"/\"/go;
+ my $result = sprintf <<EOF;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<HTML><HEAD>
+<TITLE>$Title: index</TITLE>
+</HEAD><BODY $body>
+$HTML_header
+<HR ALIGN=CENTER SIZE=\"4\" WIDTH=\"100%%\">
+<BR><CENTER><FONT SIZE=\"+2\">
+<B>$title - archives</B>
+</FONT></CENTER>
+<BR CLEAR=ALL>
+<HR ALIGN=CENTER SIZE=4 WIDTH=\"100%%\"><P>
+<CENTER>
+EOF
+
+ if ($GRAPH) {
+ my $i = 0;
+ while (defined ${${$output{'index'}{'graph'}}[$i]}{'title'}) {
+ my $title = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'title'});
+ my $filename = "index$i.$GD_FORMAT";
+ my $color_bg = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'color'});
+ my $unit = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'unit'});
+ my $date_idx = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'value'});
+ $date_idx =~ s/^val(\d+)$/$1/o;
+ my @c = @{${${$output{'index'}{'graph'}}[$i]}{'data'}};
+ my $label_in = &GetValue (${$c[0]}{'name'});
+ my $color_in = &GetValue (${$c[0]}{'color'});
+ my $value_in = &GetValue (${$c[0]}{'value'});
+ my $type_in = 0;
+ $type_in = $value_in =~ s/^byte\((.*?)\)$/$1/o;
+ $value_in =~ s/^val(\d+)$/$1/o;
+ my $label_out = &GetValue (${$c[1]}{'name'});
+ my $color_out = &GetValue (${$c[1]}{'color'});
+ my $value_out = &GetValue (${$c[1]}{'value'});
+ my $type_out = 0;
+ $type_out = $value_out =~ s/^byte\((.*?)\)$/$1/o;
+ $value_out =~ s/^val(\d+)$/$1/o;
+ my (%in, %out, %dates, $k);
+ foreach $k (keys (%data)) {
+ my @res = split /\|/, $data{$k};
+ my ($year) = $k =~ m/^news-notice\.(\d+)\.\d+\.\d+-\d+.\d+.\d+\.html/;
+ next unless $year; # bad filename.. strange.
+ my ($start, $end) =
+ $res[$date_idx - 1] =~ m/^(\w+\s+\d+ \S+) -- (\w+\s+\d+ \S+)$/o;
+ next unless $start; # bad date
+ $start = &ConvDate ($start);
+ $end = &ConvDate ($end);
+ # 31/12 - 1/1 ?
+ my $inc = $end < $start ? 1 : 0;
+ $start += (($year - 1970) * 365 +
+ int (($year - 1968) / 4)) * 3600 * 24;
+ $year += $inc;
+ $end += (($year - 1970) * 365 + int (($year - 1968) / 4)) * 3600 * 24;
+ $in{$start} = $type_in ? &kb2i($res[$value_in - 1])
+ : $res[$value_in - 1];
+ $out{$start} = $type_out ? &kb2i($res[$value_out - 1])
+ : $res[$value_out - 1];
+ $dates{$start} = $end;
+ }
+ my ($xmax, $ymax) = (500, 170);
+ &Chrono ("$IMG_dir/$filename", $title, $color_bg, $xmax, $ymax,
+ \%in, \%out, \%dates, $label_in, $label_out,
+ $color_in, $color_out, $unit);
+ $result .= "<IMG WIDTH=\"$xmax\" HEIGHT=\"$ymax\" ";
+ $result .= "SRC=\"$IMG_pth$filename\" ALT=\"Graph\">\n";
+ $i++;
+ }
+ $result .= "<P>\n";
+ }
+ $i = 0;
+ $result .= "<TABLE BORDER=\"1\"><TR>";
+ my $temp = '';
+ while (defined ${${$output{'index'}{'column'}}[$i]}{'title'}) {
+ my $title = &GetValue (${${$output{'index'}{'column'}}[$i]}{'title'});
+ my $name = '';
+ $name = &GetValue (${${$output{'index'}{'column'}}[$i]}{'name'})
+ if defined ${${$output{'index'}{'column'}}[$i]}{'name'};
+ my @list = split /\|/, $name;
+ if ($name) {
+ $result .= sprintf "<TH COLSPAN=%d>$title</TH>", $#list + 1;
+ }
+ else {
+ $result .= "<TH ROWSPAN=\"2\">$title</TH>";
+ }
+ foreach (@list) {
+ $temp .= "<TH>$_</TH>";
+ }
+ $i++;
+ }
+ $result .= "</TR>\n<TR>$temp</TR>\n";
+
+ $i = 0;
+ foreach (sort {$b cmp $a} (keys %data)) {
+ if ($CYCLE == 0 || $i < $CYCLE) {
+ my @list = split /\|/, $data{$_};
+ my $str = "<TR><TD ALIGN=LEFT>";
+ $str .= "<A HREF=\"$_\">" if -e "$rep/$_";
+ $str .= shift @list;
+ $str .= "</A>" if -e "$rep/$_";;
+ $str .= "</TD>";
+ while (@list) {
+ $str .= "<TD ALIGN=RIGHT>";
+ my $t = shift @list;
+ $t =~ s/^\0+//o; # remove garbage, if any.
+ $str .= "$t</TD>";
+ }
+ $str .= "</TR>\n";
+ $result .= "$str";
+ }
+ $i++;
+ }
+ $result .= "</TABLE>\n</CENTER>\n<P><HR>";
+ $result .= "innreport $version (c) 1996-1999 ";
+ $result .= "by Fabien Tassin <<A HREF=\"mailto:fta\@sofaraway.org\">";
+ $result .= "fta\@sofaraway.org</A>>.\n";
+ if (defined ($output{'default'}{'footer'})) {
+ my ($t) = $output{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o;
+ $t =~ s/\\\"/\"/go;
+ $result .= "<BR>" . $t;
+ }
+ $result .= "$HTML_footer\n</BODY>\n</HTML>\n";
+ my $name = $rep . "/" . $index;
+ while ($name =~ m/\/\.\.\//o) {
+ $name =~ s|^\./||o; # ^./xxx => ^xxx
+ $name =~ s|/\./|/|go; # xxx/./yyy => xxx/yyy
+ $name =~ s|/+|/|go; # xxx//yyy => xxx/yyy
+ $name =~ s|^/\.\./|/|o; # ^/../xxx => ^/xxx
+ $name =~ s|^[^/]+/\.\./||o; # ^xxx/../ => ^nothing
+ $name =~ s|/[^/]+/\.\./|/|go; # /yyy/../ => /
+ }
+
+ open (INDEX, "> $name") || die "Error: Unable to create $name\n";
+ print INDEX $result;
+ close INDEX;
+ 1;
+}
+
+sub Graph3d {
+ my $filename = shift; # filename
+ my $title = shift; # title
+ my $xmax = shift; # width
+ my $n = shift; # Number of hash code tables
+
+ no strict;
+ my ($i, $k, $t);
+ my @val;
+ for $i (0 .. $n - 1) {
+ push @val, shift; # hash code table
+ }
+ my $colors = shift; # colors table
+ my $labels = shift; # labels
+
+ my $max = 0;
+ my $max_size = 0;
+ my $size = 0;
+ foreach $k (sort keys (%{$val[0]})) {
+ $t = 0;
+ $size++;
+ for $i (0 .. $n - 1) {
+ $t += ${$val[$i]}{$k} if defined ${$val[$i]}{$k};
+ }
+ $max = $t if $max < $t;
+ $t = length "$k";
+ $max_size = $t if $max_size < $t;
+ }
+ $max = 1 unless $max;
+ $max_size *= gdSmallFont->width;
+
+ # relief
+ my ($rx, $ry) = (15, 5);
+
+ # margins
+ my ($mt, $mb) = (40, 40);
+ my $ml = $max_size > 30 ? $max_size + 8 : 30;
+
+ my $mr = 7 + (length "$max") * gdSmallFont->width;
+ $mr = 30 if $mr < 30;
+
+ # height of each bar
+ my $h = 12;
+
+ # difference between 2 bars
+ my $d = 25;
+
+ my $ymax = $size * $d + $mt + $mb;
+ my $image = new GD::Image ($xmax, $ymax);
+
+ my ($white, $black);
+ if (defined $output{'default'}{'graph_fg'}) {
+ my $t = $output{'default'}{'graph_fg'};
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section 'default' section 'graph_fg'. Bad color.\n";
+ my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
+ $black = $image->colorAllocate (@c);
+ }
+ else {
+ $black = $image->colorAllocate ( 0, 0, 0);
+ }
+ if (defined $output{'default'}{'graph_bg'}) {
+ my $t = $output{'default'}{'graph_bg'};
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section 'default' section 'graph_bg'. Bad color.\n";
+ my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
+ $white = $image->colorAllocate (@c);
+ }
+ else {
+ $white = $image->colorAllocate (255, 255, 255);
+ }
+ $image->filledRectangle (0, 0, $xmax, $ymax, $white);
+ my @col;
+ for $i (0 .. $n - 1) {
+ $col[$i][0] = $image->colorAllocate
+ ($$colors[$i][0], $$colors[$i][1], $$colors[$i][2]);
+ $col[$i][1] = $image->colorAllocate
+ ($$colors[$i][0] * 3 / 4, $$colors[$i][1] * 3 / 4,
+ $$colors[$i][2] * 3 / 4);
+ $col[$i][2] = $image->colorAllocate
+ ($$colors[$i][0] * 2 / 3, $$colors[$i][1] * 2 / 3,
+ $$colors[$i][2] * 2 / 3);
+ }
+
+ $image->transparent ($white) if $transparent;
+
+ $image->rectangle (0, 0, $xmax - 1, $size * $d + $mt + $mb - 1, $black);
+ $image->line (0, $mt - 5, $xmax - 1, $mt - 5, $black);
+ for $i (0 .. $n - 1) {
+ $image->string (gdSmallFont, $i * $xmax / $n + $mt - 10 + $rx,
+ ($mt - gdSmallFont->height) / 2, "$$labels[$i]", $black);
+ $image->filledRectangle ($i * $xmax / $n + 10, 8 + $ry / 2,
+ $i * $xmax / $n + $mt - 10, $mt - 12, $col[$i][0]);
+ $image->rectangle ($i * $xmax / $n + 10, 8 + $ry / 2,
+ $i * $xmax / $n + $mt - 10, $mt - 12, $black);
+ {
+ my $poly = new GD::Polygon;
+ $poly->addPt($i * $xmax / $n + 10, 8 + $ry / 2);
+ $poly->addPt($i * $xmax / $n + 10 + $rx / 2, 8);
+ $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, 8);
+ $poly->addPt($i * $xmax / $n + $mt - 10, 8 + $ry / 2);
+
+ $image->filledPolygon($poly, $col[$i][1]);
+ $image->polygon($poly, $black);
+ }
+ {
+ my $poly = new GD::Polygon;
+ $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, 8);
+ $poly->addPt($i * $xmax / $n + $mt - 10, 8 + $ry / 2);
+ $poly->addPt($i * $xmax / $n + $mt - 10, $mt - 12);
+ $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, $mt - 12 - $ry / 2);
+
+ $image->filledPolygon($poly, $col[$i][2]);
+ $image->polygon($poly, $black);
+ }
+ }
+ # Title
+ $image->string (gdMediumBoldFont, ($xmax - gdMediumBoldFont->width *
+ (length "$title")) / 2, $ymax - gdMediumBoldFont->height - 7,
+ "$title", $black);
+
+ my $e = $mt - $h + $d;
+ my $r = ($xmax - $ml - $mr - $rx) / $max;
+
+ # Axe Oz
+ $image->line ($ml + $rx, $mt, $ml + $rx, $size * $d + $mt - $ry, $black);
+ $image->line ($ml + $rx + $max * $r, $mt, $ml + $rx + $max * $r,
+ $size * $d + $mt - $ry, $black);
+ $image->line ($ml, $mt + $ry, $ml, $size * $d + $mt, $black);
+ # Axe Ox
+ $image->line ($ml + $rx, $size * $d + $mt - $ry,
+ $ml + $rx - 2 * $rx, $size * $d + $mt + $ry, $black);
+ # Axe Oy
+ $image->line ($ml + $rx, $size * $d + $mt - $ry,
+ $xmax - $mr / 2, $size * $d + $mt - $ry, $black);
+ $image->line ($ml, $size * $d + $mt,
+ $xmax - $mr - $rx, $size * $d + $mt, $black);
+
+ # Graduations..
+ my $nn = 10;
+ for $k (1 .. ($nn - 1)) {
+ $image->dashedLine ($ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
+ $mt + 10, $ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
+ $size * $d + $mt - $ry, $black);
+ $image->dashedLine ($ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
+ $size * $d + $mt - $ry,
+ $ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
+ $size * $d + $mt, $black);
+ $image->line ($ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
+ $size * $d + $mt,
+ $ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
+ $size * $d + $mt + 5, $black);
+ my $t = sprintf "%d%%", $k * 10;
+ $image->string (gdSmallFont, $ml + $k * ($xmax - $ml - $mr - $rx) / $nn -
+ (length "$t") * gdSmallFont->width / 2,
+ $size * $d + $mt + 6, "$t", $black);
+ }
+ {
+ my $t = sprintf "%d%%", 0;
+ $image->line ($ml, $size * $d + $mt, $ml, $size * $d + $mt + 5, $black);
+ $image->string (gdSmallFont, $ml - (length "$t") * gdSmallFont->width / 2,
+ $size * $d + $mt + 6, "$t", $black);
+ $image->line ($xmax - $mr, $size * $d + $mt - $ry,
+ $xmax - $mr - $rx, $size * $d + $mt, $black);
+ $image->line ($xmax - $mr - $rx, $size * $d + $mt,
+ $xmax - $mr - $rx, $size * $d + $mt + 5, $black);
+ $t = sprintf "%d%%", 100;
+ $image->string (gdSmallFont, $xmax - $mr - $rx
+ - (length "$t") * gdSmallFont->width / 2,
+ $size * $d + $mt + 6, "$t", $black);
+ }
+ foreach $k (sort {${$val[0]}{$b} <=> ${$val[0]}{$a}} keys (%{$val[0]})) {
+ $image->string (gdSmallFont, $ml - (length "$k") * gdSmallFont->width - 3,
+ $e + $h / 2 - gdSmallFont->height / 2, "$k", $black);
+ my $t = 0;
+ $image->line ($ml + ($t + ${$val[0]}{$k}) * $r + $rx - $rx, $e + $h,
+ $ml + ($t + ${$val[0]}{$k}) * $r + $rx, $e - $ry + $h,
+ $black);
+ for $i (0 .. $n - 1) {
+ next unless defined ${$val[$i]}{$k};
+ {
+ my $poly = new GD::Polygon;
+ $poly->addPt($ml + $t * $r, $e);
+ $poly->addPt($ml + $t * $r + $rx, $e - $ry);
+ $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry);
+ $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r, $e);
+
+ $image->filledPolygon($poly, $col[$i][1]);
+ $image->polygon($poly, $black);
+ }
+ unless (${$val[$i + 1]}{$k} || ${$val[$i]}{$k} == 0) {
+ my $poly = new GD::Polygon;
+ $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry);
+ $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx - $rx, $e);
+ $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx - $rx, $e + $h);
+ $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry + $h);
+
+ $image->filledPolygon($poly, $col[$i][2]);
+ $image->polygon($poly, $black);
+ }
+ $image->filledRectangle ($ml + $t * $r, $e,
+ $ml + ($t + ${$val[$i]}{$k}) * $r, $e + $h,
+ $col[$i][0]);
+ $image->rectangle ($ml + $t * $r, $e, $ml + ($t + ${$val[$i]}{$k}) * $r,
+ $e + $h, $black);
+ $t += ${$val[$i]}{$k};
+ }
+ # total length (offered)
+ $image->filledRectangle ($ml + $t * $r + $rx + 3,
+ $e - 2 - gdSmallFont->height / 2,
+ $ml + $t * $r + $rx + 4 +
+ gdSmallFont->width * length $t,
+ $e - 6 + gdSmallFont->height / 2, $white);
+ $image->string (gdSmallFont, $ml + $t * $r + $rx + 5,
+ $e - 3 - gdSmallFont->height / 2, "$t", $black);
+ # first value (accepted)
+ $image->filledRectangle ($ml + $t * $r + $rx + 3,
+ $e - 4 + gdSmallFont->height / 2,
+ $ml + $t * $r + $rx + 4 +
+ gdSmallFont->width * length "${$val[0]}{$k}",
+ $e - 2 + gdSmallFont->height, $white);
+ $image->string (gdSmallFont, $ml + $t * $r + $rx + 5,
+ $e - 5 + gdSmallFont->height / 2, ${$val[0]}{$k}, $black);
+ $e += $d;
+ }
+ open (IMG, "> $filename") || die "Error: Can't open \"$filename\": $!\n";
+ if ($GD_FORMAT eq 'png') {
+ print IMG $image->png;
+ }
+ else {
+ print IMG $image->gif;
+ }
+ close IMG;
+ $ymax;
+}
+
+sub Histo {
+ my ($filename, $title, $xmax, $factor,
+ $labelx, $labely, $val1, $labels1) = @_;
+
+ no strict;
+ my $max = 0;
+ my $ymax = 300;
+ my $nb = 0;
+ # A hugly hack to convert hashes to lists..
+ # and to adjust the first and the last value...
+ # this function should be rewritten..
+ my (@a, @b, $kk);
+ foreach $kk (sort keys (%$val1)) {
+ if (defined $$val1{$kk}) {
+ $nb++;
+ # Arg... the following MUST be removed !!!!!!!!!
+ $$val1{$kk} = $$val1{$kk} / $innreport_inn::inn_flow_time{$kk} * 3600
+ if ($innreport_inn::inn_flow_time{$kk} != 3600) &&
+ ($innreport_inn::inn_flow_time{$kk} != 0);
+ push @a, $$val1{$kk};
+ $max = $$val1{$kk} if $$val1{$kk} > $max;
+ push @b, $$labels1{$kk};
+ }
+ }
+ return 0 unless $nb; # strange, no data.
+ my $val = \@a;
+ my $labels = \@b;
+ my ($i, $j);
+ my ($marginl, $marginr, $margint, $marginb, $shx, $shy);
+
+ my $image = new GD::Image($xmax, $ymax);
+ my ($white, $black);
+ if (defined $output{'default'}{'graph_fg'}) {
+ my $t = $output{'default'}{'graph_fg'};
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section 'default' section 'graph_fg'. Bad color.\n";
+ my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
+ $black = $image->colorAllocate (@c);
+ }
+ else {
+ $black = $image->colorAllocate ( 0, 0, 0);
+ }
+ if (defined $output{'default'}{'graph_bg'}) {
+ my $t = $output{'default'}{'graph_bg'};
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section 'default' section 'graph_bg'. Bad color.\n";
+ my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
+ $white = $image->colorAllocate (@c);
+ }
+ else {
+ $white = $image->colorAllocate (255, 255, 255);
+ }
+ $image->filledRectangle (0, 0, $xmax, $ymax, $white);
+ my $gray = $image->colorAllocate (128, 128, 128);
+ my $red = $image->colorAllocate (255, 0, 0);
+ my $red2 = $image->colorAllocate (189, 0, 0);
+ my $red3 = $image->colorAllocate (127, 0, 0);
+ my $coltxt = $black;
+
+ $image->transparent ($white) if $transparent;
+
+ my $FontWidth = gdSmallFont->width;
+ my $FontHeight = gdSmallFont->height;
+
+ $marginl = 60;
+ $marginr = 30;
+ $margint = 60;
+ $marginb = 30;
+ $shx = 7;
+ $shy = 7;
+
+ $max = 1 unless $max;
+ my $part = 8;
+ $max /= $factor;
+
+ my $old_max = $max;
+ {
+ my $t = log ($max) / log 10;
+ $t = sprintf "%.0f", $t - 1;
+ $t = exp ($t * log 10);
+ $max = sprintf "%.0f", $max / $t * 10 + 0.4;
+ my $t2 = sprintf "%.0f", $max / $part;
+ unless ($part * $t2 == $max) {
+ while ($part * $t2 != $max) {
+ $max++;
+ $t2 = sprintf "%d", $max / $part;
+ }
+ }
+ $max = $max * $t / 10;
+ }
+
+ # Title
+ $image->string (gdMediumBoldFont,
+ ($xmax - length ($title) * gdMediumBoldFont->width) / 2,
+ ($margint - $shy - gdMediumBoldFont->height) / 2,
+ $title, $coltxt);
+
+ # Labels
+ $image->string (gdSmallFont, $marginl / 2, $margint / 2, $labely, $coltxt);
+ $image->string (gdSmallFont, $xmax - $marginr / 2 -
+ $FontWidth * length ($labelx), $ymax - $marginb / 2,
+ $labelx, $coltxt);
+
+ # Max
+ $image->line ($marginl, $ymax - $marginb - $shy -
+ $old_max * ($ymax - $marginb - $margint - $shy) / $max,
+ $xmax - $marginr, $ymax - $marginb - $shy -
+ $old_max * ($ymax - $marginb - $margint - $shy) / $max, $red);
+ $image->line ($marginl, $ymax - $marginb - $shy -
+ $old_max * ($ymax - $marginb - $margint - $shy) / $max,
+ $marginl - $shx, $ymax - $marginb -
+ $old_max * ($ymax - $marginb - $margint - $shy) / $max, $red);
+
+ # Left
+ $image->line ($marginl - $shx, $margint + $shy,
+ $marginl - $shx, $ymax - $marginb, $coltxt);
+ $image->line ($marginl, $margint,
+ $marginl, $ymax - $marginb - $shy, $coltxt);
+ $image->line ($marginl, $margint,
+ $marginl - $shx, $margint + $shy, $coltxt);
+ $image->line ($marginl - $shx, $ymax - $marginb,
+ $marginl, $ymax - $marginb - $shy, $coltxt);
+
+ # Right
+ $image->line ($xmax - $marginr, $margint,
+ $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
+ $image->line ($xmax - $marginr - $shx, $ymax - $marginb,
+ $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
+
+ # Bottom
+ $image->line ($marginl - $shx, $ymax - $marginb,
+ $xmax - $marginr - $shx, $ymax - $marginb, $coltxt);
+ $image->line ($marginl, $ymax - $marginb - $shy,
+ $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
+ $image->fill ($xmax / 2, $ymax - $marginb - $shy / 2, $gray);
+
+ # Top
+ $image->line ($marginl, $margint,
+ $xmax - $marginr, $margint, $coltxt);
+ $image->setStyle ($coltxt, $coltxt, &GD::gdTransparent,
+ &GD::gdTransparent, &GD::gdTransparent);
+ # Graduations
+ for ($i = 0; $i <= $part; $i++) {
+ $j = $max * $i / $part ; # Warning to floor
+ # $j = ($max / $part) * ($i / 10000);
+ # $j *= 10000;
+
+ # Little hack...
+ $j = sprintf "%d", $j if $j > 100;
+
+ $image->line ($marginl - $shx - 3, $ymax - $marginb -
+ $i * ($ymax - $marginb - $margint - $shy) / $part,
+ $marginl - $shx, $ymax - $marginb -
+ $i * ($ymax - $marginb - $margint - $shy) / $part, $coltxt);
+ $image->line ($marginl - $shx, $ymax - $marginb -
+ $i * ($ymax - $marginb - $margint - $shy) / $part,
+ $marginl, $ymax - $marginb - $shy -
+ $i * ($ymax - $marginb - $margint - $shy) / $part, gdStyled);
+ $image->line ($marginl, $ymax - $marginb - $shy -
+ $i * ($ymax - $marginb - $margint - $shy) / $part,
+ $xmax - $marginr, $ymax - $marginb - $shy -
+ $i * ($ymax - $marginb - $margint - $shy) / $part, gdStyled);
+ $image->string (gdSmallFont,
+ $marginl - $shx - $FontWidth * length ("$j") - 7,
+ $ymax - $marginb -
+ ($i) * ($ymax - $marginb - $margint - $shy) / ($part) -
+ $FontHeight / 2, "$j", $coltxt);
+ }
+
+ # Graduation (right bottom corner)
+ $image->line ($xmax - $marginr - $shx, $ymax - $marginb,
+ $xmax - $marginr - $shx, $ymax - $marginb + 3, $coltxt);
+ # Bars
+ $i = 0;
+ my $w = ($xmax - $marginl - $marginr) / $nb;
+ my $k = $w / 5;
+ $$val[$nb - 1] = 0 unless $$val[$nb - 1];
+ foreach $j (@$val) {
+ my $MAX = 1;
+ if ($i++ <= $nb) {
+ # Graduation
+ $image->line ($marginl + ($i - 1) * $w - $shx, $ymax - $marginb,
+ $marginl + ($i - 1) * $w - $shx, $ymax - $marginb + 3,
+ $coltxt);
+ my $ii = sprintf "%d", $i / $MAX;
+ $image->string (gdSmallFont,
+ $marginl + ($i - 0.5) * $w + 1 -
+ ($FontWidth * length ($$labels[$i-1])) / 2 - $shx,
+ $ymax - $marginb + 3, $$labels[$i-1], $coltxt)
+ unless ($w < $FontWidth * length ($$labels[$i-1]))
+ && ($i != $MAX * $ii);
+
+ # Right
+ my $poly = new GD::Polygon;
+ $poly->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
+ $poly->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy);
+ $poly->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb);
+ $poly->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
+
+ $image->filledPolygon($poly, $red3);
+ $image->polygon($poly, $coltxt);
+
+ # Front
+ $image->filledRectangle ($marginl + ($i - 1) * $w + $k - $shx,
+ $ymax - $marginb -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max,
+ $marginl + ($i) * $w - $k - $shx,
+ $ymax - $marginb, $red);
+ $image->rectangle ($marginl + ($i - 1) * $w + $k - $shx,
+ $ymax - $marginb -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max,
+ $marginl + ($i) * $w - $k - $shx,
+ $ymax - $marginb, $coltxt);
+ # Top
+ my $poly2 = new GD::Polygon;
+ $poly2->addPt($marginl + ($i - 1) * $w + $k, $ymax - $marginb - $shy -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
+ $poly2->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
+ $poly2->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
+ $poly2->addPt($marginl + ($i - 1) * $w + $k - $shx, $ymax - $marginb -
+ $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
+
+ $image->rectangle (0, 0, $xmax - 1, $ymax - 1, $coltxt);
+ $image->filledPolygon($poly2, $red2);
+ $image->polygon($poly2, $coltxt);
+ }
+ }
+
+ open (IMG, "> $filename") || die "Can't create '$filename'\n";
+ if ($GD_FORMAT eq 'png') {
+ print IMG $image->png;
+ }
+ else {
+ print IMG $image->gif;
+ }
+ close IMG;
+ 1;
+}
+
+sub Chrono {
+ my $filename = shift; # filename
+ my $title = shift; # title
+ my $color_bg = shift; # background color
+ my $xmax = shift; # width
+ my $ymax = shift; # height
+
+ my $in = shift;
+ my $out = shift;
+ my $dates = shift;
+
+ my $legend_in = shift;
+ my $legend_out = shift;
+
+ my $color_in = shift;
+ my $color_out = shift;
+
+ my $unit = shift;
+
+ my $key;
+ my $x_min = 1E30;
+ my $x_max = 0;
+ my $y_min = 0;
+ my $y_max;
+ my $y_max_in = 0;
+ my $y_max_out = 0;
+
+ foreach $key (sort keys %$dates) {
+ $x_min = $key if $x_min > $key;
+ $x_max = $$dates{$key} if $x_max < $$dates{$key};
+ my $t = $$out{$key} / ($$dates{$key} - $key);
+ $y_max_out = $t if $y_max_out < $t;
+ $t = $$in{$key} / ($$dates{$key} - $key);
+ $y_max_in = $t if $y_max_in < $t;
+ }
+ $y_max = $y_max_out > $y_max_in ? $y_max_out : $y_max_in;
+ my $factor = 1;
+ if ($y_max < 1) {
+ $factor = 60;
+ if ($y_max < 4 / 60) {
+ $y_max = 4 / 60;
+ }
+ else {
+ $y_max = int ($y_max * $factor) + 1;
+ $y_max += (4 - ($y_max % 4)) % 4;
+ $y_max /= $factor;
+ }
+ }
+ else {
+ $y_max = int ($y_max) + 1;
+ $y_max += (4 - ($y_max % 4)) % 4;
+ }
+
+ $unit .= "/" . ($factor == 60 ? "min" : "sec");
+
+ # min range is 4 weeks.
+ my $delta = $x_max - $x_min;
+ $x_min = $x_max - 3024000 if $delta < 3024000;
+ # between 4 weeks and one year, range is a year.
+ $x_min = $x_max - 31536000 if ($delta < 31536000 && $delta > 3024000);
+ # max range is 13 months
+ $x_min = $x_max - 34128000 if $delta > 34128000;
+ my $image = new GD::Image ($xmax, $ymax);
+ my ($white, $black);
+ if (defined $output{'default'}{'graph_fg'}) {
+ my $t = $output{'default'}{'graph_fg'};
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section 'default' section 'graph_fg'. Bad color.\n";
+ my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
+ $black = $image->colorAllocate (@c);
+ }
+ else {
+ $black = $image->colorAllocate ( 0, 0, 0);
+ }
+ if (defined $output{'default'}{'graph_bg'}) {
+ my $t = $output{'default'}{'graph_bg'};
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section 'default' section 'graph_bg'. Bad color.\n";
+ my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
+ $white = $image->colorAllocate (@c);
+ }
+ else {
+ $white = $image->colorAllocate (255, 255, 255);
+ }
+ my $bg;
+ if (defined $color_bg) {
+ $color_bg =~ m/^\#[\da-fA-F]{6}$/o ||
+ die "Error in section 'index'. Bad color $color_bg.\n";
+ my @c = map { hex $_ } ($color_bg =~ m/^\#(..)(..)(..)$/);
+ $bg = $image->colorAllocate (@c);
+ }
+ else {
+ $bg = $image->colorAllocate (255, 255, 206);
+ }
+ my $col_in;
+ if (defined $color_in) {
+ $color_in =~ m/^\#[\da-fA-F]{6}$/o ||
+ die "Error in section 'index'. Bad color $color_in.\n";
+ my @c = map { hex $_ } ($color_in =~ m/^\#(..)(..)(..)$/);
+ $col_in = $image->colorAllocate (@c);
+ }
+ else {
+ $col_in = $image->colorAllocate ( 80, 159, 207);
+ }
+ my $col_out;
+ my @col_out = ( 0, 0, 255);
+ if (defined $color_out) {
+ $color_out =~ m/^\#[\da-fA-F]{6}$/o ||
+ die "Error in section 'index'. Bad color $color_out.\n";
+ my @c = map { hex $_ } ($color_out =~ m/^\#(..)(..)(..)$/);
+ $col_out = $image->colorAllocate (@c);
+ @col_out = @c;
+ }
+ else {
+ $col_out = $image->colorAllocate (@col_out);
+ }
+
+ my $white2 = $image->colorAllocate (255, 255, 255);
+ my $gray = $image->colorAllocate (192, 192, 192);
+ my $red = $image->colorAllocate (255, 0, 0);
+ my $coltxt = $black;
+
+ my $size = 22; # legend
+ # legend statistics
+ my ($max_in, $max_out) = (0, 0); # min
+ my ($min_in, $min_out) = (1E10, 1E10); # max
+ my ($t_in, $t_out) = (0, 0); # time
+ my ($s_in, $s_out) = (0, 0); # sum
+
+ $image->filledRectangle (0, 0, $xmax, $ymax, $gray);
+ $image->transparent ($gray) if $transparent;
+
+ my $FontWidth = gdSmallFont->width;
+ my $FontHeight = gdSmallFont->height;
+ $image->setStyle ($black, &GD::gdTransparent, &GD::gdTransparent);
+
+ my $marginl = 13 + $FontWidth * length (sprintf "%d", $y_max * $factor);
+ my $marginr = 15 + 4 * $FontWidth; # "100%"
+ my $margint = 2 * $FontHeight + gdMediumBoldFont->height;
+ my $marginb = 2 * $FontHeight + $size;
+ my $xratio = ($xmax - $marginl - $marginr) / ($x_max - $x_min);
+ my $yratio = ($ymax - $margint - $marginb) / ($y_max - $y_min);
+
+ my $frame = new GD::Polygon;
+ $frame->addPt(2, $margint - $FontHeight -3);
+ $frame->addPt($xmax - 2, $margint - $FontHeight -3);
+ $frame->addPt($xmax - 2, $ymax - 3);
+ $frame->addPt(2, $ymax - 3);
+ $image->filledPolygon($frame, $white2);
+ $image->polygon($frame, $black);
+
+ $image->filledRectangle ($marginl, $margint,
+ $xmax - $marginr, $ymax - $marginb, $bg);
+ my $brush = new GD::Image(1, 2);
+ my $b_col = $brush->colorAllocate(@col_out);
+ $brush->line(0, 0, 0, 1, $b_col);
+ $image->setBrush($brush);
+ my ($old_x, $old_y_in, $old_y_out);
+ foreach $key (sort keys %$dates) {
+ next if $key < $x_min;
+ my $delta = $$dates{$key} - $key;
+ $min_in = $$in{$key} / $delta if $min_in > $$in{$key} / $delta;
+ $max_in = $$in{$key} / $delta if $max_in < $$in{$key} / $delta;
+ $min_out = $$out{$key} / $delta if $min_out > $$out{$key} / $delta;
+ $max_out = $$out{$key} / $delta if $max_out < $$out{$key} / $delta;
+ $t_in += $delta;
+ $s_in += $$in{$key};
+ $s_out += $$out{$key};
+
+ my $tt_in = $$in{$key} / ($$dates{$key} - $key) * $yratio;
+ my $tt_out = $$out{$key} / ($$dates{$key} - $key) * $yratio;
+ my $new_x = $marginl + ($key - $x_min) * $xratio;
+ $image->filledRectangle ($marginl + ($key - $x_min) * $xratio,
+ $ymax - $marginb - $tt_in,
+ $marginl + ($$dates{$key} - $x_min) * $xratio,
+ $ymax - $marginb, $col_in);
+ if (defined $old_x) {
+ $old_x = $new_x if $old_x > $new_x;
+ my $poly = new GD::Polygon;
+ $poly->addPt($old_x, $old_y_in);
+ $poly->addPt($new_x, $ymax - $marginb - $tt_in);
+ $poly->addPt($new_x, $ymax - $marginb);
+ $poly->addPt($old_x, $ymax - $marginb);
+ $image->filledPolygon($poly, $col_in);
+ }
+ $image->line ($marginl + ($key - $x_min) * $xratio,
+ $ymax - $marginb - $tt_out,
+ $marginl + ($$dates{$key} - $x_min) * $xratio,
+ $ymax - $marginb - $tt_out, &GD::gdBrushed);
+ $image->line ($old_x, $old_y_out, $new_x,
+ $ymax - $marginb - $tt_out, $col_out) if defined $old_x;
+ $old_x = $marginl + ($$dates{$key} - $x_min) * $xratio;
+ $old_y_in = $ymax - $marginb - $tt_in;
+ $old_y_out = $ymax - $marginb - $tt_out;
+ }
+ $t_out = $t_in;
+
+ # main frame
+ $image->rectangle ($marginl, $margint,
+ $xmax - $marginr, $ymax - $marginb, $black);
+ # graduations
+ my $i;
+ foreach $i (0, 25, 50, 75, 100) {
+ my $t = $ymax - $margint - $marginb;
+ $image->line ($marginl, $ymax - $marginb - $i / 100 * $t,
+ $xmax - $marginr, $ymax - $marginb - $i / 100 * $t,
+ &GD::gdStyled);
+ $image->line ($xmax - $marginr, $ymax - $marginb - $i / 100 * $t,
+ $xmax - $marginr + 3, $ymax - $marginb - $i / 100 * $t,
+ $black);
+ $image->line ($marginl - 3, $ymax - $marginb - $i / 100 * $t,
+ $marginl, $ymax - $marginb - $i / 100 * $t,
+ $black);
+ $image->string (&GD::gdSmallFont, $xmax - $marginr + 8, - $FontHeight / 2 +
+ $ymax - $marginb - $i / 100 * $t, "$i%", $black);
+ my $s = sprintf "%d", $y_max * $i / 100 * $factor;
+ $image->string (&GD::gdSmallFont, $marginl - 5 - $FontWidth * length $s,
+ - $FontHeight / 2 +
+ $ymax - $marginb - $i / 100 * $t, $s, $black);
+ }
+ ##
+ my $w = 604800; # number of seconds in a week
+ my $y = 31536000; # number of seconds in a 365 days year
+ my $mm = 2592000; # number of seconds in a 30 days month
+ if ($x_max - $x_min <= 3024000) { # less than five weeks
+ # unit is a week
+ # 1/1/1990 is a monday. Use this as a basis.
+ my $d = 631152000; # number of seconds between 1/1/1970 and 1/1/1990
+ my $n = int ($x_min / $y);
+ my $t = $x_min - $n * $y - int (($n - 2) / 4) * 24 * 3600;
+ my $f = int ($t / $w);
+ $n = $d + int (($x_min - $d) / $w) * $w;
+ while ($n < $x_max) {
+ $t = $marginl + ($n - $x_min) * $xratio;
+ if ($n > $x_min) {
+ $image->line ($t, $margint, $t, $ymax - $marginb, &GD::gdStyled);
+ $image->line ($t, $ymax - $marginb, $t, $ymax - $marginb + 2, $black);
+ }
+ $image->string (&GD::gdSmallFont, $FontWidth * 7 / 2 + $t,
+ $ymax - $marginb + 4, (sprintf "Week %02d", $f), $black)
+ if ($n + $w / 2 > $x_min) && ($n + $w / 2 < $x_max);
+ $f++;
+ $n += $w;
+ $t = int ($n / $y);
+ $f = 0
+ if $n - $y * $t - int (($t - 2) / 4) * 24 * 3600 < $w && $f > 50;
+ }
+ $d = 86400; # 1 day
+ $n = int ($x_min / $y);
+ $t = $n * $y + int (($n - 2) / 4) * 24 * 3600;
+ $i = 0;
+ my $x;
+ while ($t < $x_max) {
+ $x = $marginl + ($t - $x_min) * $xratio;
+ $image->line ($x, $margint, $x, $ymax - $marginb + 2, $red)
+ if $t > $x_min;
+ $t += $mm;
+ $t += $d if $i == 0 || $i == 2 || $i == 4 ||
+ $i == 6 || $i == 7 || $i == 9 || $i == 11; # 31 days months
+ if ($i == 1) { # february ?
+ $t -= 2 * $d;
+ $t += $d unless (1970 + int ($t / $y)) % 4;
+ }
+ $i++;
+ $i = 0 if $i == 12; # Happy New Year !!
+ }
+ }
+ else {
+ # unit is a month
+ my $n = int ($x_min / $y);
+ my $t = $n * $y + int (($n - 2) / 4) * 24 * 3600;
+ my @m = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
+ my $d = 86400; # 1 day
+ my $i = 0;
+ my $x;
+ while ($t < $x_max) {
+ $x = $marginl + ($t - $x_min) * $xratio;
+ if ($t > $x_min) {
+ $image->line ($x, $margint, $x, $ymax - $marginb, &GD::gdStyled);
+ $image->line ($x, $ymax - $marginb, $x,
+ $ymax - $marginb + 2, $black);
+ $image->line ($x, $margint, $x, $ymax - $marginb, $red) unless $i;
+ }
+ $image->string (&GD::gdSmallFont,
+ $mm * $xratio / 2 - $FontWidth * 3 / 2 +
+ $x, $ymax - $marginb + 4, (sprintf "%s", $m[$i]),
+ $black)
+ if ($t + 2 * $w > $x_min) && ($x_max > 2 * $w + $t);
+ $t += $mm;
+ $t += $d if ($i == 0 || $i == 2 || $i == 4 ||
+ $i == 6 || $i == 7 || $i == 9 || $i == 11); # 31 days months
+ if ($i == 1) { # february ?
+ $t -= 2 * $d;
+ $t += $d unless (1970 + int ($t / $y)) % 4;
+ }
+ $i++;
+ $i = 0 if $i == 12; # Happy New Year !!
+ }
+ }
+
+ # Add the little red arrow
+ my $poly = new GD::Polygon;
+ $poly->addPt($xmax - $marginr - 2, $ymax - $marginb - 3);
+ $poly->addPt($xmax - $marginr + 4, $ymax - $marginb);
+ $poly->addPt($xmax - $marginr - 2, $ymax - $marginb + 3);
+ $image->filledPolygon($poly, $red);
+
+ # Title
+ $image->string (&GD::gdMediumBoldFont,
+ $xmax / 2 - $FontWidth * length ($title) / 2, 4,
+ $title, $black);
+
+ # Legend
+ my $y_in = $ymax - $size - $FontHeight + 5;
+ $image->string (&GD::gdSmallFont, $marginl, $y_in, $legend_in, $col_in);
+ $image->string (&GD::gdSmallFont, $xmax / 4, $y_in,
+ (sprintf "Min: %5.1f $unit", $min_in * $factor), $black);
+ $image->string (&GD::gdSmallFont, $xmax / 2, $y_in,
+ (sprintf "Avg: %5.1f $unit", $s_in / $t_in * $factor), $black);
+ $image->string (&GD::gdSmallFont, 3 * $xmax / 4, $y_in,
+ (sprintf "Max: %5.1f $unit", $max_in * $factor), $black);
+
+ my $y_out = $ymax - $size + 5;
+ $image->string (&GD::gdSmallFont, $marginl, $y_out, $legend_out, $col_out);
+ $image->string (&GD::gdSmallFont, $xmax / 4, $y_out,
+ (sprintf "Min: %5.1f $unit", $min_out * $factor), $black);
+ $image->string (&GD::gdSmallFont, $xmax / 2, $y_out,
+ (sprintf "Avg: %5.1f $unit", $s_out / $t_out * $factor), $black);
+ $image->string (&GD::gdSmallFont, 3 * $xmax / 4, $y_out,
+ (sprintf "Max: %5.1f $unit", $max_out * $factor), $black);
+
+ open (IMG, "> $filename") || die "Error: Can't open \"$filename\": $!\n";
+ if ($GD_FORMAT eq 'png') {
+ print IMG $image->png;
+ }
+ else {
+ print IMG $image->gif;
+ }
+ close IMG;
+ return $ymax;
+}
+
+sub Write_all_results {
+ my $HTML_output = shift;
+ my $h = shift;
+ my $k;
+
+ my $title = $$h{'default'}{'title'} ?
+ $$h{'default'}{'title'} : "Daily Usenet report";
+ $title =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $title =~ s/\\\"/\"/go;
+ my $Title = $title;
+ $Title =~ s/<.*?>//go;
+ {
+ my $Title = $Title;
+ $Title =~ s/\&/&/go;
+ $Title =~ s/\</</go;
+ $Title =~ s/\>/>/go;
+ print "$Title from $first_date to $last_date\n\n";
+ }
+
+ if ($HTML) {
+ my $body = defined $output{'default'}{'html_body'} ?
+ $output{'default'}{'html_body'} : '';
+ $body =~ s/^\"\s*(.*?)\s*\"$/ $1/o;
+ $body =~ s/\\\"/\"/go;
+ open (HTML, "> $HTML_output") || die "Error: cant open $HTML_output\n";
+
+ print HTML "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n" .
+ "<HTML>\n<HEAD>\n<TITLE>$Title: $first_date</TITLE>\n" .
+ "<!-- innreport $version -->\n</HEAD>\n<BODY $body>\n" .
+ "$HTML_header\n<CENTER><H1>$title</H1>\n" .
+ "<H3>$first_date -- $last_date</H3>\n</CENTER>\n<P><HR><P>\n";
+
+ # Index
+ print HTML "<UL>\n";
+ foreach $k (@{$$h{'_order_'}}) {
+ next if $k =~ m/^(default|index)$/;
+ my ($data) = $$h{$k}{'data'} =~ m/^\"\s*(.*?)\s*\"$/o;
+ $data =~ s/^\%/\%$CLASS\:\:/ unless $data eq '%prog_type';
+ my %data;
+ { local $^W = 0; no strict; %data = eval $data }
+ my ($string) = $$h{$k}{'title'} =~ m/^\"\s*(.*?)\s*\"$/o;
+ $string =~ s/\s*:$//o;
+ my $want = 1;
+
+ ($want) = $$h{$k}{'skip'} =~ m/^\"?\s*(.*?)\s*\"?$/o
+ if defined $$h{$k}{'skip'};
+ $want = $want eq 'true' ? 0 : 1;
+ print HTML "<LI><A HREF=\"#$k\">$string</A>\n" if %data && $want;
+ }
+ print HTML "</UL><P><HR><P>\n";
+ }
+ if (@unrecognize && $WANT_UNKNOWN) {
+ my $mm = $#unrecognize;
+ print HTML "<A NAME=\"unrecognize\">" if $HTML && $WANT_HTML_UNKNOWN;
+ print "Unknown entries from news log file:\n";
+ print HTML "<STRONG>Unknown entries from news log file:</STRONG></A><P>\n"
+ if $HTML && $WANT_HTML_UNKNOWN;
+ $mm = $MAX_UNRECOGNIZED - 1
+ if $MAX_UNRECOGNIZED > 0 && $mm > $MAX_UNRECOGNIZED - 1;
+ if ($mm < $unrecognize_max && $unrecognize_max > 0) {
+ printf HTML "First %d / $unrecognize_max lines (%3.1f%%)<BR>\n", $mm + 1,
+ ($mm + 1) / $unrecognize_max * 100 if $HTML && $WANT_HTML_UNKNOWN;
+ printf "First %d / $unrecognize_max lines (%3.1f%%)\n", $mm + 1,
+ ($mm + 1) / $unrecognize_max * 100;
+ }
+
+ my $l;
+ for $l (0 .. $mm) {
+ chomp $unrecognize[$l]; # sometimes, the last line need a CR
+ print "$unrecognize[$l]\n"; # so, we always add one
+ if ($HTML && $WANT_HTML_UNKNOWN) {
+ $unrecognize[$l] =~ s/&/\&/g;
+ $unrecognize[$l] =~ s/</\</g;
+ $unrecognize[$l] =~ s/>/\>/g;
+ print HTML "$unrecognize[$l]<BR>\n";
+ }
+ }
+ print "\n";
+ print HTML "<P><HR><P>\n" if $HTML && $WANT_HTML_UNKNOWN;
+ }
+
+ close HTML if $HTML;
+ foreach $k (@{$$h{'_order_'}}) {
+ next if $k =~ m/^(default|index)$/;
+ &Write_Results($HTML_output, $k, $h);
+ }
+ if ($HTML) {
+ open (HTML, ">> $HTML_output") || die "Error: cant open $HTML_output\n";
+ print HTML <<EOT;
+innreport $version (c) 1996-1999 by Fabien Tassin
+<<A HREF="mailto:fta\@sofaraway.org">fta\@sofaraway.org</A>>.
+EOT
+ if (defined $$h{'default'}{'footer'}) {
+ my ($t) = $$h{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o;
+ $t =~ s/\\\"/\"/go;
+ print HTML "<BR>" . $t;
+ }
+ print HTML "\n$HTML_footer";
+ printf HTML "\n<!-- Running time: %s -->", second2time(time - $start_time);
+ print HTML "\n</BODY>\n</HTML>\n";
+ close HTML;
+ }
+}
+
+sub Write_Results {
+ my $HTML_output = shift;
+ my $report = shift;
+ my $data = shift;
+ my %output = %$data;
+ return 0 unless defined $output{$report}; # no data to write
+ return 0 if defined $output{$report}{'skip'} &&
+ $output{$report}{'skip'} =~ m/^true$/io;
+ my ($TEXT, $HTML, $DOUBLE);
+
+ # Need a text report ?
+ $TEXT = defined $output{$report}{'text'} ? $output{$report}{'text'} :
+ (defined $output{'default'}{'text'} ? $output{'default'}{'text'} : '');
+ die "Error in config file. Field 'text' is mandatory.\n" unless $TEXT;
+ $TEXT = ($TEXT =~ m/^true$/io) ? 1 : 0;
+
+ # Need an html report ?
+ if ($HTML_output) {
+ $HTML = defined $output{$report}{'html'} ? $output{$report}{'html'} :
+ (defined $output{'default'}{'html'} ? $output{'default'}{'html'} : '');
+ die "Error in config file. Field 'html' is mandatory.\n" unless $HTML;
+ $HTML = ($HTML =~ m/^true$/io) ? 1 : 0;
+ }
+ # Double table ?
+ $DOUBLE = defined $output{$report}{'double'} ?
+ $output{$report}{'double'} : 0;
+ $DOUBLE = ($DOUBLE =~ m/^true$/io) ? 1 : 0;
+
+ # Want to truncate the report ?
+ my $TOP = defined $output{$report}{'top'} ? $output{$report}{'top'} : -1;
+ my $TOP_HTML = defined $output{$report}{'top_html'} ?
+ $output{$report}{'top_html'} : $TOP;
+ my $TOP_TEXT = defined $output{$report}{'top_text'} ?
+ $output{$report}{'top_text'} : $TOP;
+
+ my (%h, %d, $h);
+ {
+ my $t = $output{$report}{'data'} ||
+ die "Error in section $report. Need a 'data' field.\n";
+ $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
+ %d = eval $t;
+ return unless %d; # nothing to report. exit.
+ return unless keys (%d); # nothing to report. exit.
+ }
+ {
+ my $t = defined $output{$report}{'sort'} ? $output{$report}{'sort'} :
+ "\$a cmp \$b";
+ $t =~ s/\n/ /smog;
+ $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $t =~ s/([\$\%\@])/$1${CLASS}\:\:/go;
+ $t =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|num)/$1$2/go;
+ $t =~ s/\{\$${CLASS}\:\:(a|b)\}/\{\$$1\}/go;
+ $t =~ s/\$${CLASS}\:\:(a|b)/\$$1/go;
+ $h = $t;
+ }
+
+ if ($HTML) {
+ open (HTML, ">> $HTML_output") || die "Error: cant open $HTML_output\n";
+ }
+ print "\n" if $TEXT;
+ my ($key, $key1, $key2);
+ if (defined $output{$report}{'title'}) {
+ my $t = $output{$report}{'title'};
+ $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ if ($HTML) {
+ print HTML "<A NAME=\"$report\">";
+ my $html = $t;
+ $html =~ s/(:?)$/ [Top $TOP_HTML]$1/o if $TOP_HTML > 0;
+ $html =~ s|^(.*)$|<STRONG>$1</STRONG>|;
+ print HTML "$html</A>\n<P>\n<CENTER>\n<TABLE BORDER=\"1\">\n";
+ }
+ $t =~ s/(:?)$/ [Top $TOP_TEXT]$1/o if $TOP_TEXT > 0;
+ print "$t\n" if $TEXT;
+ }
+ my $numbering = 0;
+ $numbering = 1 if defined $output{$report}{'numbering'} &&
+ $output{$report}{'numbering'} =~ m/^true$/o;
+ my $i;
+ my $s = '';
+ my $html = '';
+ my $first = 0;
+
+ foreach $i (@{$output{$report}{'column'}}) {
+ my ($v1, $v2);
+
+ my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
+ $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
+ my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
+ $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
+
+ $v1 = defined ($$i{'format_name'}) ? $$i{'format_name'} :
+ (defined ($$i{'format'}) ? $$i{'format'} : "%s");
+ $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $v2 = $$i{'name'};
+ $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $s .= sprintf $v1 . " ", $v2 if $wtext && !($DOUBLE && $first == 1);
+ if ($HTML && $whtml) {
+ my $v1 = $v1;
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?(\w)/\%$1/g;
+ my $temp = $first ? "CENTER" : "LEFT";
+ $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
+ $html .= sprintf "<TH ALIGN=\"$temp\">$v1</TH>", $v2;
+ }
+ $first++;
+ }
+ $s =~ s/\s*$//;
+ print "$s\n" if $TEXT;
+ $s = '';
+ if ($HTML) {
+ print HTML "<TR>$html</TR>\n<TR><TD></TD></TR>\n";
+ $html = '';
+ }
+ my $num = 0;
+ my $done;
+ if ($DOUBLE) {
+ my $num_d = 0;
+ foreach $key1 (sort keys (%d)) {
+ $done = 0;
+ $num = 0;
+ $num_d++;
+ $s = '';
+ $html = '';
+ my @res;
+ foreach $key2 (sort {$d{$key1}{$b} <=> $d{$key1}{$a}}
+ keys (%{$d{$key1}})) {
+ my $first = 0;
+ $num++;
+ foreach $i (@{$output{$report}{'column'}}) {
+ my ($v1, $v2, $p);
+
+ my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
+ $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
+ my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
+ $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
+
+ # is it the primary key ?
+ $p = 0;
+ $p = 1 if defined $$i{'primary'} && $$i{'primary'} =~ m/true/;
+
+ # format
+ $v1 = defined ($$i{'format'}) ? $$i{'format'} : "%s";
+ $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+
+ # value
+ $v2 = $$i{'value'};
+ $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $r ='';
+ if ($v2) {
+ $r = &EvalExpr ($v2, $key2, $num, $key1);
+ die "Error in section $report column $$i{'name'}. " .
+ "Invalid 'value' value.\n" unless defined $r;
+ }
+ $res[$first] += $r if $v1 =~ m/\%-?(?:\d+(?:\.\d+)?)?d/o;
+ if ($p) {
+ $s .= sprintf $v1. "\n", $r unless $done || !$wtext;
+ if ($HTML && $whtml) {
+ if ($done) {
+ $html .= "<TD></TD>";
+ }
+ else {
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+ $html .= $numbering ? "<TH ALIGN=\"CENTER\">$num_d</TH>" : '';
+ # unless $first;
+ $html .= sprintf "<TD ALIGN=\"LEFT\">$v1</TD></TR>\n", $r;
+ $html .= "<TR><TD></TD>";
+ }
+ }
+ }
+ else {
+ if ($wtext) {
+ $s .= " " if $first == 1;
+ $s .= sprintf $v1 . " ", $r;
+ }
+ if ($HTML && $whtml) {
+ $html .= $numbering ? "<TD></TD>" : '' if $first == 1;
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+ my $temp = $first > 1 ? "RIGHT" : "LEFT";
+ $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
+ }
+ }
+ $done = 1 if $p;
+ $first++;
+ }
+ $s =~ s/\s*$//;
+ $s =~ s/\\n/\n/g;
+ print "$s\n" if $TEXT && ($num <= $TOP_TEXT || $TOP_TEXT == -1);
+ if ($HTML && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
+ $html =~ s/\\n//g;
+ print HTML "<TR>$html</TR>\n";
+ }
+ $s = '';
+ $html = '';
+ }
+ $first = 0;
+ $s = '';
+ $html = '';
+ if ($TOP_TEXT != -1 && $TOP_HTML != -1) {
+ foreach $i (@{$output{$report}{'column'}}) {
+ if (defined $$i{'primary'} && $$i{'primary'} =~ m/true/o) {
+ $first++;
+ $s .= ' ';
+ $html .= "<TD></TD>" if $HTML;
+ $html .= "<TD></TD>" if $HTML && $numbering;
+ next;
+ }
+ my ($v1, $v2);
+ $v1 = defined ($$i{'format_total'}) ? $$i{'format_total'} :
+ (defined ($$i{'format'}) ? $$i{'format'} : "%s");
+ $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $r = $first == 1 ? $num : $res[$first];
+ $s .= sprintf $v1 . " ", $r;
+ if ($HTML) {
+ my $temp = $first > 1 ? "RIGHT" : "LEFT";
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+ $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first > 1;
+ $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
+ }
+ $first++;
+ }
+ $s =~ s/\s*$//;
+ $s =~ s/\\n//g;
+ print "$s\n" if $TEXT;
+ print HTML "<TR>$html</TR>\n" if $HTML;
+ }
+ }
+ print "\n" if $TEXT;
+ print HTML "<TR><TD></TD></TR>\n" if $HTML;
+ $first = 0;
+ $num = $num_d;
+ $s = '';
+ $html = '';
+ foreach $i (@{$output{$report}{'column'}}) {
+ my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
+ $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
+ my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
+ $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
+
+ my ($v1, $v2);
+ $v1 = defined $$i{'format_total'} ? $$i{'format_total'} :
+ (defined $$i{'format'} ? $$i{'format'} : "%s");
+ $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $v2 = $$i{'total'} ||
+ die "Error in section $report column $$i{'name'}. " .
+ "Need a 'total' field.\n";
+ $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $r = '';
+ if ($v2) {
+ $r = &EvalExpr ($v2, $key2, $num, 1);
+ die "Error in section $report column $$i{'name'}. " .
+ "Invalid 'total' value.\n" unless defined $r;
+ }
+ $s .= sprintf $v1 . " ", $r if $wtext && $first != 1;
+ if ($HTML && $whtml) {
+ my $temp = $first ? "RIGHT" : "LEFT";
+ $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+ $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first;
+ $html .= $first == 1 ? "<TD></TD>" :
+ sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
+ }
+ $first++;
+ }
+ $s =~ s/\s*$//;
+ $s =~ s/\\n//g;
+ print "$s\n" if $TEXT;
+ print HTML "<TR>$html</TR>\n</TABLE>\n</CENTER>\n<P>\n<HR>\n" if $HTML;
+ }
+ else {
+ # foreach $key (sort { local $^W = 0; no strict; eval $h } (keys (%d)))
+ foreach $key ((eval "sort {local \$^W = 0; no strict; $h} (keys (%d))")) {
+ next unless defined $key;
+ next unless defined $d{$key}; # to avoid problems after some undef()
+ $num++;
+ next unless $num <= $TOP_HTML || $TOP_HTML == -1 ||
+ $num <= $TOP_TEXT || $TOP_TEXT == -1;
+ my $first = 0;
+ foreach $i (@{$output{$report}{'column'}}) {
+ my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
+ $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
+ my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
+ $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
+
+ my ($v1, $v2);
+ $v1 = defined ($$i{'format'}) ? $$i{'format'} : "%s";
+ $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $v2 = $$i{'value'};
+ $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $r ='';
+ if ($v2) {
+ $r = &EvalExpr ($v2, $key, $num);
+ die "Error in section $report column $$i{'name'}. " .
+ "Invalid 'value' value.\n" unless defined $r;
+ }
+ $s .= sprintf $v1 . " ", $r
+ if $wtext && (($num <= $TOP_TEXT) || ($TOP_TEXT == -1));
+ if ($HTML && $whtml && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+ $html .= "<TH ALIGN=\"CENTER\">$num</TH>" if $numbering && !$first;
+ my $temp = $first ? "RIGHT" : "LEFT";
+ $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
+ }
+ $first++;
+ }
+ $s =~ s/\s*$//;
+ print "$s\n" if $TEXT && ($num <= $TOP_TEXT || $TOP_TEXT == -1);
+ $s = '';
+ if ($HTML && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
+ print HTML "<TR>$html</TR>\n";
+ $html = '';
+ }
+ }
+ print "\n" if $TEXT;
+ print HTML "<TR><TD></TD></TR>\n" if $HTML;
+ $first = 0;
+ foreach $i (@{$output{$report}{'column'}}) {
+ my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
+ $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
+ my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
+ $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
+
+ my ($v1, $v2);
+ $v1 = defined ($$i{'format_total'}) ? $$i{'format_total'} :
+ (defined ($$i{'format'}) ? $$i{'format'} : "%s");
+ $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $v2 = $$i{'total'} ||
+ die "Error in section $report column $$i{'name'}. " .
+ "Need a 'total' field.\n";
+ $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $r = '';
+ if ($v2) {
+ $r = &EvalExpr ($v2, $key, $num);
+ die "Error in section $report column $$i{'name'}. " .
+ "Invalid 'total' value.\n" unless defined $r;
+ }
+ $s .= sprintf $v1 . " ", $r if $wtext;
+ if ($HTML && $whtml) {
+ $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
+ my $temp = $first ? "RIGHT" : "LEFT";
+ $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
+ $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first;
+ $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
+ }
+ $first++;
+ }
+ $s =~ s/\s*$//;
+ print "$s\n" if $TEXT;
+ if ($HTML) {
+ print HTML "<TR>$html</TR>\n";
+ print HTML "</TABLE>\n</CENTER><P>\n";
+
+ my $i = 0;
+ while ($GRAPH && defined ${${$output{$report}{'graph'}}[$i]}{'type'}) {
+ my $type = ${${$output{$report}{'graph'}}[$i]}{'type'};
+ my ($title) = ${${$output{$report}{'graph'}}[$i]}{'title'} =~
+ m/^\"\s*(.*?)\s*\"$/o;
+ if ($type eq 'histo3d') {
+ my (@values, @colors, @labels);
+ my $num = 0;
+ my $j;
+ foreach $j (@{${${$output{$report}{'graph'}}[$i]}{'data'}}) {
+ $num++;
+ my ($h) = $$j{'value'} =~ m/^\"\s*(.*?)\s*\"$/o;
+ my %hh;
+ $h =~ s/^\%/\%$CLASS\:\:/ unless $h eq '%prog_type';
+ { local $^W = 0; no strict; %hh = eval $h }
+ push @values, \%hh;
+ my ($t) = $$j{'name'} =~ m/^\"\s*(.*?)\s*\"$/o;
+ push @labels, $t;
+ $t = $$j{'color'} ||
+ die "Error in section $report section 'graph'. " .
+ "No color specified for 'value' $$j{'value'}.\n";
+ $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
+ $t =~ m/^[\da-fA-F]{6}$/o ||
+ die "Error in section $report section 'graph'. " .
+ "Bad color for 'value' $$j{'value'}.\n";
+ my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
+ push @colors, \@c;
+ }
+ $suffix = '' unless defined $suffix;
+ my $s = ($i ? $i : '') . $suffix;
+ print HTML "<CENTER><IMG ALT=\"$title\" ";
+ close HTML;
+ my $y = &Graph3d ("$IMG_dir/$report$s.$GD_FORMAT",
+ $title, $xmax, $num, @values, \@colors, \@labels);
+ open (HTML, ">> $HTML_output") ||
+ die "Error: cant open $HTML_output\n";
+ print HTML "WIDTH=\"$xmax\" HEIGHT=\"$y\" ";
+ print HTML "SRC=\"$IMG_pth$report$s.$GD_FORMAT\"></CENTER>\n";
+ }
+ elsif ($type eq 'histo') {
+ my (%values, %labels);
+ my $factor =
+ ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'factor'}
+ || die "Error in section $report section 'graph'. " .
+ "No factor specified for 'value' " .
+ ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
+ ".\n";
+ $factor =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $labelx =
+ ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'}
+ || die "Error in section $report section 'graph'. " .
+ "No name specified for value.\n";
+ $labelx =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $labely =
+ ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'}
+ || die "Error in section $report section 'graph'. " .
+ "No name specified for value.\n";
+ $labely =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ my $t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'value'}
+ || die "Error in section $report section 'graph'. " .
+ "No 'value' specified for " .
+ ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'} .
+ ".\n";
+ $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
+ { local $^W = 0; no strict; %labels = eval $t }
+
+ $t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'value'} ||
+ die "Error in section $report section 'graph'. " .
+ "No 'value' specified for " .
+ ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
+ ".\n";
+ $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
+ $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
+ { local $^W = 0; no strict; %values = eval $t }
+ my $s = ($i ? $i : '') . $suffix;
+ {
+ my $r;
+ close HTML;
+ $r = &Histo ("$IMG_dir/$report$s.$GD_FORMAT", $title, $xmax,
+ $factor, $labelx, $labely, \%values, \%labels);
+ open (HTML, ">> $HTML_output") ||
+ die "Error: cant open $HTML_output\n";
+ print HTML "<CENTER><IMG ALT=\"$title\" WIDTH=\"$xmax\" " .
+ "SRC=\"$IMG_pth$report$s.$GD_FORMAT\"></CENTER>\n" if $r;
+ }
+ }
+ elsif ($type eq 'piechart') {
+ print "Sorry, graph type 'piechart' not supported yet..\n";
+ }
+ else {
+ die "Error in section $report section 'graph'. " .
+ "Invalid 'type' value.\n"
+ }
+ $i++;
+ print HTML "<P>\n";
+ }
+ print HTML "\n<HR>\n";
+ }
+ }
+ close HTML if $HTML;
+}
+
+sub EvalExpr {
+ my $v = shift;
+ my ($key, $num, $key1) = @_;
+ my $key2;
+
+ $v =~ s/\n/ /smog;
+ $v =~ s/^\"(.*?)\"$/$1/o;
+ if ($key1) {
+ $key2 = $key;
+ $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotalDouble\(\\%/og;
+ }
+ else {
+ $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotal\(\\%/og;
+ # $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%([^\)]*)\)/$1&ComputeTotal\("$2"\)/og;
+ }
+ $v =~ s/([^a-zA-Z_\-]?)bytes\s*\(\s*/$1&NiceByte\(/og;
+ $v =~ s/([^a-zA-Z_\-]?)time\s*\(\s*/$1&second2time\(/og;
+ $v =~ s/([^a-zA-Z_\-]?)time_ms\s*\(\s*/$1&ms2time\(/og;
+ # $v =~ s/([\$\%\@])/$1${CLASS}\:\:/og;
+ $v =~ s/([\$\%\@])([^{\s\d])/$1${CLASS}\:\:$2/og;
+ $v =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|sec_glob|num)/$1$2/og;
+ my $r;
+ # eval { local $^W = 0; no strict; ($r) = eval $v; };
+ eval " local \$^W = 0; no strict; (\$r) = $v; ";
+ $r = 0 unless defined $r;
+ $r;
+}
+
+sub NiceByte {
+ my $size = shift;
+ my $t;
+
+ $size = 0 unless defined $size;
+ $t = $size / 1024 / 1024 / 1024 > 1 ?
+ sprintf "%.1f GB", $size / 1024 / 1024 / 1024 :
+ ($size / 1024 / 1024 > 1 ? sprintf "%.1f MB", $size / 1024 / 1024 :
+ sprintf "%.1f KB", $size / 1024);
+ return $t;
+}
+
+sub kb2i {
+ my $s = shift;
+ my ($i, $u) = $s =~ m/^(\S+) (\S+)$/;
+ $i *= 1024 * 8 if $u =~ m/MB/o;
+ $i *= 1024 * 1024 * 8 if $u =~ m/GB/o;
+ return $i;
+}
+
+sub Decode_Config_File {
+ my $file = shift;
+ my ($line, $section);
+ my $linenum = 0;
+ my $info;
+ my @list;
+ open (FILE, "$file") || die "Can\'t open config file \"$file\". Abort.\n";
+ while (defined ($line = <FILE>)) {
+ $linenum++;
+ last if eof (FILE);
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be 'section' instead of '$info'\n"
+ unless ($info eq 'section');
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: invalid section name '$info'\n"
+ unless $info =~ /^\w+$/;
+ print "section $info {\n" if $DEBUG;
+ $section = $info;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a '{' instead of '$info'\n"
+ unless ($info eq '{');
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ push @list, $section;
+ while ($info ne '}') { # it is a block
+ last if eof (FILE);
+ my $keyword = $info;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ my $value = $info;
+ if ($info eq '{') { # it is a sub-block
+ my @a;
+ $output{$section}{$keyword} = \@a unless $output{$section}{$keyword};
+ my %hash;
+ print "\t$keyword {\n" if $DEBUG;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ my @sublist; # to store the "data" blocks
+
+ while ($info ne '}') {
+ last if eof (FILE);
+ my $subkeyword = $info;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ my $subvalue = $info;
+ if ($info eq '{') {
+ # it is a sub-sub-block
+ my %subhash;
+ print "\t\t$subkeyword {\n" if $DEBUG;
+ my @b;
+ $hash{$subkeyword} = \@b unless ${hash}{$subkeyword};
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ while ($info ne '}') {
+ last if eof (FILE);
+ my $subsubkeyword = $info;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ my $subsubvalue = $info;
+ if ($info eq '{') {
+ die "Error in $file line $linenum: too many blocks.\n";
+ }
+ else {
+ ($info, $linenum, $line) =
+ &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a ';' instead " .
+ "of '$info'\n" unless ($info eq ';');
+ print "\t\t\t$subsubkeyword\t$subsubvalue;\n" if $DEBUG;
+ $subhash{$subsubkeyword} = $subsubvalue;
+ ($info, $linenum, $line) =
+ &read_conf ($linenum, $line, \*FILE);
+ }
+ }
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a ';' instead of " .
+ "'$info'\n" unless $info eq ';';
+ push @{$hash{$subkeyword}} , \%subhash;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ print "\t\t};\n" if $DEBUG;
+ }
+ else {
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a ';' instead " .
+ "of '$info'\n" unless $info eq ';';
+ print "\t\t$subkeyword\t$subvalue;\n" if $DEBUG;
+ $hash{$subkeyword} = $subvalue;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ }
+ }
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
+ unless $info eq ';';
+ push @{$output{$section}{$keyword}}, \%hash;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ print "\t};\n" if $DEBUG;
+ }
+ else {
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
+ unless $info eq ';';
+ print "\t$keyword\t$value;\n" if $DEBUG;
+ $output{$section}{$keyword} = $value;
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ }
+ }
+ die "Error in $file line $linenum: must be a '}' instead of '$info'\n"
+ unless $info eq '}';
+ ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
+ die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
+ unless $info eq ';';
+ print "};\n\n" if $DEBUG;
+ }
+ close FILE;
+ $output{'_order_'} = \@list;
+}
+
+sub read_conf {
+ my ($linenum, $line, $file) = @_;
+ *FILE = *$file;
+
+ $line =~ s,^\s+,,o; # remove useless blanks
+ $line =~ s,^(\#|//).*$,,o; # remove comments (at the beginning)
+ while (($line =~ m/^$/o || $line =~ m/^\"[^\"]*$/o) && !(eof (FILE))) {
+ $line .= <FILE>; # read one line
+ $linenum++;
+ $line =~ s,^\s*,,om; # remove useless blanks
+ $line =~ s,^(\#|//).*$,,om; # remove comments (at the beginning)
+ }
+ $line =~ s/^( # at the beginning
+ [{};] # match '{', '}', or ';'
+ | # OR
+ \" # a double quoted string
+ (?:\\.|[^\"\\])*
+ \"
+ | # OR
+ [^{};\"\s]+ # a word
+ )\s*//mox;
+ my $info = $1;
+ if (defined $info && $info) {
+ chomp $info;
+ }
+ else {
+ warn "Syntax error in conf file line $linenum.\n";
+ }
+ return ($info, $linenum, $line);
+}
+
+sub GetValue {
+ my $v = shift;
+ my ($r) = $v =~ m/^(?:\"\s*)?(.*?)(?:\s*\")?$/so;
+ return $r;
+}
+
+sub Usage {
+ my ($base) = $0 =~ /([^\/]+)$/;
+ print "Usage: $base -f innreport.conf [-[no]options]\n";
+ print " where options are:\n";
+ print " -h (or -help) this help page\n";
+ print " -v display the version number of INNreport\n";
+ print " -config print INNreport configuration information\n";
+ print " -html HTML output";
+ print " [default]" if ($HTML);
+ print "\n";
+ print " -g want graphs";
+ print " [default]" if ($GRAPH);
+ print "\n";
+ print " -graph an alias for option -g\n";
+ print " -d directory directory for Web pages";
+ print "\n [default=$HTML_dir]"
+ if (defined ($HTML_dir));
+ print "\n";
+ print " -dir directory an alias for option -d\n";
+ print " -p directory pictures path (file space)";
+ print "\n [default=$IMG_dir]"
+ if (defined ($IMG_dir));
+ print "\n";
+ print " -path directory an alias for option -p\n";
+ print " -w directory pictures path (web space)";
+ print " [default=$IMG_pth]" if (defined ($IMG_pth));
+ print "\n";
+ print " -webpath directory an alias for option -w\n";
+ print "\n";
+ print " -i file Name of index file";
+ print " [default=$index]" if (defined ($index));
+ print "\n";
+ print " -index file an alias for option -i\n";
+ print " -a want to archive HTML results";
+ print " [default]" if ($ARCHIVE);
+ print "\n";
+ print " -archive an alias for option -a\n";
+ print " -c number how many report files to keep (0 = all)\n";
+ print " [default=$CYCLE]"
+ if (defined ($CYCLE));
+ print "\n";
+ print " -cycle number an alias for option -c\n";
+ print " -s char separator for filename";
+ print " [default=\"$SEPARATOR\"]\n";
+ print " -separator char an alias for option -s\n";
+ print " -unknown \"Unknown entries from news log file\"\n";
+ print " report";
+ print " [default]" if ($WANT_UNKNOWN);
+ print "\n";
+ print " -html-unknown Same as above, but in generated HTML output.";
+ print " [default]" if ($WANT_UNKNOWN);
+ print "\n";
+ print " -maxunrec Max number of unrecognized lines to display\n";
+ print " [default=$MAX_UNRECOGNIZED]"
+ if (defined ($MAX_UNRECOGNIZED));
+ print "\n";
+ print " -notdaily Never perform daily actions";
+ print " [default]" if $NOT_DAILY;
+ print "\n";
+ print " -casesensitive Case sensitive";
+ print " [default]" if ($CASE_SENSITIVE);
+ print "\n\n";
+ print "Use no in front of boolean options to unset them.\n";
+ print "For example, \"-html\" is set by default. Use \"-nohtml\" to remove this\n";
+ print "feature.\n";
+ exit 0;
+}
+
+sub Version {
+ print "\nThis is INNreport version $version\n\n";
+ print "Copyright 1996-1999, Fabien Tassin <fta\@sofaraway.org>\n";
+ exit 0;
+}
+
+sub Summary {
+ use Config;
+
+ # Convert empty arguments into null string ("")
+ my $i = 0;
+ foreach (@old_argv) {
+ $old_argv[$i] = '""' if $_ eq '';
+ $i++;
+ }
+
+ # Display the summary
+ print "\nSummary of my INNreport (version $version) configuration:\n";
+ print " General options:\n";
+ print " command line='@old_argv' (please, check this value)\n";
+ print " html=" . ($HTML?"yes":"no") . ", graph=" .
+ ($GRAPH?"yes":"no") . ", haveGD=" .
+ ($::HAVE_GD?"yes":"no") . "\n";
+ print " archive=" . ($ARCHIVE?"yes":"no") .
+ ", cycle=$CYCLE, separator=\"" . $SEPARATOR . "\"\n";
+ print " case_sensitive=" .
+ ($CASE_SENSITIVE?"yes":"no") . ", want_unknown=" .
+ ($WANT_UNKNOWN?"yes":"no") .
+ ", max_unrecog=$MAX_UNRECOGNIZED\n";
+ print " Paths:\n";
+ print " html_dir=$HTML_dir\n";
+ print " img_dir=$IMG_dir\n";
+ print " img_pth=$IMG_pth\n";
+ print " index=$index\n";
+ print " Platform:\n";
+ print " perl version $::Config{baserev} "
+ . "patchlevel $::Config{patchlevel} "
+ . "subversion $::Config{subversion}\n";
+ print " libperl=$::Config{libperl}, useshrplib=$::Config{useshrplib}, "
+ . "bincompat3=$::Config{bincompat3}\n";
+ print " osname=$::Config{osname}, osvers=$::Config{osvers}, "
+ . "archname=$::Config{archname}\n";
+ print " uname=$::Config{myuname}\n\n";
+
+ exit 0;
+}
+
+######################### End of File ##########################
~ian / innduct.git / blobdiff