#! /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'}{'img_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 ##########################