X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=.pc%2Fu_innreport_misc%2Fscripts%2Finnreport.in;fp=.pc%2Fu_innreport_misc%2Fscripts%2Finnreport.in;h=0000000000000000000000000000000000000000;hb=68584e5e9b07131d5a4a87f22e65ce0f13d71d58;hp=334f7488f2c6e20371a27401ea3b08d0658576ca;hpb=7eb24bdbe5b00aa5cf0198f7877f1e5f729c7b2c;p=innduct.git diff --git a/.pc/u_innreport_misc/scripts/innreport.in b/.pc/u_innreport_misc/scripts/innreport.in deleted file mode 100644 index 334f748..0000000 --- a/.pc/u_innreport_misc/scripts/innreport.in +++ /dev/null @@ -1,2598 +0,0 @@ -#! /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: -# -# 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 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 = ; - 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 = ; - 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 () { - 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 < - -$Title: index - -$HTML_header -
-
-$title - archives -
-
-

-

-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 .= "\"Graph\"\n"; - $i++; - } - $result .= "

\n"; - } - $i = 0; - $result .= ""; - 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 "", $#list + 1; - } - else { - $result .= ""; - } - foreach (@list) { - $temp .= ""; - } - $i++; - } - $result .= "\n$temp\n"; - - $i = 0; - foreach (sort {$b cmp $a} (keys %data)) { - if ($CYCLE == 0 || $i < $CYCLE) { - my @list = split /\|/, $data{$_}; - my $str = ""; - while (@list) { - $str .= ""; - } - $str .= "\n"; - $result .= "$str"; - } - $i++; - } - $result .= "
$title$title$_
"; - $str .= "" if -e "$rep/$_"; - $str .= shift @list; - $str .= "" if -e "$rep/$_";; - $str .= ""; - my $t = shift @list; - $t =~ s/^\0+//o; # remove garbage, if any. - $str .= "$t
\n

\n

"; - $result .= "innreport $version (c) 1996-1999 "; - $result .= "by Fabien Tassin <"; - $result .= "fta\@sofaraway.org>.\n"; - if (defined ($output{'default'}{'footer'})) { - my ($t) = $output{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o; - $t =~ s/\\\"/\"/go; - $result .= "
" . $t; - } - $result .= "$HTML_footer\n\n\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; - 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 "\n" . - "\n\n$Title: $first_date\n" . - "\n\n\n" . - "$HTML_header\n

$title

\n" . - "

$first_date -- $last_date

\n
\n

\n"; - - # Index - print HTML "

    \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 "
  • $string\n" if %data && $want; - } - print HTML "

\n"; - } - if (@unrecognize && $WANT_UNKNOWN) { - my $mm = $#unrecognize; - print HTML "" if $HTML && $WANT_HTML_UNKNOWN; - print "Unknown entries from news log file:\n"; - print HTML "Unknown entries from news log file:

\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%%)
\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; - print HTML "$unrecognize[$l]
\n"; - } - } - print "\n"; - print HTML "

\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 <fta\@sofaraway.org>. -EOT - if (defined $$h{'default'}{'footer'}) { - my ($t) = $$h{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o; - $t =~ s/\\\"/\"/go; - print HTML "
" . $t; - } - print HTML "\n$HTML_footer"; - printf HTML "\n", second2time(time - $start_time); - print HTML "\n\n\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 ""; - my $html = $t; - $html =~ s/(:?)$/ [Top $TOP_HTML]$1/o if $TOP_HTML > 0; - $html =~ s|^(.*)$|$1|; - print HTML "$html\n

\n

\n\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 "", $v2; - } - $first++; - } - $s =~ s/\s*$//; - print "$s\n" if $TEXT; - $s = ''; - if ($HTML) { - print HTML "$html\n\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 .= ""; - } - else { - $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g; - $html .= $numbering ? "" : ''; - # unless $first; - $html .= sprintf "\n", $r; - $html .= ""; - } - } - } - else { - if ($wtext) { - $s .= " " if $first == 1; - $s .= sprintf $v1 . " ", $r; - } - if ($HTML && $whtml) { - $html .= $numbering ? "" : '' if $first == 1; - $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g; - my $temp = $first > 1 ? "RIGHT" : "LEFT"; - $html .= sprintf "", $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 "$html\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 .= "" if $HTML; - $html .= "" 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|(.*)|$1|o unless $first > 1; - $html .= sprintf "", $r; - } - $first++; - } - $s =~ s/\s*$//; - $s =~ s/\\n//g; - print "$s\n" if $TEXT; - print HTML "$html\n" if $HTML; - } - } - print "\n" if $TEXT; - print HTML "\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|(.*)|$1|o unless $first; - $html .= $first == 1 ? "" : - sprintf "", $r; - } - $first++; - } - $s =~ s/\s*$//; - $s =~ s/\\n//g; - print "$s\n" if $TEXT; - print HTML "$html\n
$v1
$num_d$v1
$v1
$v1
$v1
\n
\n

\n

\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 .= "$num" if $numbering && !$first; - my $temp = $first ? "RIGHT" : "LEFT"; - $html .= sprintf "$v1", $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 "$html\n"; - $html = ''; - } - } - print "\n" if $TEXT; - print HTML "\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|(.*)|$1|o unless $first; - $html .= sprintf "$v1", $r; - } - $first++; - } - $s =~ s/\s*$//; - print "$s\n" if $TEXT; - if ($HTML) { - print HTML "$html\n"; - print HTML "\n

\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 "

\"$title\"> $HTML_output") || - die "Error: cant open $HTML_output\n"; - print HTML "WIDTH=\"$xmax\" HEIGHT=\"$y\" "; - print HTML "SRC=\"$IMG_pth$report$s.$GD_FORMAT\">
\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 "
\"$title\"
\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 "

\n"; - } - print HTML "\n

\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 = )) { - $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 .= ; # 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 \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 ##########################