.pc/u_innreport_misc/scripts/innreport.in

   1 #! /usr/bin/perl
   2 # fixscript will replace this line with require innshellvars.pl
   3
   4 ##########################################################################
   5 #
   6 #   innreport: Perl script to summarize news log files
   7 #              (with optional HTML output and graphs).
   8 #
   9 # version: 3.0.2
  10 #
  11 # Copyright (c) 1996-1999, Fabien Tassin (fta@sofaraway.org).
  12 #
  13 ##########################################################################
  14 #
  15 # Usage: innreport -f config_file [-[no]options] logfile [logfile2 [...]]
  16 #   where options are:
  17 #     -h (or -help)      : this help page
  18 #     -html              : HTML output
  19 #     -v                 : display the version number of INNreport
  20 #     -f config_file     : name of the configuration file
  21 #     -config            : print INNreport configuration information
  22 #     -g                 : want graphs [default]
  23 #     -graph             : an alias for option -g
  24 #     -d directory       : directory for Web pages
  25 #     -dir directory     : an alias for option -d
  26 #     -p directory       : pictures path (file space)
  27 #     -path directory    : an alias for option -p
  28 #     -w directory       : pictures path (web space)
  29 #     -webpath directory : an alias for option -w
  30 #     -i                 : name of index page
  31 #     -index             : an alias for option -i
  32 #     -a                 : want to archive HTML results
  33 #     -archive           : an alias for option -a
  34 #     -c number          : how many report files to keep (0 = all)
  35 #     -cycle number      : an alias for option -c
  36 #     -s char            : separator for filename
  37 #     -separator char    : an alias for option -s
  38 #     -unknown           : Unknown entries from news log file
  39 #     -maxunrec          : Max number of unrecognized line to display
  40 #     -casesensitive     : Case sensitive
  41 #     -notdaily          : Never perform daily actions
  42 #
  43 # Use no in front of boolean options to unset them.
  44 # For example, "-html" is set by default. Use "-nohtml" to remove this
  45 # feature.
  46 #
  47 ##########################################################################
  48 #
  49 # ABSOLUTELY NO WARRANTY WITH THIS PACKAGE. USE IT AT YOUR OWN RISKS.
  50 #
  51 # Note: You need the Perl graphic library GD.pm if you want the graphs.
  52 #       GD is available on all good CPAN ftp sites:
  53 #           ex: [CPAN_DIR]/authors/id/LDS/GD-1.1_.tar.gz (or greater)
  54 #         or directly to:
  55 #           <URL:http://www-genome.wi.mit.edu/pub/software/WWW/GD.html>
  56 #       Note : innreport will create PNG or GIF files depending upon
  57 #              the GD version.
  58 #
  59 # Documentation: for a short explaination of the different options, you
  60 #        can read the usage (obtained with the -h or -help switch).
  61 #
  62 # Install: - check the Perl location (first line). Require Perl 5.002
  63 #            or greater.
  64 #          - look at the parameters in the configuration file (section
  65 #            'default')
  66 #          - copy the configuration file into ${PATHETC}/innreport.conf
  67 #          - copy the INN module into ${PATHETC}/innreport_inn.pm
  68 #          - copy this script into ${PATHETC}/innreport
  69 #          - be sure that the news user can run it (chmod 755 or 750)
  70 #          - in "scanlog", comment the line containing innlog and add:
  71 #            ${PATHETC}/innreport -f ${PATHETC}/innreport.conf ${OLD_SYSLOG}
  72 #            or, if you want to change some options:
  73 #    ${PATHETC}/innreport -f ${PATHETC}/innreport.conf options ${OLD_SYSLOG}
  74 #
  75 # Report: please report bugs (preferably) to the INN mailing list
  76 #         (see README) or directly to the author (do not forget to
  77 #         include the result of the "-config" switch, the parameters
  78 #         passed on the command line and the INN version).
  79 #         Please also report unknown entries.
  80 #         Be sure your are using the latest version of this script before
  81 #         any report.
  82 #
  83 ##########################################################################
  84
  85 # Note: References to <ftp://ftp.sofaraway.org/pub/innreport/> have been
  86 # removed from the output because this site appears to no longer exist.  It
  87 # used to be the upstream source for innreport.  If there is a new site for
  88 # innreport releases, please notify the INN maintainers.
  89
  90 # remember to add '-w' on the first line and to uncomment the 'use strict'
  91 # below before doing any changes to this file.
  92
  93 use strict;
  94
  95 ## Do you want to create a Web page. Pick DO or DONT.
  96 my $HTML = "DO";
  97
  98 ## Do you want the graphs (need $HTML too). Pick DO or DONT.
  99 my $GRAPH = "DO";
 100
 101 ## Directory for the Web pages (used only if the previous line is active)
 102 my $HTML_dir = "$inn::pathhttp";
 103
 104 ## Directory for the pictures (need HTML support) in the file space
 105 my $IMG_dir = "$HTML_dir/pics";
 106
 107 ## Directory for the pictures (need HTML support) in the Web space
 108 ## (can be relative or global)
 109 my $IMG_pth = "pics";
 110
 111 ## Do you want to archive HTML results (& pics) [ will add a date in each
 112 ## name ]. Pick DO or DONT.
 113 my $ARCHIVE = "DO";
 114
 115 ## index page will be called:
 116 my $index = "index.html";
 117
 118 ## How many report files to keep (0 = all) (need $ARCHIVE).
 119 my $CYCLE = 0;
 120
 121 ## separator between hours-minutes-seconds in filenames
 122 ## (normaly a ":" but some web-browsers (Lynx, MS-IE, Mosaic) can't read it)
 123 ## Warning: never use "/". Use only a _valid_ filename char.
 124 my $SEPARATOR = ".";
 125
 126 ## Do you want the "Unknown entries from news log file" report. Pick DO or
 127 ## DONT.
 128 my $WANT_UNKNOWN = "DO";
 129
 130 ## Max number of unrecognized lines to display (if $WANT_UNKNOWN)
 131 ## (-1 = no limit)
 132 my $MAX_UNRECOGNIZED = 50;
 133
 134 ## Do you want to be case sensitive. Pick DO or DONT.
 135 my $CASE_SENSITIVE = "DO";
 136
 137 ## Some actions must only be performed daily (once for a log file).
 138 ## (ex: unwanted.log with INN). Default value (DONT) means to perform
 139 ## these actions each . Pick DO or DONT.
 140 my $NOT_DAILY = "DONT";
 141
 142 ###############################################
 143 ## THERE'S NOTHING TO CHANGE AFTER THIS LINE ##
 144 ###############################################
 145
 146 my $version = "3.0.2";
 147 my %output; # content of the configuration file.
 148 my $DEBUG = 0; # set to 1 to verify the structure/content of the conf file.
 149 my $start_time = time;
 150
 151 # Require Perl 5.002 or greater.
 152 require 5.002;
 153 use Getopt::Long;
 154 use vars qw/$HAVE_GD $GD_FORMAT/;
 155
 156 my @old_argv = @ARGV;
 157
 158 # Convert DO/DONT into boolean values.
 159 {
 160   my $i;
 161   foreach $i (\$HTML, \$GRAPH, \$ARCHIVE, \$WANT_UNKNOWN,
 162               \$CASE_SENSITIVE, \$NOT_DAILY) {
 163     $$i = $$i eq 'DO' ? 1 : 0 ;
 164   }
 165 }
 166
 167 my %ref;
 168 GetOptions (\%ref,
 169            qw(-h -help
 170               -html!
 171               -config
 172               -f=s
 173               -g! -graph!
 174               -d=s -dir=s
 175               -p=s -path=s
 176               -w=s -webpath=s
 177               -i=s -index=s
 178               -a! -archive!
 179               -c=i -cycle=i
 180               -s=s -separator=s
 181               -unknown!
 182               -html-unknown!
 183               -maxunrec=i
 184               -casesensitive!
 185               -notdaily!
 186               -v
 187               ));
 188
 189 &Version if $ref{'v'};
 190
 191 &Decode_Config_File($ref{'f'}) if defined $ref{'f'};
 192 &Usage if $ref{'h'} || $ref{'help'} || !defined $ref{'f'};
 193
 194 $HTML = 0 if defined $output{'default'}{'html'};
 195 $HTML = 1 if $output{'default'}{'html'} eq 'true';
 196 $HTML = 0 if defined $ref{'html'};
 197 $HTML = 1 if $ref{'html'};
 198
 199 $GRAPH = 0 if defined $output{'default'}{'graph'};
 200 $GRAPH = 1 if $HTML && ($output{'default'}{'graph'} eq 'true');
 201 $GRAPH = 0 if defined $ref{'g'} || defined $ref{'graph'};
 202 $GRAPH = 1 if $HTML && ($ref{'g'} || $ref{'graph'});
 203
 204 $HTML_dir = &GetValue ($output{'default'}{'html_dir'})
 205   if defined $output{'default'}{'html_dir'};
 206 $HTML_dir = $ref{'d'} if defined $ref{'d'};
 207 $HTML_dir = $ref{'dir'} if defined $ref{'dir'};
 208
 209 $IMG_pth = &GetValue ($output{'default'}{'img_dir'})
 210   if defined $output{'default'}{'img_dir'};
 211 $IMG_pth = $ref{'w'} if defined $ref{'w'};
 212 $IMG_pth = $ref{'webpath'} if defined $ref{'webpath'};
 213
 214 $IMG_dir = $HTML_dir . "/" . $IMG_pth
 215   if (defined $output{'default'}{'html_dir'} ||
 216        defined $ref{'w'} || defined $ref{'webpath'})
 217       &&
 218       (defined $output{'default'}{'html_dir'} ||
 219        defined $ref{'d'} || defined $ref{'dir'});
 220
 221 $IMG_dir = $ref{'p'} if defined $ref{'p'};
 222 $IMG_dir = $ref{'path'} if defined $ref{'path'};
 223
 224 $index = &GetValue ($output{'default'}{'index'})
 225   if defined $output{'default'}{'index'};
 226 $index = $ref{'i'} if defined $ref{'i'};
 227 $index = $ref{'index'} if defined $ref{'index'};
 228
 229 $ARCHIVE = &GetValue ($output{'default'}{'archive'})
 230   if defined $output{'default'}{'archive'};
 231 $ARCHIVE = $ARCHIVE eq 'true';
 232 $ARCHIVE = 0 if defined $ref{'a'} || defined $ref{'archive'};
 233 $ARCHIVE = 1 if ($ref{'a'} || $ref{'archive'}) && $HTML;
 234 $ARCHIVE = 0 unless $HTML;
 235
 236 $CYCLE = &GetValue ($output{'default'}{'cycle'})
 237   if defined $output{'default'}{'cycle'};
 238 $CYCLE = 0 if $CYCLE eq 'none';
 239 $CYCLE = $ref{'c'} if defined $ref{'c'};
 240 $CYCLE = $ref{'cycle'} if defined $ref{'cycle'};
 241
 242 $SEPARATOR = &GetValue ($output{'default'}{'separator'})
 243   if defined $output{'default'}{'separator'};
 244 $SEPARATOR = $ref{'s'} if defined $ref{'s'};
 245 $SEPARATOR = $ref{'separator'} if defined $ref{'separator'};
 246
 247 if (defined $output{'default'}{'unknown'}) {
 248   $WANT_UNKNOWN = &GetValue ($output{'default'}{'unknown'});
 249   $WANT_UNKNOWN = $WANT_UNKNOWN eq 'true' ? 1 : 0;
 250 }
 251 $WANT_UNKNOWN = 0 if defined $ref{'unknown'};
 252 $WANT_UNKNOWN = 1 if $ref{'unknown'};
 253
 254 my $WANT_HTML_UNKNOWN = $WANT_UNKNOWN;
 255 if (defined $output{'default'}{'html-unknown'}) {
 256   $WANT_HTML_UNKNOWN = &GetValue ($output{'default'}{'html-unknown'});
 257   $WANT_HTML_UNKNOWN = $WANT_HTML_UNKNOWN eq 'true' ? 1 : 0;
 258 }
 259 $WANT_HTML_UNKNOWN = 0 if defined $ref{'html-unknown'};
 260 $WANT_HTML_UNKNOWN = 1 if $ref{'html-unknown'};
 261
 262 $NOT_DAILY = 0 if defined $ref{'notdaily'};
 263 $NOT_DAILY = 1 if $ref{'notdaily'};
 264
 265 $MAX_UNRECOGNIZED = &GetValue ($output{'default'}{'max_unknown'})
 266   if defined $output{'default'}{'max_unknown'};
 267 $MAX_UNRECOGNIZED = $ref{'maxunrec'} if defined ($ref{'maxunrec'});
 268
 269 $CASE_SENSITIVE = &GetValue ($output{'default'}{'casesensitive'})
 270   if defined $output{'default'}{'casesensitive'};
 271 $CASE_SENSITIVE = 1 if $CASE_SENSITIVE eq 'true';
 272 $CASE_SENSITIVE = 0 if defined $ref{'casesensitive'};
 273 $CASE_SENSITIVE = 1 if $ref{'casesensitive'};
 274
 275 my $CLASS   = &GetValue ($output{'default'}{'module'});
 276 my $LIBPATH = &GetValue ($output{'default'}{'libpath'});
 277
 278 umask 022;
 279
 280 BEGIN {
 281   eval "use GD;";
 282   $HAVE_GD = $@ eq '';
 283   if ($HAVE_GD) {
 284     my $gd = new GD::Image(1,1);
 285     $GD_FORMAT = "gif" if $gd->can('gif');
 286     $GD_FORMAT = "png" if $gd->can('png');
 287   }
 288   $HAVE_GD;
 289 };
 290 undef $GRAPH unless $HTML;
 291 if ($GRAPH && !$::HAVE_GD) {
 292   print "WARNING: can't make graphs as required.\n" .
 293         "         Install GD.pm or disable this option.\n\n";
 294   undef $GRAPH;
 295 }
 296
 297 if ($HTML) {
 298   if ($GRAPH) {
 299     $IMG_dir = "." if defined $IMG_dir && $IMG_dir eq '';
 300     $IMG_pth .= "/" if $IMG_pth;
 301     $IMG_pth =~ s|/+|/|g;
 302     $IMG_dir =~ s|/+|/|g;
 303     unless (-w $IMG_dir) {
 304       print "WARNING: can't write in \"$IMG_dir\" as required by -g " .
 305         "switch.\n         Option -g removed. Please see the -p switch.\n\n";
 306       undef $GRAPH;
 307     }
 308   }
 309   $HTML_dir = "." if defined $HTML_dir && $HTML_dir eq '';
 310   unless (-w $HTML_dir) {
 311     print "WARNING: can't write in \"$HTML_dir\" as required by -html " .
 312       "switch.\n         Option -html and -a removed. Please see the " .
 313       "-d switch.\n\n";
 314     undef $HTML;
 315     $ARCHIVE = 0;
 316   }
 317 }
 318
 319 # Now, we are sure that HTML and graphs can be made if options are active.
 320 &Summary if defined $ref{'config'};
 321
 322 my $unrecognize_max = 0;
 323 my @unrecognize;
 324 my ($total_line, $total_size) = (0, 0);
 325 my ($suffix, $HTML_output, %config, $first_date, $last_date,
 326     %prog_type, %prog_size);
 327
 328 my $HTML_header = '';
 329 my $HTML_footer = '';
 330
 331 my $MIN = 1E10;
 332 my $MAX = -1;
 333
 334 my $xmax = &GetValue ($output{'default'}{'graph_width'})   # Graph size..
 335   if defined $output{'default'}{'graph_width'};
 336 $xmax = 550 unless $xmax;
 337
 338 my $transparent = &GetValue ($output{'default'}{'transparent'})
 339   if defined $output{'default'}{'transparent'};
 340 $transparent = (defined $transparent && $transparent eq 'true') ? 1 : 0;
 341
 342 my $repeated = 1;
 343
 344 my $first_date_cvt = $MIN;
 345 my $last_date_cvt = $MAX;
 346
 347
 348 #########################################################################
 349 my $s = sprintf "use lib qw($LIBPATH); use $CLASS;";
 350 eval $s;  # initialization
 351 die "Can't find/load $CLASS.pm : $@\n" if $@;
 352
 353 my $save_line = <>;
 354 $_ = $save_line;
 355 local $^W = 0 if $] < 5.004; # to avoid a warning for each '+=' first use.
 356 LINE: while (!eof ()) {
 357   $total_line++;
 358   my $size = length;
 359   $total_size += $size;
 360
 361   # Syslog optimization
 362   if ($repeated) {
 363     $repeated--;
 364     $_ = $save_line;
 365   }
 366   else {
 367     $_ = <>;
 368     if ($_ =~ /last message repeated (\d+) times?$/o) {
 369        $repeated = $1;
 370        $_ = $save_line;
 371     }
 372     else {
 373        $save_line = $_;
 374     }
 375   }
 376
 377   # skip empty lines
 378   next LINE if $_ eq '';
 379
 380   my $res;
 381   my ($day, $hour, $prog, $left) =
 382     $_ =~ m/^(\S+\s+\S+) (\S+) \S+ (\S+): \[ID \d+ \S+\] (.*)$/o;
 383   ($day, $hour, $prog, $left) =
 384     $_ =~ m/^(\S+\s+\S+) (\S+) \S+ (\S+): (.*)$/o unless $day;
 385   ($day, $hour, $prog, $left) =
 386     $_ =~ m/^(\S+\s+\S+) (\S+) \d+ \S+ (\S+): (.*)$/o unless $day;
 387
 388   unless ($day) {
 389     ($day, $hour, $res, $left) = $_ =~ m/^(\S+\s+\S+) (\S+)\.\d+ (\S+) (.*)$/o;
 390     if ($day) {
 391       my $cvtdate = &ConvDate ("$day $hour");
 392       if ($cvtdate < $first_date_cvt) {
 393         $first_date_cvt = $cvtdate;
 394         $first_date = "$day $hour";
 395       }
 396       elsif ($cvtdate > $last_date_cvt) {
 397         $last_date_cvt = $cvtdate;
 398         $last_date = "$day $hour";
 399       }
 400       $prog = "inn";
 401     }
 402     else {
 403       next if $_ =~ /^$/;
 404       # Unrecognize line... skip
 405       $unrecognize[$unrecognize_max] = $_
 406         unless $unrecognize_max > $MAX_UNRECOGNIZED
 407                 && $MAX_UNRECOGNIZED > 0;
 408       $unrecognize_max++;
 409       next LINE;
 410     }
 411   }
 412   else {
 413     my $cvtdate = &ConvDate ("$day $hour");
 414     if ($cvtdate < $first_date_cvt) {
 415       $first_date_cvt = $cvtdate;
 416       $first_date = "$day $hour";
 417     }
 418     elsif ($cvtdate > $last_date_cvt) {
 419       $last_date_cvt = $cvtdate;
 420       $last_date = "$day $hour";
 421     }
 422   }
 423
 424   ########
 425   ## Program name
 426   # word[7164] -> word
 427   my ($pid) = $prog =~ s/\[(\d+)\]$//o;
 428   # word: -> word
 429   $prog =~ s/:$//o;
 430   # wordX -> word   (where X is a digit)
 431   $prog =~ s/\d+$//o;
 432
 433   $prog_type{$prog}++;
 434   $prog_size{$prog} = 0 unless defined $prog_size{$prog}; # stupid warning :(
 435   $prog_size{$prog} += $size;
 436
 437   # The "heart" of the tool.
 438   {
 439     no strict;
 440     next LINE if
 441       &{$CLASS."::collect"} ($day, $hour, $prog, $res, $left, $CASE_SENSITIVE);
 442   }
 443
 444   $unrecognize[$unrecognize_max] = $_
 445     unless $unrecognize_max > $MAX_UNRECOGNIZED
 446             && $MAX_UNRECOGNIZED > 0;
 447   $unrecognize_max++;
 448 }
 449
 450 {
 451   no strict;
 452   &{$CLASS . "::adjust"} ($first_date, $last_date);
 453 }
 454
 455 $| = 1;
 456
 457 die "no data. Abort.\n" unless $total_line;
 458
 459 my $sec_glob = &ConvDate ("$last_date") - &ConvDate ("$first_date");
 460 unless ($sec_glob) {
 461   print "WARNING: bad date (\"$last_date\" or \"$first_date\")\n" .
 462         "         Please, contact the author of innreport.\n";
 463   $sec_glob = 24 * 60 * 60; # one day
 464 }
 465
 466 $HTML_output = '';
 467
 468 if ($HTML) {
 469   # Create a new filename (unique and _sortable_)
 470   if ($ARCHIVE) {
 471     # The filename will contain the first date of the log or the current time.
 472     my ($ts, $tm, $th, $dd, $dm, $dy) = localtime;
 473     my ($m, $d, $h, $mn, $s) =
 474       $first_date =~ /^(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)$/;
 475     if ($m) {
 476       my $ddm = (index "JanFebMarAprMayJunJulAugSepOctNovDec", $m) / 3;
 477       # Adjust the year because syslog doesn't record it. We assume that
 478       # it's the current year unless the last date is in the future.
 479       my $ld = &ConvDate($last_date);
 480       $dy-- if $ld > $ts + 60 * ($tm + 60 * ($th + 24 * ($dd - 1 +
 481         substr("000031059090120151181212243273304334", $dm * 3, 3)))) ||
 482         $ld < &ConvDate($first_date);
 483       ($dm, $dd, $th, $tm, $ts) = ($ddm, $d, $h, $mn, $s);
 484     }
 485     $dm++; # because January = 0 and we prefer 1
 486     $dy += 100 if $dy < 90; # Try to pacify the year 2000 !
 487     $dy += 1900;
 488     $suffix = sprintf ".%02d.%02d.%02d-%02d$SEPARATOR%02d$SEPARATOR%02d",
 489                        $dy, $dm, $dd, $th, $tm, $ts;
 490   }
 491   else {
 492     $suffix = '';
 493   }
 494   $HTML_output = "$HTML_dir" . "/news-notice" . "$suffix" . ".html";
 495   $HTML_output =~ s|/+|/|g;
 496   if (defined $output{'default'}{'html_header_file'}) {
 497     my $file = &GetValue ($output{'default'}{'html_header_file'});
 498     $file = $HTML_dir . "/" . $file;
 499     open (F, $file) && do {
 500       local $/ = undef;
 501       $HTML_header = <F>;
 502       close F;
 503     };
 504   }
 505   if (defined $output{'default'}{'html_footer_file'}) {
 506     my $file = &GetValue ($output{'default'}{'html_footer_file'});
 507     $file = $HTML_dir . "/" . $file;
 508     open (F, $file) && do {
 509       local $/ = undef;
 510       $HTML_footer = <F>;
 511       close F;
 512     };
 513   }
 514 }
 515
 516 &Write_all_results ($HTML_output, \%output);
 517
 518 &Make_Index ($HTML_dir, $index, "news-notice$suffix.html", \%output)
 519   if $HTML && $index;
 520
 521 #====================================================================
 522
 523 if ($ARCHIVE) {
 524   # rotate html files
 525   &Rotate ($CYCLE, $HTML_dir, "news-notice", ".html");
 526
 527   # rotate pictures
 528   my $report;
 529   foreach $report (@{$output{'_order_'}}) {
 530     next if $report =~ m/^(default|index)$/;
 531     next unless defined $output{$report}{'graph'};
 532
 533     my $i = 0;
 534     while ($GRAPH && defined ${${$output{$report}{'graph'}}[$i]}{'type'}) {
 535       my $name = $report . ($i ? $i : '');
 536       &Rotate ($CYCLE, $IMG_dir, $name, '.' . $GD_FORMAT);
 537       $i++;
 538     }
 539   }
 540 }
 541
 542 # Code needed by INN only. It must be in innreport_inn.pm to keep things clean.
 543 if (!$NOT_DAILY && defined $output{'default'}{'unwanted_log'}) {
 544   my $logfile = &GetValue ($output{'default'}{'unwanted_log'});
 545   my $logpath = &GetValue ($output{'default'}{'logpath'});
 546   {
 547     no strict;
 548     &{$CLASS . "::report_unwanted_ng"} ("$logpath/$logfile");
 549   }
 550 }
 551
 552 ################
 553 # End of report.
 554 ###################################################################
 555
 556 ######
 557 # Misc...
 558
 559 # Compare 2 dates (+hour)
 560 sub DateCompare {
 561   # ex: "May 12 06"   for May 12, 6:00am
 562   local $[ = 0;
 563   # The 2 dates are near. The range is less than a few days that's why we
 564   # can cheat to determine the order. It is only important if one date
 565   # is in January and the other in December.
 566
 567   my $date1 = substr ($a, 4, 2) * 24;
 568   my $date2 = substr ($b, 4, 2) * 24;
 569   $date1 += index("JanFebMarAprMayJunJulAugSepOctNovDec",substr($a,0,3)) * 288;
 570   $date2 += index("JanFebMarAprMayJunJulAugSepOctNovDec",substr($b,0,3)) * 288;
 571   if ($date1 - $date2 > 300 * 24) {
 572     $date2 += 288 * 3 * 12;
 573   }
 574   elsif ($date2 - $date1 > 300 * 24) {
 575     $date1 += 288 * 3 * 12;
 576   }
 577   $date1 += substr($a, 7, 2);
 578   $date2 += substr($b, 7, 2);
 579   $date1 - $date2;
 580 }
 581
 582
 583 # Convert: seconds to hh:mm:ss
 584 sub second2time {
 585   my $temp;
 586   my $t = shift;
 587   # Hours
 588   $temp = sprintf "%02d", $t / 3600;
 589   my $chaine = "$temp:";
 590   $t %= 3600;
 591   # Min
 592   $temp = sprintf "%02d", $t / 60;
 593   $chaine .= "$temp:";
 594   $t %= 60;
 595   # Sec
 596   $chaine .= sprintf "%02d", $t;
 597   return $chaine;
 598 }
 599
 600 # Convert: milliseconds to hh:mm:ss:mm
 601 sub ms2time {
 602   my $temp;
 603   my $t = shift;
 604   # Hours
 605   $temp = sprintf "%02d", $t / 3600000;
 606   my $chaine = "$temp:";
 607   $t %= 3600000;
 608   # Min
 609   $temp = sprintf "%02d", $t / 60000;
 610   $chaine .= "$temp:";
 611   $t %= 60000;
 612   # Sec
 613   $temp = sprintf "%02d", $t / 1000;
 614   $chaine .= "$temp.";
 615   $t %= 1000;
 616   # Millisec
 617   $chaine .= sprintf "%03d", $t;
 618   return $chaine;
 619 }
 620
 621 # Rotate the archive files..
 622 sub Rotate {
 623   # Usage: &Rotate ($max_files, "$directory", "prefix", "suffix");
 624   my ($max, $rep, $prefix, $suffix) = @_;
 625   my ($file, $num, %files);
 626   local ($a, $b);
 627
 628   return 1 unless $max;
 629   opendir (DIR, "$rep") || die "Error: Cant open directory \"$rep\"\n";
 630
 631   FILE : while (defined ($file = readdir (DIR))) {
 632     next FILE
 633       unless $file =~ /^           # e.g. news-notice.1997.05.14-01:34:29.html
 634                         $prefix          # Prefix : news-notice
 635                         \.               # dot    : .
 636                         (\d\d)?\d\d      # Year   : 1997 (or 97)
 637                         \.               # dot    : .
 638                         \d\d             # Month  : 05
 639                         \.               # dot    : .
 640                         \d\d             # Day    : 14
 641                         -                # Separator : -
 642                         \d\d             # Hour   : 01
 643                         $SEPARATOR       # Separator : ":"
 644                         \d\d             # Minute : 34
 645                         $SEPARATOR       # Separator : ":"
 646                         \d\d             # Second : 29
 647                         $suffix          # Suffix : ".html"
 648                         $/x;
 649     $files{$file}++;
 650   }
 651   closedir DIR;
 652   $num = 0;
 653   foreach $file (sort {$b cmp $a} (keys (%files))) {
 654     unlink "$rep/$file" if $num++ >= $max && -f "$rep/$file";
 655   }
 656   return 1;
 657 }
 658
 659 # convert a date to a number of seconds
 660 sub ConvDate {
 661   # usage: $num = &ConvDate ($date);
 662   # date format is Aug 22 01:49:40
 663   my $T = shift;
 664   my ($m, $d, $h, $mn, $s) = $T =~ /^(\S+)\s+(\d+)\s+(\d+):(\d+):(\d+)$/;
 665   my $out = $s + 60 * $mn + 3600 * $h + 86400 * ($d - 1);
 666
 667   $m = substr("000031059090120151181212243273304334",
 668               index ("JanFebMarAprMayJunJulAugSepOctNovDec", $m), 3);
 669   $out += $m * 86400;
 670   return $out;
 671 }
 672
 673 # Compare 2 filenames
 674 sub filenamecmp {
 675   local $[ = 0;
 676   my ($la, $lb) = ($a, $b);
 677   my ($ya) = $la =~ m/news-notice\.(\d+)\./o;
 678   $ya += 100  if $ya < 90; # Try to pacify the year 2000 !
 679   $ya += 1900 if $ya < 1900; # xx -> xxxx
 680   my ($yb) = $lb =~ m/news-notice\.(\d+)\./o;
 681   $yb += 100  if $yb < 90; # Try to pacify the year 2000 !
 682   $yb += 1900 if $yb < 1900; # xx -> xxxx
 683
 684   $la =~ s/news-notice\.(\d+)\./$ya\./;
 685   $lb =~ s/news-notice\.(\d+)\./$yb\./;
 686   $la =~ s/[\.\-\:html]//g;
 687   $lb =~ s/[\.\-\:html]//g;
 688
 689   $lb <=> $la;
 690 }
 691
 692 sub ComputeTotal {
 693   my $h = shift;
 694   my $total = 0;
 695   my $key;
 696   foreach $key (keys (%$h)) {
 697     $total += $$h{$key};
 698   }
 699   $total;
 700 }
 701
 702 sub ComputeTotalDouble {
 703   my $h = shift;
 704   my $total = 0;
 705   my ($key1, $key2);
 706   foreach $key1 (keys (%$h)) {
 707     foreach $key2 (keys (%{$$h{$key1}})) {
 708       $total += ${$$h{$key1}}{$key2};
 709     }
 710   }
 711   $total;
 712 }
 713
 714 # make an index for archive pages
 715 sub Make_Index {
 716   my ($rep, $index, $filename, $data) = @_;
 717   my %output = %$data;
 718
 719   $index =~ s/^\"\s*(.*?)\s*\"$/$1/o;
 720
 721   # add requested data at the end of the database.
 722   open (DATA, ">> $rep/innreport.db") || die "can't open $rep/innreport.db\n";
 723   my $i = 0;
 724   my $res = "$filename";
 725   while (defined ${${$output{'index'}{'column'}}[$i]}{'value'}) {
 726     my $data = &GetValue (${${$output{'index'}{'column'}}[$i]}{'value'});
 727     $data =~ s/\n//sog;
 728     my @list = split /\|/, $data;
 729     my $val;
 730     foreach $val (@list) {
 731       $res .= ($val eq 'date' ? "|$first_date -- $last_date"
 732                               : "|" . &EvalExpr($val));
 733     }
 734     $i++;
 735   }
 736   print DATA "$res\n";
 737   close DATA;
 738
 739   # sort the database (reverse order), remove duplicates.
 740   open (DATA, "$rep/innreport.db") || die "can't open $rep/innreport.db\n";
 741   my %data;
 742   while (<DATA>) {
 743     m/^([^\|]+)\|(.*)$/o;
 744     $data{$1} = $2;
 745   }
 746   close DATA;
 747   open (DATA, "> $rep/innreport.db") || die "can't open $rep/innreport.db\n";
 748   $i = 0;
 749   foreach (sort {$b cmp $a} (keys %data)) {
 750     print DATA "$_|$data{$_}\n" if $CYCLE == 0 || $i < $CYCLE;
 751     $i++;
 752   }
 753   close DATA;
 754
 755   my $title = "Daily Usenet report";
 756   $title = &GetValue ($output{'default'}{'title'})
 757     if defined $output{'default'}{'title'};
 758   $title =~ s/\\\"/\"/g;
 759   my $Title = $title;
 760   $Title =~ s/<.*?>//g;
 761   my $body = '';
 762   $body = &GetValue ($output{'default'}{'html_body'})
 763     if defined $output{'default'}{'html_body'};
 764   $body =~ s/\\\"/\"/go;
 765   my $result = sprintf <<EOF;
 766 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
 767 <HTML><HEAD>
 768 <TITLE>$Title: index</TITLE>
 769 </HEAD><BODY $body>
 770 $HTML_header
 771 <HR ALIGN=CENTER SIZE=\"4\" WIDTH=\"100%%\">
 772 <BR><CENTER><FONT SIZE=\"+2\">
 773 <B>$title - archives</B>
 774 </FONT></CENTER>
 775 <BR CLEAR=ALL>
 776 <HR ALIGN=CENTER SIZE=4 WIDTH=\"100%%\"><P>
 777 <CENTER>
 778 EOF
 779
 780   if ($GRAPH) {
 781     my $i = 0;
 782     while (defined ${${$output{'index'}{'graph'}}[$i]}{'title'}) {
 783       my $title =  &GetValue (${${$output{'index'}{'graph'}}[$i]}{'title'});
 784       my $filename = "index$i.$GD_FORMAT";
 785       my $color_bg = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'color'});
 786       my $unit     = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'unit'});
 787       my $date_idx = &GetValue (${${$output{'index'}{'graph'}}[$i]}{'value'});
 788       $date_idx =~ s/^val(\d+)$/$1/o;
 789       my @c = @{${${$output{'index'}{'graph'}}[$i]}{'data'}};
 790       my $label_in  = &GetValue (${$c[0]}{'name'});
 791       my $color_in  = &GetValue (${$c[0]}{'color'});
 792       my $value_in  = &GetValue (${$c[0]}{'value'});
 793       my $type_in   = 0;
 794       $type_in = $value_in =~ s/^byte\((.*?)\)$/$1/o;
 795       $value_in =~ s/^val(\d+)$/$1/o;
 796       my $label_out = &GetValue (${$c[1]}{'name'});
 797       my $color_out = &GetValue (${$c[1]}{'color'});
 798       my $value_out = &GetValue (${$c[1]}{'value'});
 799       my $type_out   = 0;
 800       $type_out = $value_out =~ s/^byte\((.*?)\)$/$1/o;
 801       $value_out =~ s/^val(\d+)$/$1/o;
 802       my (%in, %out, %dates, $k);
 803       foreach $k (keys (%data)) {
 804         my @res = split /\|/, $data{$k};
 805         my ($year) = $k =~ m/^news-notice\.(\d+)\.\d+\.\d+-\d+.\d+.\d+\.html/;
 806         next unless $year; # bad filename.. strange.
 807         my ($start, $end) =
 808           $res[$date_idx - 1] =~ m/^(\w+\s+\d+ \S+) -- (\w+\s+\d+ \S+)$/o;
 809         next unless $start; # bad date
 810         $start = &ConvDate ($start);
 811         $end = &ConvDate ($end);
 812         # 31/12 - 1/1 ?
 813         my $inc = $end < $start ? 1 : 0;
 814         $start += (($year - 1970) * 365 +
 815                    int (($year - 1968) / 4)) * 3600 * 24;
 816         $year += $inc;
 817         $end += (($year - 1970) * 365 + int (($year - 1968) / 4)) * 3600 * 24;
 818         $in{$start} = $type_in ? &kb2i($res[$value_in - 1])
 819                                : $res[$value_in - 1];
 820         $out{$start} = $type_out ? &kb2i($res[$value_out - 1])
 821                                  : $res[$value_out - 1];
 822         $dates{$start} = $end;
 823       }
 824       my ($xmax, $ymax) = (500, 170);
 825       &Chrono ("$IMG_dir/$filename", $title, $color_bg, $xmax, $ymax,
 826                \%in, \%out, \%dates, $label_in, $label_out,
 827                $color_in, $color_out, $unit);
 828       $result .= "<IMG WIDTH=\"$xmax\" HEIGHT=\"$ymax\" ";
 829       $result .= "SRC=\"$IMG_pth$filename\" ALT=\"Graph\">\n";
 830       $i++;
 831     }
 832     $result .= "<P>\n";
 833   }
 834   $i = 0;
 835   $result .= "<TABLE BORDER=\"1\"><TR>";
 836   my $temp = '';
 837   while (defined ${${$output{'index'}{'column'}}[$i]}{'title'}) {
 838     my $title = &GetValue (${${$output{'index'}{'column'}}[$i]}{'title'});
 839     my $name = '';
 840     $name = &GetValue (${${$output{'index'}{'column'}}[$i]}{'name'})
 841       if defined ${${$output{'index'}{'column'}}[$i]}{'name'};
 842     my @list = split /\|/, $name;
 843     if ($name) {
 844       $result .= sprintf "<TH COLSPAN=%d>$title</TH>", $#list + 1;
 845     }
 846     else {
 847       $result .= "<TH ROWSPAN=\"2\">$title</TH>";
 848     }
 849     foreach (@list) {
 850       $temp .= "<TH>$_</TH>";
 851     }
 852     $i++;
 853   }
 854   $result .= "</TR>\n<TR>$temp</TR>\n";
 855
 856   $i = 0;
 857   foreach (sort {$b cmp $a} (keys %data)) {
 858     if ($CYCLE == 0 || $i < $CYCLE) {
 859       my @list = split /\|/, $data{$_};
 860       my $str = "<TR><TD ALIGN=LEFT>";
 861       $str .= "<A HREF=\"$_\">" if -e "$rep/$_";
 862       $str .= shift @list;
 863       $str .= "</A>" if -e "$rep/$_";;
 864       $str .= "</TD>";
 865       while (@list) {
 866         $str .= "<TD ALIGN=RIGHT>";
 867         my $t = shift @list;
 868         $t =~ s/^\0+//o; # remove garbage, if any.
 869         $str .= "$t</TD>";
 870       }
 871       $str .= "</TR>\n";
 872       $result .= "$str";
 873     }
 874     $i++;
 875   }
 876   $result .= "</TABLE>\n</CENTER>\n<P><HR>";
 877   $result .= "innreport $version (c) 1996-1999 ";
 878   $result .= "by Fabien Tassin &lt;<A HREF=\"mailto:fta\@sofaraway.org\">";
 879   $result .= "fta\@sofaraway.org</A>&gt;.\n";
 880   if (defined ($output{'default'}{'footer'})) {
 881     my ($t) = $output{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o;
 882     $t =~ s/\\\"/\"/go;
 883     $result .= "<BR>" . $t;
 884   }
 885   $result .= "$HTML_footer\n</BODY>\n</HTML>\n";
 886   my $name = $rep . "/" . $index;
 887   while ($name =~ m/\/\.\.\//o) {
 888     $name =~ s|^\./||o;                 # ^./xxx        =>      ^xxx
 889     $name =~ s|/\./|/|go;               # xxx/./yyy     =>      xxx/yyy
 890     $name =~ s|/+|/|go;                 # xxx//yyy      =>      xxx/yyy
 891     $name =~ s|^/\.\./|/|o;             # ^/../xxx      =>      ^/xxx
 892     $name =~ s|^[^/]+/\.\./||o;         # ^xxx/../      =>      ^nothing
 893     $name =~ s|/[^/]+/\.\./|/|go;       # /yyy/../      =>      /
 894   }
 895
 896   open (INDEX, "> $name") || die "Error: Unable to create $name\n";
 897   print INDEX $result;
 898   close INDEX;
 899   1;
 900 }
 901
 902 sub Graph3d {
 903   my $filename = shift;           # filename
 904   my $title = shift;              # title
 905   my $xmax = shift;               # width
 906   my $n = shift;                  # Number of hash code tables
 907
 908   no strict;
 909   my ($i, $k, $t);
 910   my @val;
 911   for $i (0 .. $n - 1) {
 912     push @val, shift;           # hash code table
 913   }
 914   my $colors = shift;             # colors table
 915   my $labels = shift;             # labels
 916
 917   my $max = 0;
 918   my $max_size = 0;
 919   my $size = 0;
 920   foreach $k (sort keys (%{$val[0]})) {
 921     $t = 0;
 922     $size++;
 923     for $i (0 .. $n - 1) {
 924       $t += ${$val[$i]}{$k} if defined ${$val[$i]}{$k};
 925     }
 926     $max = $t if $max < $t;
 927     $t = length "$k";
 928     $max_size = $t if $max_size < $t;
 929   }
 930   $max = 1 unless $max;
 931   $max_size *= gdSmallFont->width;
 932
 933   # relief
 934   my ($rx, $ry) = (15, 5);
 935
 936   # margins
 937   my ($mt, $mb) = (40, 40);
 938   my $ml = $max_size > 30 ? $max_size + 8 : 30;
 939
 940   my $mr = 7 + (length "$max") * gdSmallFont->width;
 941   $mr = 30 if $mr < 30;
 942
 943   # height of each bar
 944   my $h = 12;
 945
 946   # difference between 2 bars
 947   my $d = 25;
 948
 949   my $ymax = $size * $d + $mt + $mb;
 950   my $image = new GD::Image ($xmax, $ymax);
 951
 952   my ($white, $black);
 953   if (defined $output{'default'}{'graph_fg'}) {
 954     my $t = $output{'default'}{'graph_fg'};
 955     $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
 956     $t =~ m/^[\da-fA-F]{6}$/o ||
 957       die "Error in section 'default' section 'graph_fg'. Bad color.\n";
 958     my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
 959     $black = $image->colorAllocate (@c);
 960   }
 961   else {
 962     $black = $image->colorAllocate (  0,   0,   0);
 963   }
 964   if (defined $output{'default'}{'graph_bg'}) {
 965     my $t = $output{'default'}{'graph_bg'};
 966     $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
 967     $t =~ m/^[\da-fA-F]{6}$/o ||
 968       die "Error in section 'default' section 'graph_bg'. Bad color.\n";
 969     my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
 970     $white = $image->colorAllocate (@c);
 971   }
 972   else {
 973     $white = $image->colorAllocate (255, 255, 255);
 974   }
 975   $image->filledRectangle (0, 0, $xmax, $ymax, $white);
 976   my @col;
 977   for $i (0 .. $n - 1) {
 978     $col[$i][0] = $image->colorAllocate
 979       ($$colors[$i][0], $$colors[$i][1], $$colors[$i][2]);
 980     $col[$i][1] = $image->colorAllocate
 981       ($$colors[$i][0] * 3 / 4, $$colors[$i][1] * 3 / 4,
 982        $$colors[$i][2] * 3 / 4);
 983     $col[$i][2] = $image->colorAllocate
 984       ($$colors[$i][0] * 2 / 3, $$colors[$i][1] * 2 / 3,
 985        $$colors[$i][2] * 2 / 3);
 986   }
 987
 988   $image->transparent ($white) if $transparent;
 989
 990   $image->rectangle (0, 0, $xmax - 1, $size * $d + $mt + $mb - 1, $black);
 991   $image->line (0, $mt - 5, $xmax - 1, $mt - 5, $black);
 992   for $i (0 .. $n - 1) {
 993     $image->string (gdSmallFont, $i * $xmax / $n + $mt - 10 + $rx,
 994                     ($mt - gdSmallFont->height) / 2, "$$labels[$i]", $black);
 995     $image->filledRectangle ($i * $xmax / $n + 10, 8 + $ry / 2,
 996                        $i * $xmax / $n + $mt - 10, $mt - 12, $col[$i][0]);
 997     $image->rectangle ($i * $xmax / $n + 10, 8 + $ry / 2,
 998                        $i * $xmax / $n + $mt - 10, $mt - 12, $black);
 999     {
1000       my $poly = new GD::Polygon;
1001       $poly->addPt($i * $xmax / $n + 10, 8 + $ry / 2);
1002       $poly->addPt($i * $xmax / $n + 10 + $rx / 2, 8);
1003       $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, 8);
1004       $poly->addPt($i * $xmax / $n + $mt - 10, 8 + $ry / 2);
1005
1006       $image->filledPolygon($poly, $col[$i][1]);
1007       $image->polygon($poly, $black);
1008     }
1009     {
1010       my $poly = new GD::Polygon;
1011       $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, 8);
1012       $poly->addPt($i * $xmax / $n + $mt - 10, 8 + $ry / 2);
1013       $poly->addPt($i * $xmax / $n + $mt - 10, $mt - 12);
1014       $poly->addPt($i * $xmax / $n + $mt - 10 + $rx / 2, $mt - 12 - $ry / 2);
1015
1016       $image->filledPolygon($poly, $col[$i][2]);
1017       $image->polygon($poly, $black);
1018     }
1019   }
1020   # Title
1021   $image->string (gdMediumBoldFont, ($xmax - gdMediumBoldFont->width *
1022                   (length "$title")) / 2, $ymax - gdMediumBoldFont->height - 7,
1023                   "$title", $black);
1024
1025   my $e = $mt - $h + $d;
1026   my $r = ($xmax - $ml - $mr - $rx) / $max;
1027
1028   # Axe Oz
1029   $image->line ($ml + $rx, $mt, $ml + $rx, $size * $d + $mt - $ry, $black);
1030   $image->line ($ml + $rx + $max * $r, $mt, $ml + $rx + $max * $r,
1031                 $size * $d + $mt - $ry, $black);
1032   $image->line ($ml, $mt + $ry, $ml, $size * $d + $mt, $black);
1033   # Axe Ox
1034   $image->line ($ml + $rx, $size * $d + $mt - $ry,
1035                 $ml + $rx - 2 * $rx, $size * $d + $mt + $ry, $black);
1036   # Axe Oy
1037   $image->line ($ml + $rx, $size * $d + $mt - $ry,
1038                 $xmax - $mr / 2, $size * $d + $mt - $ry, $black);
1039   $image->line ($ml, $size * $d + $mt,
1040                 $xmax - $mr - $rx, $size * $d + $mt, $black);
1041
1042   # Graduations..
1043   my $nn = 10;
1044   for $k (1 .. ($nn - 1)) {
1045     $image->dashedLine ($ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
1046                   $mt + 10, $ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
1047                   $size * $d + $mt - $ry, $black);
1048     $image->dashedLine ($ml + $rx + $k * ($xmax - $ml - $mr - $rx) / $nn,
1049                         $size * $d + $mt - $ry,
1050                         $ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
1051                         $size * $d + $mt, $black);
1052     $image->line ($ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
1053                         $size * $d + $mt,
1054                         $ml + $k * ($xmax - $ml - $mr - $rx) / $nn,
1055                         $size * $d + $mt + 5, $black);
1056     my $t = sprintf "%d%%", $k * 10;
1057     $image->string (gdSmallFont, $ml + $k * ($xmax - $ml - $mr - $rx) / $nn -
1058                     (length "$t") * gdSmallFont->width / 2,
1059                     $size * $d + $mt + 6, "$t", $black);
1060   }
1061   {
1062     my $t = sprintf "%d%%", 0;
1063     $image->line ($ml, $size * $d + $mt, $ml, $size * $d + $mt + 5, $black);
1064     $image->string (gdSmallFont, $ml - (length "$t") * gdSmallFont->width / 2,
1065                     $size * $d + $mt + 6, "$t", $black);
1066     $image->line ($xmax - $mr, $size * $d + $mt - $ry,
1067                   $xmax - $mr - $rx, $size * $d + $mt, $black);
1068     $image->line ($xmax - $mr - $rx, $size * $d + $mt,
1069                   $xmax - $mr - $rx, $size * $d + $mt + 5, $black);
1070     $t = sprintf "%d%%", 100;
1071     $image->string (gdSmallFont, $xmax - $mr - $rx
1072                     - (length "$t") * gdSmallFont->width / 2,
1073                     $size * $d + $mt + 6, "$t", $black);
1074   }
1075   foreach $k (sort {${$val[0]}{$b} <=> ${$val[0]}{$a}} keys (%{$val[0]})) {
1076     $image->string (gdSmallFont, $ml - (length "$k") * gdSmallFont->width - 3,
1077                     $e + $h / 2 - gdSmallFont->height / 2, "$k", $black);
1078     my $t = 0;
1079     $image->line ($ml + ($t + ${$val[0]}{$k}) * $r + $rx - $rx, $e + $h,
1080                   $ml + ($t + ${$val[0]}{$k}) * $r + $rx, $e - $ry + $h,
1081                   $black);
1082     for $i (0 .. $n - 1) {
1083       next unless defined ${$val[$i]}{$k};
1084       {
1085         my $poly = new GD::Polygon;
1086         $poly->addPt($ml + $t * $r, $e);
1087         $poly->addPt($ml + $t * $r + $rx, $e - $ry);
1088         $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry);
1089         $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r, $e);
1090
1091         $image->filledPolygon($poly, $col[$i][1]);
1092         $image->polygon($poly, $black);
1093       }
1094       unless (${$val[$i + 1]}{$k} || ${$val[$i]}{$k} == 0) {
1095         my $poly = new GD::Polygon;
1096         $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry);
1097         $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx - $rx, $e);
1098         $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx - $rx, $e + $h);
1099         $poly->addPt($ml + ($t + ${$val[$i]}{$k}) * $r + $rx, $e - $ry + $h);
1100
1101         $image->filledPolygon($poly, $col[$i][2]);
1102         $image->polygon($poly, $black);
1103       }
1104       $image->filledRectangle ($ml + $t * $r, $e,
1105                                $ml + ($t + ${$val[$i]}{$k}) * $r, $e + $h,
1106                                $col[$i][0]);
1107       $image->rectangle ($ml + $t * $r, $e, $ml + ($t + ${$val[$i]}{$k}) * $r,
1108                          $e + $h, $black);
1109       $t += ${$val[$i]}{$k};
1110     }
1111     # total length (offered)
1112     $image->filledRectangle ($ml + $t * $r + $rx + 3,
1113                              $e - 2 - gdSmallFont->height / 2,
1114                              $ml + $t * $r + $rx + 4 +
1115                              gdSmallFont->width * length $t,
1116                              $e - 6 + gdSmallFont->height / 2, $white);
1117     $image->string (gdSmallFont, $ml + $t * $r + $rx + 5,
1118                     $e - 3 - gdSmallFont->height / 2, "$t", $black);
1119     # first value (accepted)
1120     $image->filledRectangle ($ml + $t * $r + $rx + 3,
1121                              $e - 4 + gdSmallFont->height / 2,
1122                              $ml + $t * $r + $rx + 4 +
1123                              gdSmallFont->width * length "${$val[0]}{$k}",
1124                              $e - 2 + gdSmallFont->height, $white);
1125     $image->string (gdSmallFont, $ml + $t * $r + $rx + 5,
1126                     $e - 5 + gdSmallFont->height / 2, ${$val[0]}{$k}, $black);
1127     $e += $d;
1128   }
1129   open (IMG, "> $filename") || die "Error: Can't open \"$filename\": $!\n";
1130   if ($GD_FORMAT eq 'png') {
1131     print IMG $image->png;
1132   }
1133   else {
1134     print IMG $image->gif;
1135   }
1136   close IMG;
1137   $ymax;
1138 }
1139
1140 sub Histo {
1141   my ($filename, $title, $xmax, $factor,
1142       $labelx, $labely, $val1, $labels1) = @_;
1143
1144   no strict;
1145   my $max = 0;
1146   my $ymax = 300;
1147   my $nb = 0;
1148   # A hugly hack to convert hashes to lists..
1149   # and to adjust the first and the last value...
1150   # this function should be rewritten..
1151   my (@a, @b, $kk);
1152   foreach $kk (sort keys (%$val1))   {
1153     if (defined $$val1{$kk}) {
1154       $nb++;
1155       # Arg... the following MUST be removed !!!!!!!!!
1156       $$val1{$kk} = $$val1{$kk} / $innreport_inn::inn_flow_time{$kk} * 3600
1157         if ($innreport_inn::inn_flow_time{$kk} != 3600) &&
1158            ($innreport_inn::inn_flow_time{$kk} != 0);
1159       push @a, $$val1{$kk};
1160       $max = $$val1{$kk} if $$val1{$kk} > $max;
1161       push @b, $$labels1{$kk};
1162     }
1163   }
1164   return 0 unless $nb; # strange, no data.
1165   my $val = \@a;
1166   my $labels = \@b;
1167   my ($i, $j);
1168   my ($marginl, $marginr, $margint, $marginb, $shx, $shy);
1169
1170   my $image = new GD::Image($xmax, $ymax);
1171   my ($white, $black);
1172   if (defined $output{'default'}{'graph_fg'}) {
1173     my $t = $output{'default'}{'graph_fg'};
1174     $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1175     $t =~ m/^[\da-fA-F]{6}$/o ||
1176       die "Error in section 'default' section 'graph_fg'. Bad color.\n";
1177     my @c = map { hex ($_) } ($t =~ m/^(..)(..)(..)$/);
1178     $black = $image->colorAllocate (@c);
1179   }
1180   else {
1181     $black = $image->colorAllocate (  0,   0,   0);
1182   }
1183   if (defined $output{'default'}{'graph_bg'}) {
1184     my $t = $output{'default'}{'graph_bg'};
1185     $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1186     $t =~ m/^[\da-fA-F]{6}$/o ||
1187       die "Error in section 'default' section 'graph_bg'. Bad color.\n";
1188     my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
1189     $white = $image->colorAllocate (@c);
1190   }
1191   else {
1192     $white = $image->colorAllocate (255, 255, 255);
1193   }
1194   $image->filledRectangle (0, 0, $xmax, $ymax, $white);
1195   my $gray  = $image->colorAllocate (128, 128, 128);
1196   my $red   = $image->colorAllocate (255,   0,   0);
1197   my $red2  = $image->colorAllocate (189,   0,   0);
1198   my $red3  = $image->colorAllocate (127,   0,   0);
1199   my $coltxt = $black;
1200
1201   $image->transparent ($white) if $transparent;
1202
1203   my $FontWidth = gdSmallFont->width;
1204   my $FontHeight = gdSmallFont->height;
1205
1206   $marginl = 60;
1207   $marginr = 30;
1208   $margint = 60;
1209   $marginb = 30;
1210   $shx = 7;
1211   $shy = 7;
1212
1213   $max = 1 unless $max;
1214   my $part = 8;
1215   $max /= $factor;
1216
1217   my $old_max = $max;
1218   {
1219     my $t = log ($max) / log 10;
1220     $t = sprintf "%.0f", $t - 1;
1221     $t = exp ($t * log 10);
1222     $max = sprintf "%.0f", $max / $t * 10 + 0.4;
1223     my $t2 = sprintf "%.0f", $max / $part;
1224     unless ($part * $t2 == $max) {
1225       while ($part * $t2 != $max) {
1226         $max++;
1227         $t2 = sprintf "%d", $max / $part;
1228       }
1229     }
1230     $max = $max * $t / 10;
1231   }
1232
1233   # Title
1234   $image->string (gdMediumBoldFont,
1235                   ($xmax - length ($title) * gdMediumBoldFont->width) / 2,
1236                   ($margint - $shy - gdMediumBoldFont->height) / 2,
1237                   $title, $coltxt);
1238
1239   # Labels
1240   $image->string (gdSmallFont, $marginl / 2, $margint / 2, $labely, $coltxt);
1241   $image->string (gdSmallFont, $xmax - $marginr / 2 -
1242                   $FontWidth * length ($labelx), $ymax - $marginb / 2,
1243                   $labelx, $coltxt);
1244
1245   # Max
1246   $image->line ($marginl, $ymax - $marginb - $shy -
1247                 $old_max * ($ymax - $marginb - $margint - $shy) / $max,
1248                 $xmax - $marginr, $ymax - $marginb - $shy -
1249                 $old_max * ($ymax - $marginb - $margint - $shy) / $max, $red);
1250   $image->line ($marginl, $ymax - $marginb - $shy -
1251                 $old_max * ($ymax - $marginb - $margint - $shy) / $max,
1252                 $marginl - $shx, $ymax - $marginb -
1253                 $old_max * ($ymax - $marginb - $margint - $shy) / $max, $red);
1254
1255   # Left
1256   $image->line ($marginl - $shx, $margint + $shy,
1257                 $marginl - $shx, $ymax - $marginb, $coltxt);
1258   $image->line ($marginl, $margint,
1259                 $marginl, $ymax - $marginb - $shy, $coltxt);
1260   $image->line ($marginl, $margint,
1261                 $marginl - $shx, $margint + $shy, $coltxt);
1262   $image->line ($marginl - $shx, $ymax - $marginb,
1263                 $marginl, $ymax - $marginb - $shy, $coltxt);
1264
1265   # Right
1266   $image->line ($xmax - $marginr, $margint,
1267                 $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
1268   $image->line ($xmax - $marginr - $shx, $ymax - $marginb,
1269                 $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
1270
1271   # Bottom
1272   $image->line ($marginl - $shx, $ymax - $marginb,
1273                 $xmax - $marginr - $shx, $ymax - $marginb, $coltxt);
1274   $image->line ($marginl, $ymax - $marginb - $shy,
1275                 $xmax - $marginr, $ymax - $marginb - $shy, $coltxt);
1276   $image->fill ($xmax / 2, $ymax - $marginb - $shy / 2, $gray);
1277
1278   # Top
1279   $image->line ($marginl, $margint,
1280                 $xmax - $marginr, $margint, $coltxt);
1281   $image->setStyle ($coltxt, $coltxt, &GD::gdTransparent,
1282                     &GD::gdTransparent, &GD::gdTransparent);
1283   # Graduations
1284   for ($i = 0; $i <= $part; $i++) {
1285     $j = $max * $i / $part ;  # Warning to floor
1286     # $j = ($max / $part) * ($i / 10000);
1287     # $j *= 10000;
1288
1289     # Little hack...
1290     $j = sprintf "%d", $j if $j > 100;
1291
1292     $image->line ($marginl - $shx - 3, $ymax - $marginb -
1293                   $i * ($ymax - $marginb - $margint - $shy) / $part,
1294                   $marginl - $shx, $ymax - $marginb -
1295                   $i * ($ymax - $marginb - $margint - $shy) / $part, $coltxt);
1296     $image->line ($marginl - $shx, $ymax - $marginb -
1297                   $i * ($ymax - $marginb - $margint - $shy) / $part,
1298                   $marginl, $ymax - $marginb - $shy -
1299                   $i * ($ymax - $marginb - $margint - $shy) / $part, gdStyled);
1300     $image->line ($marginl, $ymax - $marginb - $shy -
1301                   $i * ($ymax - $marginb - $margint - $shy) / $part,
1302                   $xmax - $marginr, $ymax - $marginb - $shy -
1303                   $i * ($ymax - $marginb - $margint - $shy) / $part, gdStyled);
1304     $image->string (gdSmallFont,
1305                     $marginl - $shx - $FontWidth * length ("$j") - 7,
1306                     $ymax - $marginb -
1307                     ($i) * ($ymax - $marginb - $margint - $shy) / ($part) -
1308                     $FontHeight / 2, "$j", $coltxt);
1309   }
1310
1311   # Graduation (right bottom corner)
1312   $image->line ($xmax - $marginr - $shx, $ymax - $marginb,
1313                 $xmax - $marginr - $shx, $ymax - $marginb + 3, $coltxt);
1314   # Bars
1315   $i = 0;
1316   my $w = ($xmax - $marginl - $marginr) / $nb;
1317   my $k = $w / 5;
1318   $$val[$nb - 1] = 0 unless $$val[$nb - 1];
1319   foreach $j (@$val) {
1320     my $MAX = 1;
1321     if ($i++ <= $nb) {
1322       # Graduation
1323       $image->line ($marginl + ($i - 1) * $w - $shx, $ymax - $marginb,
1324                     $marginl + ($i - 1) * $w - $shx, $ymax - $marginb + 3,
1325                     $coltxt);
1326       my $ii = sprintf "%d", $i / $MAX;
1327       $image->string (gdSmallFont,
1328                       $marginl + ($i - 0.5) * $w + 1 -
1329                       ($FontWidth * length ($$labels[$i-1])) / 2 - $shx,
1330                       $ymax - $marginb + 3, $$labels[$i-1], $coltxt)
1331         unless ($w < $FontWidth * length ($$labels[$i-1]))
1332                 && ($i != $MAX * $ii);
1333
1334       # Right
1335       my $poly = new GD::Polygon;
1336       $poly->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy -
1337                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1338       $poly->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy);
1339       $poly->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb);
1340       $poly->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb -
1341                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1342
1343       $image->filledPolygon($poly, $red3);
1344       $image->polygon($poly, $coltxt);
1345
1346       # Front
1347       $image->filledRectangle ($marginl + ($i - 1) * $w + $k - $shx,
1348                    $ymax - $marginb -
1349                    $j  / $factor * ($ymax - $marginb - $margint - $shy) / $max,
1350                    $marginl + ($i) * $w - $k - $shx,
1351                    $ymax - $marginb, $red);
1352       $image->rectangle ($marginl + ($i - 1) * $w + $k - $shx,
1353                    $ymax - $marginb -
1354                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max,
1355                    $marginl + ($i) * $w - $k - $shx,
1356                    $ymax - $marginb, $coltxt);
1357       # Top
1358       my $poly2 = new GD::Polygon;
1359       $poly2->addPt($marginl + ($i - 1) * $w + $k, $ymax - $marginb - $shy -
1360                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1361       $poly2->addPt($marginl + ($i) * $w - $k, $ymax - $marginb - $shy -
1362                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1363       $poly2->addPt($marginl + ($i) * $w - $k - $shx, $ymax - $marginb -
1364                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1365       $poly2->addPt($marginl + ($i - 1) * $w + $k - $shx, $ymax - $marginb -
1366                    $j / $factor * ($ymax - $marginb - $margint - $shy) / $max);
1367
1368       $image->rectangle (0, 0, $xmax - 1, $ymax - 1, $coltxt);
1369       $image->filledPolygon($poly2, $red2);
1370       $image->polygon($poly2, $coltxt);
1371     }
1372   }
1373
1374   open (IMG, "> $filename") || die "Can't create '$filename'\n";
1375   if ($GD_FORMAT eq 'png') {
1376     print IMG $image->png;
1377   }
1378   else {
1379     print IMG $image->gif;
1380   }
1381   close IMG;
1382   1;
1383 }
1384
1385 sub Chrono {
1386   my $filename = shift;           # filename
1387   my $title = shift;              # title
1388   my $color_bg = shift;           # background color
1389   my $xmax = shift;               # width
1390   my $ymax = shift;               # height
1391
1392   my $in = shift;
1393   my $out = shift;
1394   my $dates = shift;
1395
1396   my $legend_in = shift;
1397   my $legend_out = shift;
1398
1399   my $color_in = shift;
1400   my $color_out = shift;
1401
1402   my $unit = shift;
1403
1404   my $key;
1405   my $x_min = 1E30;
1406   my $x_max = 0;
1407   my $y_min = 0;
1408   my $y_max;
1409   my $y_max_in = 0;
1410   my $y_max_out = 0;
1411
1412   foreach $key (sort keys %$dates) {
1413     $x_min = $key if $x_min > $key;
1414     $x_max = $$dates{$key} if $x_max < $$dates{$key};
1415     my $t = $$out{$key} / ($$dates{$key} - $key);
1416     $y_max_out = $t if $y_max_out < $t;
1417     $t = $$in{$key} / ($$dates{$key} - $key);
1418     $y_max_in = $t if $y_max_in < $t;
1419   }
1420   $y_max = $y_max_out > $y_max_in ? $y_max_out : $y_max_in;
1421   my $factor = 1;
1422   if ($y_max < 1) {
1423     $factor = 60;
1424     if ($y_max < 4 / 60) {
1425       $y_max = 4 / 60;
1426     }
1427     else {
1428       $y_max = int ($y_max * $factor) + 1;
1429       $y_max += (4 - ($y_max % 4)) % 4;
1430       $y_max /= $factor;
1431     }
1432   }
1433   else {
1434     $y_max = int ($y_max) + 1;
1435     $y_max += (4 - ($y_max % 4)) % 4;
1436   }
1437
1438   $unit .= "/" . ($factor == 60 ? "min" : "sec");
1439
1440   # min range is 4 weeks.
1441   my $delta = $x_max - $x_min;
1442   $x_min = $x_max - 3024000 if $delta < 3024000;
1443   # between 4 weeks and one year, range is a year.
1444   $x_min = $x_max - 31536000 if ($delta < 31536000 && $delta > 3024000);
1445   # max range is 13 months
1446   $x_min = $x_max - 34128000 if $delta > 34128000;
1447   my $image = new GD::Image ($xmax, $ymax);
1448   my ($white, $black);
1449   if (defined $output{'default'}{'graph_fg'}) {
1450     my $t = $output{'default'}{'graph_fg'};
1451     $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1452     $t =~ m/^[\da-fA-F]{6}$/o ||
1453       die "Error in section 'default' section 'graph_fg'. Bad color.\n";
1454     my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
1455     $black = $image->colorAllocate (@c);
1456   }
1457   else {
1458     $black = $image->colorAllocate (  0,   0,   0);
1459   }
1460   if (defined $output{'default'}{'graph_bg'}) {
1461     my $t = $output{'default'}{'graph_bg'};
1462     $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
1463     $t =~ m/^[\da-fA-F]{6}$/o ||
1464       die "Error in section 'default' section 'graph_bg'. Bad color.\n";
1465     my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
1466     $white = $image->colorAllocate (@c);
1467   }
1468   else {
1469     $white = $image->colorAllocate (255, 255, 255);
1470   }
1471   my $bg;
1472   if (defined $color_bg) {
1473     $color_bg =~ m/^\#[\da-fA-F]{6}$/o ||
1474       die "Error in section 'index'. Bad color $color_bg.\n";
1475     my @c = map { hex $_ } ($color_bg =~ m/^\#(..)(..)(..)$/);
1476     $bg = $image->colorAllocate (@c);
1477   }
1478   else {
1479     $bg = $image->colorAllocate (255, 255, 206);
1480   }
1481   my $col_in;
1482   if (defined $color_in) {
1483     $color_in =~ m/^\#[\da-fA-F]{6}$/o ||
1484       die "Error in section 'index'. Bad color $color_in.\n";
1485     my @c = map { hex $_ } ($color_in =~ m/^\#(..)(..)(..)$/);
1486     $col_in = $image->colorAllocate (@c);
1487   }
1488   else {
1489     $col_in = $image->colorAllocate ( 80, 159, 207);
1490   }
1491   my $col_out;
1492   my @col_out = (  0,   0, 255);
1493   if (defined $color_out) {
1494     $color_out =~ m/^\#[\da-fA-F]{6}$/o ||
1495       die "Error in section 'index'. Bad color $color_out.\n";
1496     my @c = map { hex $_ } ($color_out =~ m/^\#(..)(..)(..)$/);
1497     $col_out = $image->colorAllocate (@c);
1498     @col_out = @c;
1499   }
1500   else {
1501     $col_out = $image->colorAllocate (@col_out);
1502   }
1503
1504   my $white2  = $image->colorAllocate (255, 255, 255);
1505   my $gray    = $image->colorAllocate (192, 192, 192);
1506   my $red     = $image->colorAllocate (255,   0,   0);
1507   my $coltxt  = $black;
1508
1509   my $size    = 22; # legend
1510   # legend statistics
1511   my ($max_in, $max_out) = (0, 0);         # min
1512   my ($min_in, $min_out) = (1E10, 1E10);   # max
1513   my ($t_in, $t_out) = (0, 0);             # time
1514   my ($s_in, $s_out) = (0, 0);             # sum
1515
1516   $image->filledRectangle (0, 0, $xmax, $ymax, $gray);
1517   $image->transparent ($gray) if $transparent;
1518
1519   my $FontWidth = gdSmallFont->width;
1520   my $FontHeight = gdSmallFont->height;
1521   $image->setStyle ($black, &GD::gdTransparent, &GD::gdTransparent);
1522
1523   my $marginl = 13 + $FontWidth * length (sprintf "%d", $y_max * $factor);
1524   my $marginr = 15 + 4 * $FontWidth; # "100%"
1525   my $margint = 2 * $FontHeight + gdMediumBoldFont->height;
1526   my $marginb = 2 * $FontHeight + $size;
1527   my $xratio = ($xmax - $marginl - $marginr) / ($x_max - $x_min);
1528   my $yratio = ($ymax - $margint - $marginb) / ($y_max - $y_min);
1529
1530   my $frame = new GD::Polygon;
1531   $frame->addPt(2, $margint - $FontHeight -3);
1532   $frame->addPt($xmax - 2, $margint - $FontHeight -3);
1533   $frame->addPt($xmax - 2, $ymax - 3);
1534   $frame->addPt(2, $ymax - 3);
1535   $image->filledPolygon($frame, $white2);
1536   $image->polygon($frame, $black);
1537
1538   $image->filledRectangle ($marginl, $margint,
1539                            $xmax - $marginr, $ymax - $marginb, $bg);
1540   my $brush = new GD::Image(1, 2);
1541   my $b_col = $brush->colorAllocate(@col_out);
1542   $brush->line(0, 0, 0, 1, $b_col);
1543   $image->setBrush($brush);
1544   my ($old_x, $old_y_in, $old_y_out);
1545   foreach $key (sort keys %$dates) {
1546     next if $key < $x_min;
1547     my $delta = $$dates{$key} - $key;
1548     $min_in  = $$in{$key} / $delta  if $min_in  > $$in{$key} / $delta;
1549     $max_in  = $$in{$key} / $delta  if $max_in  < $$in{$key} / $delta;
1550     $min_out = $$out{$key} / $delta if $min_out > $$out{$key} / $delta;
1551     $max_out = $$out{$key} / $delta if $max_out < $$out{$key} / $delta;
1552     $t_in   += $delta;
1553     $s_in   += $$in{$key};
1554     $s_out  += $$out{$key};
1555
1556     my $tt_in  = $$in{$key} / ($$dates{$key} - $key) * $yratio;
1557     my $tt_out = $$out{$key} / ($$dates{$key} - $key) * $yratio;
1558     my $new_x = $marginl + ($key - $x_min) * $xratio;
1559     $image->filledRectangle ($marginl + ($key - $x_min) * $xratio,
1560                        $ymax - $marginb - $tt_in,
1561                        $marginl + ($$dates{$key} - $x_min) * $xratio,
1562                        $ymax - $marginb, $col_in);
1563     if (defined $old_x) {
1564       $old_x = $new_x if $old_x > $new_x;
1565       my $poly = new GD::Polygon;
1566       $poly->addPt($old_x, $old_y_in);
1567       $poly->addPt($new_x, $ymax - $marginb - $tt_in);
1568       $poly->addPt($new_x, $ymax - $marginb);
1569       $poly->addPt($old_x, $ymax - $marginb);
1570       $image->filledPolygon($poly, $col_in);
1571     }
1572     $image->line ($marginl + ($key - $x_min) * $xratio,
1573                        $ymax - $marginb - $tt_out,
1574                        $marginl + ($$dates{$key} - $x_min) * $xratio,
1575                        $ymax - $marginb - $tt_out, &GD::gdBrushed);
1576     $image->line ($old_x, $old_y_out, $new_x,
1577                   $ymax - $marginb - $tt_out, $col_out) if defined $old_x;
1578     $old_x = $marginl + ($$dates{$key} - $x_min) * $xratio;
1579     $old_y_in  = $ymax - $marginb - $tt_in;
1580     $old_y_out = $ymax - $marginb - $tt_out;
1581   }
1582   $t_out = $t_in;
1583
1584   # main frame
1585   $image->rectangle ($marginl, $margint,
1586                      $xmax - $marginr, $ymax - $marginb, $black);
1587   # graduations
1588   my $i;
1589   foreach $i (0, 25, 50, 75, 100) {
1590     my $t = $ymax - $margint - $marginb;
1591     $image->line ($marginl, $ymax - $marginb - $i / 100 * $t,
1592                   $xmax - $marginr, $ymax - $marginb - $i / 100 * $t,
1593                   &GD::gdStyled);
1594     $image->line ($xmax - $marginr, $ymax - $marginb - $i / 100 * $t,
1595                   $xmax - $marginr + 3, $ymax - $marginb - $i / 100 * $t,
1596                   $black);
1597     $image->line ($marginl - 3, $ymax - $marginb - $i / 100 * $t,
1598                   $marginl, $ymax - $marginb - $i / 100 * $t,
1599                   $black);
1600     $image->string (&GD::gdSmallFont, $xmax - $marginr + 8, - $FontHeight / 2 +
1601                     $ymax - $marginb - $i / 100 * $t, "$i%", $black);
1602     my $s = sprintf "%d", $y_max * $i / 100 * $factor;
1603     $image->string (&GD::gdSmallFont, $marginl - 5 - $FontWidth * length $s,
1604                     - $FontHeight / 2 +
1605                     $ymax - $marginb - $i / 100 * $t, $s, $black);
1606   }
1607   ##
1608   my $w = 604800;      # number of seconds in a week
1609   my $y = 31536000;    # number of seconds in a 365 days year
1610   my $mm = 2592000;    # number of seconds in a 30 days month
1611   if ($x_max - $x_min <= 3024000) { # less than five weeks
1612     # unit is a week
1613     # 1/1/1990 is a monday. Use this as a basis.
1614     my $d = 631152000; # number of seconds between 1/1/1970 and 1/1/1990
1615     my $n = int ($x_min / $y);
1616     my $t = $x_min - $n * $y - int (($n - 2) / 4) * 24 * 3600;
1617     my $f = int ($t / $w);
1618     $n = $d + int (($x_min - $d) / $w) * $w;
1619     while ($n < $x_max) {
1620       $t = $marginl + ($n - $x_min) * $xratio;
1621       if ($n > $x_min) {
1622         $image->line ($t, $margint, $t, $ymax - $marginb, &GD::gdStyled);
1623         $image->line ($t, $ymax - $marginb, $t, $ymax - $marginb + 2, $black);
1624       }
1625       $image->string (&GD::gdSmallFont, $FontWidth * 7 / 2 + $t,
1626                       $ymax - $marginb + 4, (sprintf "Week %02d", $f), $black)
1627         if ($n + $w / 2 > $x_min) && ($n + $w / 2 < $x_max);
1628       $f++;
1629       $n += $w;
1630       $t = int ($n / $y);
1631       $f = 0
1632         if $n - $y * $t - int (($t - 2) / 4) * 24 * 3600 < $w && $f > 50;
1633     }
1634     $d = 86400;    # 1 day
1635     $n = int ($x_min / $y);
1636     $t = $n * $y + int (($n - 2) / 4) * 24 * 3600;
1637     $i = 0;
1638     my $x;
1639     while ($t < $x_max) {
1640       $x = $marginl + ($t - $x_min) * $xratio;
1641       $image->line ($x, $margint, $x, $ymax - $marginb + 2, $red)
1642         if $t > $x_min;
1643       $t += $mm;
1644       $t += $d if $i == 0 || $i == 2 || $i == 4 ||
1645                   $i == 6 || $i == 7 || $i == 9 || $i == 11; # 31 days months
1646       if ($i == 1) {  # february ?
1647         $t -= 2 * $d;
1648         $t += $d unless (1970 + int ($t / $y)) % 4;
1649       }
1650       $i++;
1651       $i = 0 if $i == 12; # Happy New Year !!
1652     }
1653   }
1654   else {
1655     # unit is a month
1656     my $n = int ($x_min / $y);
1657     my $t = $n * $y + int (($n - 2) / 4) * 24 * 3600;
1658     my @m = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
1659              "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
1660     my $d = 86400;    # 1 day
1661     my $i = 0;
1662     my $x;
1663     while ($t < $x_max) {
1664       $x = $marginl + ($t - $x_min) * $xratio;
1665       if ($t > $x_min) {
1666         $image->line ($x, $margint, $x, $ymax - $marginb, &GD::gdStyled);
1667         $image->line ($x, $ymax - $marginb, $x,
1668                       $ymax - $marginb + 2, $black);
1669         $image->line ($x, $margint, $x, $ymax - $marginb, $red) unless $i;
1670       }
1671       $image->string (&GD::gdSmallFont,
1672                       $mm * $xratio / 2 - $FontWidth * 3 / 2 +
1673                       $x, $ymax - $marginb + 4, (sprintf "%s", $m[$i]),
1674                       $black)
1675         if ($t + 2 * $w > $x_min) && ($x_max > 2 * $w + $t);
1676       $t += $mm;
1677       $t += $d if ($i == 0 || $i == 2 || $i == 4 ||
1678                    $i == 6 || $i == 7 || $i == 9 || $i == 11); # 31 days months
1679       if ($i == 1) {  # february ?
1680         $t -= 2 * $d;
1681         $t += $d unless (1970 + int ($t / $y)) % 4;
1682       }
1683       $i++;
1684       $i = 0 if $i == 12; # Happy New Year !!
1685     }
1686   }
1687
1688   # Add the little red arrow
1689   my $poly = new GD::Polygon;
1690   $poly->addPt($xmax - $marginr - 2, $ymax - $marginb - 3);
1691   $poly->addPt($xmax - $marginr + 4, $ymax - $marginb);
1692   $poly->addPt($xmax - $marginr - 2, $ymax - $marginb + 3);
1693   $image->filledPolygon($poly, $red);
1694
1695   # Title
1696   $image->string (&GD::gdMediumBoldFont,
1697                   $xmax / 2 - $FontWidth * length ($title) / 2, 4,
1698                   $title, $black);
1699
1700   # Legend
1701   my $y_in = $ymax - $size - $FontHeight + 5;
1702   $image->string (&GD::gdSmallFont, $marginl, $y_in, $legend_in, $col_in);
1703   $image->string (&GD::gdSmallFont, $xmax / 4, $y_in,
1704                   (sprintf "Min: %5.1f $unit", $min_in * $factor), $black);
1705   $image->string (&GD::gdSmallFont, $xmax / 2, $y_in,
1706                 (sprintf "Avg: %5.1f $unit", $s_in / $t_in * $factor), $black);
1707   $image->string (&GD::gdSmallFont, 3 * $xmax / 4, $y_in,
1708                   (sprintf "Max: %5.1f $unit", $max_in * $factor), $black);
1709
1710   my $y_out = $ymax - $size + 5;
1711   $image->string (&GD::gdSmallFont, $marginl, $y_out, $legend_out, $col_out);
1712   $image->string (&GD::gdSmallFont, $xmax / 4, $y_out,
1713                   (sprintf "Min: %5.1f $unit", $min_out * $factor), $black);
1714   $image->string (&GD::gdSmallFont, $xmax / 2, $y_out,
1715               (sprintf "Avg: %5.1f $unit", $s_out / $t_out * $factor), $black);
1716   $image->string (&GD::gdSmallFont, 3 * $xmax / 4, $y_out,
1717                   (sprintf "Max: %5.1f $unit", $max_out * $factor), $black);
1718
1719   open (IMG, "> $filename") || die "Error: Can't open \"$filename\": $!\n";
1720   if ($GD_FORMAT eq 'png') {
1721     print IMG $image->png;
1722   }
1723   else {
1724     print IMG $image->gif;
1725   }
1726   close IMG;
1727   return $ymax;
1728 }
1729
1730 sub Write_all_results {
1731   my $HTML_output = shift;
1732   my $h = shift;
1733   my $k;
1734
1735   my $title = $$h{'default'}{'title'} ?
1736     $$h{'default'}{'title'} : "Daily Usenet report";
1737   $title =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1738   $title =~ s/\\\"/\"/go;
1739   my $Title = $title;
1740   $Title =~ s/<.*?>//go;
1741   {
1742     my $Title = $Title;
1743     $Title =~ s/\&amp;/&/go;
1744     $Title =~ s/\&lt;/</go;
1745     $Title =~ s/\&gt;/>/go;
1746     print "$Title from $first_date to $last_date\n\n";
1747   }
1748
1749   if ($HTML) {
1750     my $body = defined $output{'default'}{'html_body'} ?
1751       $output{'default'}{'html_body'} : '';
1752     $body =~ s/^\"\s*(.*?)\s*\"$/ $1/o;
1753     $body =~ s/\\\"/\"/go;
1754     open (HTML, "> $HTML_output") || die "Error: cant open $HTML_output\n";
1755
1756     print HTML "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n" .
1757       "<HTML>\n<HEAD>\n<TITLE>$Title: $first_date</TITLE>\n" .
1758       "<!-- innreport $version -->\n</HEAD>\n<BODY $body>\n" .
1759       "$HTML_header\n<CENTER><H1>$title</H1>\n" .
1760       "<H3>$first_date -- $last_date</H3>\n</CENTER>\n<P><HR><P>\n";
1761
1762     # Index
1763     print HTML "<UL>\n";
1764     foreach $k (@{$$h{'_order_'}}) {
1765       next if $k =~ m/^(default|index)$/;
1766       my ($data) = $$h{$k}{'data'} =~ m/^\"\s*(.*?)\s*\"$/o;
1767       $data =~ s/^\%/\%$CLASS\:\:/ unless $data eq '%prog_type';
1768       my %data;
1769       { local $^W = 0; no strict; %data = eval $data }
1770       my ($string) = $$h{$k}{'title'} =~ m/^\"\s*(.*?)\s*\"$/o;
1771       $string =~ s/\s*:$//o;
1772       my $want = 1;
1773
1774       ($want) = $$h{$k}{'skip'} =~ m/^\"?\s*(.*?)\s*\"?$/o
1775         if defined $$h{$k}{'skip'};
1776       $want = $want eq 'true' ? 0 : 1;
1777       print HTML "<LI><A HREF=\"#$k\">$string</A>\n" if %data && $want;
1778     }
1779     print HTML "</UL><P><HR><P>\n";
1780   }
1781   if (@unrecognize && $WANT_UNKNOWN) {
1782     my $mm = $#unrecognize;
1783     print HTML "<A NAME=\"unrecognize\">" if $HTML && $WANT_HTML_UNKNOWN;
1784     print "Unknown entries from news log file:\n";
1785     print HTML "<STRONG>Unknown entries from news log file:</STRONG></A><P>\n"
1786       if $HTML && $WANT_HTML_UNKNOWN;
1787     $mm = $MAX_UNRECOGNIZED - 1
1788       if $MAX_UNRECOGNIZED > 0 && $mm > $MAX_UNRECOGNIZED - 1;
1789     if ($mm < $unrecognize_max && $unrecognize_max > 0) {
1790       printf HTML "First %d / $unrecognize_max lines (%3.1f%%)<BR>\n", $mm + 1,
1791         ($mm + 1) / $unrecognize_max * 100 if $HTML && $WANT_HTML_UNKNOWN;
1792       printf "First %d / $unrecognize_max lines (%3.1f%%)\n", $mm + 1,
1793         ($mm + 1) / $unrecognize_max * 100;
1794     }
1795
1796     my $l;
1797     for $l (0 .. $mm) {
1798       chomp $unrecognize[$l];     # sometimes, the last line need a CR
1799       print "$unrecognize[$l]\n"; # so, we always add one
1800       if ($HTML && $WANT_HTML_UNKNOWN) {
1801         $unrecognize[$l] =~ s/&/\&amp;/g;
1802         $unrecognize[$l] =~ s/</\&lt;/g;
1803         $unrecognize[$l] =~ s/>/\&gt;/g;
1804         print HTML "$unrecognize[$l]<BR>\n";
1805       }
1806     }
1807     print "\n";
1808     print HTML "<P><HR><P>\n" if $HTML && $WANT_HTML_UNKNOWN;
1809   }
1810
1811   close HTML if $HTML;
1812   foreach $k (@{$$h{'_order_'}}) {
1813     next if $k =~ m/^(default|index)$/;
1814     &Write_Results($HTML_output, $k, $h);
1815   }
1816   if ($HTML) {
1817     open (HTML, ">> $HTML_output") || die "Error: cant open $HTML_output\n";
1818     print HTML <<EOT;
1819 innreport $version (c) 1996-1999 by Fabien Tassin
1820 &lt;<A HREF="mailto:fta\@sofaraway.org">fta\@sofaraway.org</A>&gt;.
1821 EOT
1822     if (defined $$h{'default'}{'footer'}) {
1823       my ($t) = $$h{'default'}{'footer'} =~ m/^\"\s*(.*?)\s*\"$/o;
1824       $t =~ s/\\\"/\"/go;
1825       print HTML "<BR>" . $t;
1826     }
1827     print HTML "\n$HTML_footer";
1828     printf HTML "\n<!-- Running time: %s -->", second2time(time - $start_time);
1829     print HTML "\n</BODY>\n</HTML>\n";
1830     close HTML;
1831   }
1832 }
1833
1834 sub Write_Results {
1835   my $HTML_output = shift;
1836   my $report = shift;
1837   my $data = shift;
1838   my %output = %$data;
1839   return 0 unless defined $output{$report}; # no data to write
1840   return 0 if defined $output{$report}{'skip'} &&
1841                $output{$report}{'skip'} =~ m/^true$/io;
1842   my ($TEXT, $HTML, $DOUBLE);
1843
1844   # Need a text report ?
1845   $TEXT = defined $output{$report}{'text'} ? $output{$report}{'text'} :
1846     (defined $output{'default'}{'text'} ? $output{'default'}{'text'} : '');
1847   die "Error in config file. Field 'text' is mandatory.\n" unless $TEXT;
1848   $TEXT = ($TEXT =~ m/^true$/io) ? 1 : 0;
1849
1850   # Need an html report ?
1851   if ($HTML_output) {
1852     $HTML = defined $output{$report}{'html'} ? $output{$report}{'html'} :
1853       (defined $output{'default'}{'html'} ? $output{'default'}{'html'} : '');
1854     die "Error in config file. Field 'html' is mandatory.\n" unless $HTML;
1855     $HTML = ($HTML =~ m/^true$/io) ? 1 : 0;
1856   }
1857   # Double table ?
1858   $DOUBLE = defined $output{$report}{'double'} ?
1859     $output{$report}{'double'} : 0;
1860   $DOUBLE = ($DOUBLE =~ m/^true$/io) ? 1 : 0;
1861
1862   # Want to truncate the report ?
1863   my $TOP = defined $output{$report}{'top'} ? $output{$report}{'top'} : -1;
1864   my $TOP_HTML = defined $output{$report}{'top_html'} ?
1865                    $output{$report}{'top_html'} : $TOP;
1866   my $TOP_TEXT = defined $output{$report}{'top_text'} ?
1867                    $output{$report}{'top_text'} : $TOP;
1868
1869   my (%h, %d, $h);
1870   {
1871     my $t = $output{$report}{'data'} ||
1872       die "Error in section $report. Need a 'data' field.\n";
1873     $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1874     $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
1875     %d = eval $t;
1876     return unless %d; # nothing to report. exit.
1877     return unless keys (%d); # nothing to report. exit.
1878   }
1879   {
1880     my $t = defined $output{$report}{'sort'} ? $output{$report}{'sort'} :
1881       "\$a cmp \$b";
1882     $t =~ s/\n/ /smog;
1883     $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1884     $t =~ s/([\$\%\@])/$1${CLASS}\:\:/go;
1885     $t =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|num)/$1$2/go;
1886     $t =~ s/\{\$${CLASS}\:\:(a|b)\}/\{\$$1\}/go;
1887     $t =~ s/\$${CLASS}\:\:(a|b)/\$$1/go;
1888     $h = $t;
1889   }
1890
1891   if ($HTML) {
1892     open (HTML, ">> $HTML_output") || die "Error: cant open $HTML_output\n";
1893   }
1894   print "\n" if $TEXT;
1895   my ($key, $key1, $key2);
1896   if (defined $output{$report}{'title'}) {
1897     my $t = $output{$report}{'title'};
1898     $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1899     if ($HTML) {
1900       print HTML "<A NAME=\"$report\">";
1901       my $html = $t;
1902       $html =~ s/(:?)$/ [Top $TOP_HTML]$1/o if $TOP_HTML > 0;
1903       $html =~ s|^(.*)$|<STRONG>$1</STRONG>|;
1904       print HTML "$html</A>\n<P>\n<CENTER>\n<TABLE BORDER=\"1\">\n";
1905     }
1906     $t =~ s/(:?)$/ [Top $TOP_TEXT]$1/o if $TOP_TEXT > 0;
1907     print "$t\n" if $TEXT;
1908   }
1909   my $numbering = 0;
1910   $numbering = 1 if defined $output{$report}{'numbering'} &&
1911                     $output{$report}{'numbering'} =~ m/^true$/o;
1912   my $i;
1913   my $s = '';
1914   my $html = '';
1915   my $first = 0;
1916
1917   foreach $i (@{$output{$report}{'column'}}) {
1918     my ($v1, $v2);
1919
1920     my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
1921     $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
1922     my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
1923     $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
1924
1925     $v1 = defined ($$i{'format_name'}) ? $$i{'format_name'} :
1926       (defined ($$i{'format'}) ? $$i{'format'} : "%s");
1927     $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1928     $v2 = $$i{'name'};
1929     $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1930     $s .= sprintf $v1 . " ", $v2 if $wtext && !($DOUBLE && $first == 1);
1931     if ($HTML && $whtml) {
1932       my $v1 = $v1;
1933       $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?(\w)/\%$1/g;
1934       my $temp = $first ? "CENTER" : "LEFT";
1935       $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
1936       $html .= sprintf "<TH ALIGN=\"$temp\">$v1</TH>", $v2;
1937     }
1938     $first++;
1939   }
1940   $s =~ s/\s*$//;
1941   print "$s\n" if $TEXT;
1942   $s = '';
1943   if ($HTML) {
1944     print HTML "<TR>$html</TR>\n<TR><TD></TD></TR>\n";
1945     $html = '';
1946   }
1947   my $num = 0;
1948   my $done;
1949   if ($DOUBLE) {
1950     my $num_d = 0;
1951     foreach $key1 (sort keys (%d)) {
1952       $done = 0;
1953       $num = 0;
1954       $num_d++;
1955       $s = '';
1956       $html = '';
1957       my @res;
1958       foreach $key2 (sort {$d{$key1}{$b} <=> $d{$key1}{$a}}
1959                      keys (%{$d{$key1}})) {
1960         my $first = 0;
1961         $num++;
1962         foreach $i (@{$output{$report}{'column'}}) {
1963           my ($v1, $v2, $p);
1964
1965           my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
1966           $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
1967           my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
1968           $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
1969
1970           # is it the primary key ?
1971           $p = 0;
1972           $p = 1 if defined $$i{'primary'} && $$i{'primary'} =~ m/true/;
1973
1974           # format
1975           $v1 = defined ($$i{'format'}) ? $$i{'format'} : "%s";
1976           $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1977
1978           # value
1979           $v2 = $$i{'value'};
1980           $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
1981           my $r ='';
1982           if ($v2) {
1983             $r = &EvalExpr ($v2, $key2, $num, $key1);
1984             die "Error in section $report column $$i{'name'}. " .
1985               "Invalid 'value' value.\n" unless defined $r;
1986           }
1987           $res[$first] += $r if $v1 =~ m/\%-?(?:\d+(?:\.\d+)?)?d/o;
1988           if ($p) {
1989             $s .= sprintf $v1. "\n", $r unless $done || !$wtext;
1990             if ($HTML && $whtml) {
1991               if ($done) {
1992                 $html .= "<TD></TD>";
1993               }
1994               else {
1995                 $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
1996                 $html .= $numbering ? "<TH ALIGN=\"CENTER\">$num_d</TH>" : '';
1997                 #  unless $first;
1998                 $html .= sprintf "<TD ALIGN=\"LEFT\">$v1</TD></TR>\n", $r;
1999                 $html .= "<TR><TD></TD>";
2000               }
2001             }
2002           }
2003           else {
2004             if ($wtext) {
2005               $s .= "  " if $first == 1;
2006               $s .= sprintf $v1 . " ", $r;
2007             }
2008             if ($HTML && $whtml) {
2009               $html .= $numbering ? "<TD></TD>" : '' if $first == 1;
2010               $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2011               my $temp = $first > 1 ? "RIGHT" : "LEFT";
2012               $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2013             }
2014           }
2015           $done = 1 if $p;
2016           $first++;
2017         }
2018         $s =~ s/\s*$//;
2019         $s =~ s/\\n/\n/g;
2020         print "$s\n" if $TEXT && ($num <= $TOP_TEXT || $TOP_TEXT == -1);
2021         if ($HTML && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
2022           $html =~ s/\\n//g;
2023           print HTML "<TR>$html</TR>\n";
2024         }
2025         $s = '';
2026         $html = '';
2027       }
2028       $first = 0;
2029       $s = '';
2030       $html = '';
2031       if ($TOP_TEXT != -1 && $TOP_HTML != -1) {
2032         foreach $i (@{$output{$report}{'column'}}) {
2033           if (defined $$i{'primary'} && $$i{'primary'} =~ m/true/o) {
2034             $first++;
2035             $s .= '  ';
2036             $html .= "<TD></TD>" if $HTML;
2037             $html .= "<TD></TD>" if $HTML && $numbering;
2038             next;
2039           }
2040           my ($v1, $v2);
2041           $v1 = defined ($$i{'format_total'}) ? $$i{'format_total'} :
2042             (defined ($$i{'format'}) ? $$i{'format'} : "%s");
2043           $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2044           my $r = $first == 1 ? $num : $res[$first];
2045           $s .= sprintf $v1 . " ", $r;
2046           if ($HTML) {
2047             my $temp = $first > 1 ? "RIGHT" : "LEFT";
2048             $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2049             $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first > 1;
2050             $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2051           }
2052           $first++;
2053         }
2054         $s =~ s/\s*$//;
2055         $s =~ s/\\n//g;
2056         print "$s\n" if $TEXT;
2057         print HTML "<TR>$html</TR>\n" if $HTML;
2058       }
2059     }
2060     print "\n" if $TEXT;
2061     print HTML "<TR><TD></TD></TR>\n" if $HTML;
2062     $first = 0;
2063     $num = $num_d;
2064     $s = '';
2065     $html = '';
2066     foreach $i (@{$output{$report}{'column'}}) {
2067       my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
2068       $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
2069       my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
2070       $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
2071
2072       my ($v1, $v2);
2073       $v1 = defined $$i{'format_total'} ? $$i{'format_total'} :
2074         (defined $$i{'format'} ? $$i{'format'} : "%s");
2075       $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2076       $v2 = $$i{'total'} ||
2077         die "Error in section $report column $$i{'name'}. " .
2078           "Need a 'total' field.\n";
2079       $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2080       my $r = '';
2081       if ($v2) {
2082         $r = &EvalExpr ($v2, $key2, $num, 1);
2083         die "Error in section $report column $$i{'name'}. " .
2084           "Invalid 'total' value.\n" unless defined $r;
2085       }
2086       $s .= sprintf $v1 . " ", $r if $wtext && $first != 1;
2087       if ($HTML && $whtml) {
2088         my $temp = $first ? "RIGHT" : "LEFT";
2089         $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
2090         $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2091         $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first;
2092         $html .= $first == 1 ? "<TD></TD>" :
2093                  sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2094       }
2095       $first++;
2096     }
2097     $s =~ s/\s*$//;
2098     $s =~ s/\\n//g;
2099     print "$s\n" if $TEXT;
2100     print HTML "<TR>$html</TR>\n</TABLE>\n</CENTER>\n<P>\n<HR>\n" if $HTML;
2101   }
2102   else {
2103     # foreach $key (sort { local $^W = 0; no strict; eval $h } (keys (%d)))
2104     foreach $key ((eval "sort {local \$^W = 0; no strict; $h} (keys (%d))")) {
2105       next unless defined $key;
2106       next unless defined $d{$key}; # to avoid problems after some undef()
2107       $num++;
2108       next unless $num <= $TOP_HTML || $TOP_HTML == -1 ||
2109                   $num <= $TOP_TEXT || $TOP_TEXT == -1;
2110       my $first = 0;
2111       foreach $i (@{$output{$report}{'column'}}) {
2112         my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
2113         $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
2114         my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
2115         $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
2116
2117         my ($v1, $v2);
2118         $v1 = defined ($$i{'format'}) ? $$i{'format'} : "%s";
2119         $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2120         $v2 = $$i{'value'};
2121         $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2122         my $r ='';
2123         if ($v2) {
2124           $r = &EvalExpr ($v2, $key, $num);
2125           die "Error in section $report column $$i{'name'}. " .
2126             "Invalid 'value' value.\n" unless defined $r;
2127         }
2128         $s .= sprintf $v1 . " ", $r
2129           if $wtext && (($num <= $TOP_TEXT) || ($TOP_TEXT == -1));
2130         if ($HTML && $whtml && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
2131           $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2132           $html .= "<TH ALIGN=\"CENTER\">$num</TH>" if $numbering && !$first;
2133           my $temp = $first ? "RIGHT" : "LEFT";
2134           $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2135         }
2136         $first++;
2137       }
2138       $s =~ s/\s*$//;
2139       print "$s\n" if $TEXT && ($num <= $TOP_TEXT || $TOP_TEXT == -1);
2140       $s = '';
2141       if ($HTML && ($num <= $TOP_HTML || $TOP_HTML == -1)) {
2142         print HTML "<TR>$html</TR>\n";
2143         $html = '';
2144       }
2145     }
2146     print "\n" if $TEXT;
2147     print HTML "<TR><TD></TD></TR>\n" if $HTML;
2148     $first = 0;
2149     foreach $i (@{$output{$report}{'column'}}) {
2150       my $wtext = defined $$i{'text'} ? $$i{'text'} : 1;
2151       $wtext = $wtext =~ m/^(1|true)$/io ? 1 : 0;
2152       my $whtml = defined $$i{'html'} ? $$i{'html'} : 1;
2153       $whtml = $whtml =~ m/^(1|true)$/io ? 1 : 0;
2154
2155       my ($v1, $v2);
2156       $v1 = defined ($$i{'format_total'}) ? $$i{'format_total'} :
2157         (defined ($$i{'format'}) ? $$i{'format'} : "%s");
2158       $v1 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2159       $v2 = $$i{'total'} ||
2160         die "Error in section $report column $$i{'name'}. " .
2161           "Need a 'total' field.\n";
2162       $v2 =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2163       my $r = '';
2164       if ($v2) {
2165         $r = &EvalExpr ($v2, $key, $num);
2166         die "Error in section $report column $$i{'name'}. " .
2167           "Invalid 'total' value.\n" unless defined $r;
2168       }
2169       $s .= sprintf $v1 . " ", $r if $wtext;
2170       if ($HTML && $whtml) {
2171         $v1 =~ s/\%-?(?:\d+(?:\.\d+)?)?s/\%s/g;
2172         my $temp = $first ? "RIGHT" : "LEFT";
2173         $temp .= "\" COLSPAN=\"2" if $numbering && !$first;
2174         $v1 =~ s|(.*)|<STRONG>$1</STRONG>|o unless $first;
2175         $html .= sprintf "<TD ALIGN=\"$temp\">$v1</TD>", $r;
2176       }
2177       $first++;
2178     }
2179     $s =~ s/\s*$//;
2180     print "$s\n" if $TEXT;
2181     if ($HTML) {
2182       print HTML "<TR>$html</TR>\n";
2183       print HTML "</TABLE>\n</CENTER><P>\n";
2184
2185       my $i = 0;
2186       while ($GRAPH && defined ${${$output{$report}{'graph'}}[$i]}{'type'}) {
2187         my $type = ${${$output{$report}{'graph'}}[$i]}{'type'};
2188         my ($title) = ${${$output{$report}{'graph'}}[$i]}{'title'} =~
2189                        m/^\"\s*(.*?)\s*\"$/o;
2190         if ($type eq 'histo3d') {
2191           my (@values, @colors, @labels);
2192           my $num = 0;
2193           my $j;
2194           foreach $j (@{${${$output{$report}{'graph'}}[$i]}{'data'}}) {
2195             $num++;
2196             my ($h) = $$j{'value'} =~ m/^\"\s*(.*?)\s*\"$/o;
2197             my %hh;
2198             $h =~ s/^\%/\%$CLASS\:\:/ unless $h eq '%prog_type';
2199             { local $^W = 0; no strict; %hh = eval $h }
2200             push @values, \%hh;
2201             my ($t) = $$j{'name'} =~ m/^\"\s*(.*?)\s*\"$/o;
2202             push @labels, $t;
2203             $t = $$j{'color'} ||
2204               die "Error in section $report section 'graph'. " .
2205                 "No color specified for 'value' $$j{'value'}.\n";
2206             $t =~ s/^\"\s*\#(.*?)\s*\"$/$1/o;
2207             $t =~ m/^[\da-fA-F]{6}$/o ||
2208               die "Error in section $report section 'graph'. " .
2209                 "Bad color for 'value' $$j{'value'}.\n";
2210             my @c = map { hex $_ } ($t =~ m/^(..)(..)(..)$/);
2211             push @colors, \@c;
2212           }
2213           $suffix = '' unless defined $suffix;
2214           my $s = ($i ? $i : '') . $suffix;
2215           print HTML "<CENTER><IMG ALT=\"$title\" ";
2216           close HTML;
2217           my $y = &Graph3d ("$IMG_dir/$report$s.$GD_FORMAT",
2218                     $title, $xmax, $num, @values, \@colors, \@labels);
2219           open (HTML, ">> $HTML_output") ||
2220             die "Error: cant open $HTML_output\n";
2221           print HTML "WIDTH=\"$xmax\" HEIGHT=\"$y\" ";
2222           print HTML "SRC=\"$IMG_pth$report$s.$GD_FORMAT\"></CENTER>\n";
2223         }
2224         elsif ($type eq 'histo') {
2225           my (%values, %labels);
2226           my $factor =
2227             ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'factor'}
2228              || die "Error in section $report section 'graph'. " .
2229                "No factor specified for 'value' " .
2230                ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
2231                ".\n";
2232           $factor =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2233           my $labelx =
2234             ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'}
2235              || die "Error in section $report section 'graph'. " .
2236                "No name specified for value.\n";
2237           $labelx =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2238           my $labely =
2239             ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'}
2240              || die "Error in section $report section 'graph'. " .
2241                "No name specified for value.\n";
2242           $labely =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2243           my $t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'value'}
2244              || die "Error in section $report section 'graph'. " .
2245                "No 'value' specified for " .
2246                ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[0]}{'name'} .
2247                ".\n";
2248           $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2249           $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
2250           { local $^W = 0; no strict; %labels = eval $t }
2251
2252           $t = ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'value'} ||
2253              die "Error in section $report section 'graph'. " .
2254                "No 'value' specified for " .
2255                ${${${${$output{$report}{'graph'}}[$i]}{'data'}}[1]}{'name'} .
2256                ".\n";
2257           $t =~ s/^\"\s*(.*?)\s*\"$/$1/o;
2258           $t =~ s/^\%/\%$CLASS\:\:/ unless $t eq '%prog_type';
2259           { local $^W = 0; no strict; %values = eval $t }
2260           my $s = ($i ? $i : '') . $suffix;
2261           {
2262             my $r;
2263             close HTML;
2264             $r = &Histo ("$IMG_dir/$report$s.$GD_FORMAT", $title, $xmax,
2265                          $factor, $labelx, $labely, \%values, \%labels);
2266             open (HTML, ">> $HTML_output") ||
2267               die "Error: cant open $HTML_output\n";
2268             print HTML "<CENTER><IMG ALT=\"$title\" WIDTH=\"$xmax\" " .
2269               "SRC=\"$IMG_pth$report$s.$GD_FORMAT\"></CENTER>\n" if $r;
2270           }
2271         }
2272         elsif ($type eq 'piechart') {
2273           print "Sorry, graph type 'piechart' not supported yet..\n";
2274         }
2275         else {
2276           die "Error in section $report section 'graph'. " .
2277             "Invalid 'type' value.\n"
2278         }
2279         $i++;
2280         print HTML "<P>\n";
2281       }
2282       print HTML "\n<HR>\n";
2283     }
2284   }
2285   close HTML if $HTML;
2286 }
2287
2288 sub EvalExpr {
2289   my $v = shift;
2290   my ($key, $num, $key1) = @_;
2291   my $key2;
2292
2293   $v =~ s/\n/ /smog;
2294   $v =~ s/^\"(.*?)\"$/$1/o;
2295   if ($key1) {
2296     $key2 = $key;
2297     $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotalDouble\(\\%/og;
2298   }
2299   else {
2300     $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%/$1&ComputeTotal\(\\%/og;
2301     # $v =~ s/([^a-zA-Z_\-]?)total\s*\(\s*%([^\)]*)\)/$1&ComputeTotal\("$2"\)/og;
2302   }
2303   $v =~ s/([^a-zA-Z_\-]?)bytes\s*\(\s*/$1&NiceByte\(/og;
2304   $v =~ s/([^a-zA-Z_\-]?)time\s*\(\s*/$1&second2time\(/og;
2305   $v =~ s/([^a-zA-Z_\-]?)time_ms\s*\(\s*/$1&ms2time\(/og;
2306   # $v =~ s/([\$\%\@])/$1${CLASS}\:\:/og;
2307   $v =~ s/([\$\%\@])([^{\s\d])/$1${CLASS}\:\:$2/og;
2308   $v =~ s/([\$\%\@])${CLASS}\:\:(prog_(?:size|type)|key|sec_glob|num)/$1$2/og;
2309   my $r;
2310   # eval { local $^W = 0; no strict; ($r) = eval $v; };
2311   eval " local \$^W = 0; no strict; (\$r) = $v; ";
2312   $r = 0 unless defined $r;
2313   $r;
2314 }
2315
2316 sub NiceByte {
2317   my $size = shift;
2318   my $t;
2319
2320   $size = 0 unless defined $size;
2321   $t = $size / 1024 / 1024 / 1024 > 1 ?
2322     sprintf "%.1f GB", $size / 1024 / 1024 / 1024 :
2323       ($size / 1024 / 1024 > 1 ? sprintf "%.1f MB", $size / 1024 / 1024 :
2324         sprintf "%.1f KB", $size / 1024);
2325   return $t;
2326 }
2327
2328 sub kb2i {
2329   my $s = shift;
2330   my ($i, $u) = $s =~ m/^(\S+) (\S+)$/;
2331   $i *= 1024 * 8 if $u =~ m/MB/o;
2332   $i *= 1024 * 1024 * 8 if $u =~ m/GB/o;
2333   return $i;
2334 }
2335
2336 sub Decode_Config_File {
2337   my $file = shift;
2338   my ($line, $section);
2339   my $linenum = 0;
2340   my $info;
2341   my @list;
2342   open (FILE, "$file") || die "Can\'t open config file \"$file\". Abort.\n";
2343   while (defined ($line = <FILE>)) {
2344     $linenum++;
2345     last if eof (FILE);
2346     ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2347     die "Error in $file line $linenum: must be 'section' instead of '$info'\n"
2348       unless ($info eq 'section');
2349     ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2350     die "Error in $file line $linenum: invalid section name '$info'\n"
2351       unless $info =~ /^\w+$/;
2352     print "section $info {\n" if $DEBUG;
2353     $section = $info;
2354     ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2355     die "Error in $file line $linenum: must be a '{' instead of '$info'\n"
2356       unless ($info eq '{');
2357     ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2358     push @list, $section;
2359     while ($info ne '}') { # it is a block
2360       last if eof (FILE);
2361       my $keyword = $info;
2362       ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2363       my $value = $info;
2364       if ($info eq '{') { # it is a sub-block
2365         my @a;
2366         $output{$section}{$keyword} = \@a unless $output{$section}{$keyword};
2367         my %hash;
2368         print "\t$keyword {\n" if $DEBUG;
2369         ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2370         my @sublist; # to store the "data" blocks
2371
2372         while ($info ne '}') {
2373           last if eof (FILE);
2374           my $subkeyword = $info;
2375           ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2376           my $subvalue = $info;
2377           if ($info eq '{') {
2378             # it is a sub-sub-block
2379             my %subhash;
2380             print "\t\t$subkeyword {\n" if $DEBUG;
2381             my @b;
2382             $hash{$subkeyword} = \@b unless ${hash}{$subkeyword};
2383             ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2384             while ($info ne '}') {
2385               last if eof (FILE);
2386               my $subsubkeyword = $info;
2387               ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2388               my $subsubvalue = $info;
2389               if ($info eq '{') {
2390                 die "Error in $file line $linenum: too many blocks.\n";
2391               }
2392               else {
2393                 ($info, $linenum, $line) =
2394                   &read_conf ($linenum, $line, \*FILE);
2395                 die "Error in $file line $linenum: must be a ';' instead " .
2396                   "of '$info'\n" unless ($info eq ';');
2397                 print "\t\t\t$subsubkeyword\t$subsubvalue;\n" if $DEBUG;
2398                 $subhash{$subsubkeyword} = $subsubvalue;
2399                 ($info, $linenum, $line) =
2400                   &read_conf ($linenum, $line, \*FILE);
2401               }
2402             }
2403             ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2404             die "Error in $file line $linenum: must be a ';' instead of " .
2405               "'$info'\n" unless $info eq ';';
2406             push @{$hash{$subkeyword}} , \%subhash;
2407             ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2408             print "\t\t};\n" if $DEBUG;
2409           }
2410           else {
2411             ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2412             die "Error in $file line $linenum: must be a ';' instead " .
2413               "of '$info'\n" unless $info eq ';';
2414             print "\t\t$subkeyword\t$subvalue;\n" if $DEBUG;
2415             $hash{$subkeyword} = $subvalue;
2416             ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2417           }
2418         }
2419         ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2420         die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
2421           unless $info eq ';';
2422         push @{$output{$section}{$keyword}}, \%hash;
2423         ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2424         print "\t};\n" if $DEBUG;
2425       }
2426       else {
2427         ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2428         die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
2429           unless $info eq ';';
2430         print "\t$keyword\t$value;\n" if $DEBUG;
2431         $output{$section}{$keyword} = $value;
2432         ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2433       }
2434     }
2435     die "Error in $file line $linenum: must be a '}' instead of '$info'\n"
2436       unless $info eq '}';
2437     ($info, $linenum, $line) = &read_conf ($linenum, $line, \*FILE);
2438     die "Error in $file line $linenum: must be a ';' instead of '$info'\n"
2439       unless $info eq ';';
2440     print "};\n\n" if $DEBUG;
2441   }
2442   close FILE;
2443   $output{'_order_'} = \@list;
2444 }
2445
2446 sub read_conf {
2447   my ($linenum, $line, $file) = @_;
2448   *FILE = *$file;
2449
2450   $line =~ s,^\s+,,o;            # remove useless blanks
2451   $line =~ s,^(\#|//).*$,,o;     # remove comments (at the beginning)
2452   while (($line =~ m/^$/o || $line =~ m/^\"[^\"]*$/o) && !(eof (FILE))) {
2453     $line .= <FILE>;             # read one line
2454     $linenum++;
2455     $line =~ s,^\s*,,om;         # remove useless blanks
2456     $line =~ s,^(\#|//).*$,,om;  # remove comments (at the beginning)
2457   }
2458   $line =~ s/^(                  # at the beginning
2459                [{};]             # match '{', '}', or ';'
2460               |                  # OR
2461                \"                # a double quoted string
2462                 (?:\\.|[^\"\\])*
2463                \"
2464               |                  # OR
2465                [^{};\"\s]+       # a word
2466              )\s*//mox;
2467   my $info = $1;
2468   if (defined $info && $info) {
2469     chomp $info;
2470   }
2471   else {
2472     warn "Syntax error in conf file line $linenum.\n";
2473   }
2474   return ($info, $linenum, $line);
2475 }
2476
2477 sub GetValue {
2478   my $v = shift;
2479   my ($r) = $v =~ m/^(?:\"\s*)?(.*?)(?:\s*\")?$/so;
2480   return $r;
2481 }
2482
2483 sub Usage {
2484   my ($base) = $0 =~ /([^\/]+)$/;
2485   print "Usage: $base -f innreport.conf [-[no]options]\n";
2486   print "  where options are:\n";
2487   print "    -h (or -help)       this help page\n";
2488   print "    -v                  display the version number of INNreport\n";
2489   print "    -config             print INNreport configuration information\n";
2490   print "    -html               HTML output";
2491   print " [default]" if ($HTML);
2492   print "\n";
2493   print "    -g                  want graphs";
2494   print " [default]" if ($GRAPH);
2495   print "\n";
2496   print "    -graph              an alias for option -g\n";
2497   print "    -d directory        directory for Web pages";
2498   print "\n                        [default=$HTML_dir]"
2499     if (defined ($HTML_dir));
2500   print "\n";
2501   print "    -dir directory      an alias for option -d\n";
2502   print "    -p directory        pictures path (file space)";
2503   print "\n                        [default=$IMG_dir]"
2504     if (defined ($IMG_dir));
2505   print "\n";
2506   print "    -path directory     an alias for option -p\n";
2507   print "    -w directory        pictures path (web space)";
2508   print " [default=$IMG_pth]" if (defined ($IMG_pth));
2509   print "\n";
2510   print "    -webpath directory  an alias for option -w\n";
2511   print "\n";
2512   print "    -i file             Name of index file";
2513   print " [default=$index]" if (defined ($index));
2514   print "\n";
2515   print "    -index file         an alias for option -i\n";
2516   print "    -a                  want to archive HTML results";
2517   print " [default]" if ($ARCHIVE);
2518   print "\n";
2519   print "    -archive            an alias for option -a\n";
2520   print "    -c number           how many report files to keep (0 = all)\n";
2521   print "                        [default=$CYCLE]"
2522     if (defined ($CYCLE));
2523   print "\n";
2524   print "    -cycle number       an alias for option -c\n";
2525   print "    -s char             separator for filename";
2526   print " [default=\"$SEPARATOR\"]\n";
2527   print "    -separator char     an alias for option -s\n";
2528   print "    -unknown            \"Unknown entries from news log file\"\n";
2529   print "                        report";
2530   print " [default]" if ($WANT_UNKNOWN);
2531   print "\n";
2532   print "    -html-unknown       Same as above, but in generated HTML output.";
2533   print " [default]" if ($WANT_UNKNOWN);
2534   print "\n";
2535   print "    -maxunrec           Max number of unrecognized lines to display\n";
2536   print "                        [default=$MAX_UNRECOGNIZED]"
2537     if (defined ($MAX_UNRECOGNIZED));
2538   print "\n";
2539   print "    -notdaily           Never perform daily actions";
2540   print " [default]" if $NOT_DAILY;
2541   print "\n";
2542   print "    -casesensitive      Case sensitive";
2543   print " [default]" if ($CASE_SENSITIVE);
2544   print "\n\n";
2545   print "Use no in front of boolean options to unset them.\n";
2546   print "For example, \"-html\" is set by default. Use \"-nohtml\" to remove this\n";
2547   print "feature.\n";
2548   exit 0;
2549 }
2550
2551 sub Version {
2552   print "\nThis is INNreport version $version\n\n";
2553   print "Copyright 1996-1999, Fabien Tassin <fta\@sofaraway.org>\n";
2554   exit 0;
2555 }
2556
2557 sub Summary {
2558   use Config;
2559
2560   # Convert empty arguments into null string ("")
2561   my $i = 0;
2562   foreach (@old_argv) {
2563     $old_argv[$i] = '""' if $_ eq '';
2564     $i++;
2565   }
2566
2567   # Display the summary
2568   print "\nSummary of my INNreport (version $version) configuration:\n";
2569   print "  General options:\n";
2570   print "    command line='@old_argv' (please, check this value)\n";
2571   print "    html=" . ($HTML?"yes":"no") . ", graph=" .
2572                       ($GRAPH?"yes":"no") . ", haveGD=" .
2573                       ($::HAVE_GD?"yes":"no") . "\n";
2574   print "    archive=" . ($ARCHIVE?"yes":"no") .
2575                       ", cycle=$CYCLE, separator=\"" . $SEPARATOR . "\"\n";
2576   print "    case_sensitive=" .
2577                       ($CASE_SENSITIVE?"yes":"no") . ", want_unknown=" .
2578                       ($WANT_UNKNOWN?"yes":"no") .
2579                       ", max_unrecog=$MAX_UNRECOGNIZED\n";
2580   print "  Paths:\n";
2581   print "    html_dir=$HTML_dir\n";
2582   print "    img_dir=$IMG_dir\n";
2583   print "    img_pth=$IMG_pth\n";
2584   print "    index=$index\n";
2585   print "  Platform:\n";
2586   print "    perl version $::Config{baserev} "
2587             . "patchlevel $::Config{patchlevel} "
2588             . "subversion $::Config{subversion}\n";
2589   print "    libperl=$::Config{libperl}, useshrplib=$::Config{useshrplib}, "
2590        . "bincompat3=$::Config{bincompat3}\n";
2591   print "    osname=$::Config{osname}, osvers=$::Config{osvers}, "
2592         . "archname=$::Config{archname}\n";
2593   print "    uname=$::Config{myuname}\n\n";
2594
2595   exit 0;
2596 }
2597
2598 ######################### End of File ##########################