archie/release/scripts/prospero-stats.pl

#!/usr/local/bin/perl
# -*- perl -*-
#
# Archie-stats.pl - gather Archie statistics and print them out.
#
#	1995 (c) Bunyip Information Systems Inc. 
#	         written by Luc Boulianne <lucb@bunyip.com>
#
# $Id: prospero-stats.pl,v 1.2 1995/03/12 22:53:41 lucb Exp $
#

;# require "getopts.pl";
;# Actual routine has been appended at the end of this file.
;# Several sites did not have perl properly set up.

& Getopts("hs:");

if (defined($opt_h)) {
print "archie-stats - examine logfiles and produce a summary report
usage: archie-stats [-h] [-s servername] < logfile
        -h              this message
        -s servernname  over-ride local hostname
";
exit;
}

if (defined($opt_s)) {
        $server = $opt_s;
}

if ($server eq "") {
        chop($server = `hostname`);
}

$date = time;
chop $date;
printf "#\n# Archie Statistics Report\n#\n";
printf "# server: %s\n", $server;
printf "# local : %s\n", &strtime(localtime($date));
printf "# utc   : %s\n", &strtime(gmtime($date));

%month = 
  (Jan,'01',Feb,'02',Mar,'03',Apr,'04',May,'05',Jun,'06',
   Jul,'07',Aug,'08',Sep,'09',Oct,10,Nov,11,Dec,12);

%searchtypes = (
                '=', exact,
                'R', regex,
                'r', 'exact regex',
                'X', 'string only regex',
                'x', 'string only exact regex',
                'C', subcase,
                'c', 'exact subcase',
                'K', 'string only subcase',
                'k', 'string only exact subcase',
                'S', substring,
                's', 'exact substring',
                'Z', 'string only substring',
                'z', 'string only exact substring',
                'n', 'string only exact',
                );

printf "# date@time str rqs| ";
foreach $type (sort keys(%searchtypes)) {
    printf "%s ", $type;
}
printf "   |exn rxmt cach mtchs time  q\n";
print '#', '-' x 79, "\n";

$prevdhkey = "";
sub report {
    local ($key) = @_;
    local ($date,$hour) = split('@',$key);
    local ($i);

    printf "%s@%s00 ", $date, $hour;
    printf "%s",  $startups{$key}==0 ? "-" : $startups{$key};
    printf " %4d |", $requests{$key};
    $buf = "";
    foreach $type (sort keys(%searchtypes)) {
	if ($buf ne "") { $buf .= " "};
        $i = int($subrequests{$key,$type});
        $buf .= sprintf("%s", $i==0 ? "-" : $i);
    }
    
    printf "%-32s|", $buf;
    printf "%3d ", $expands{$key};
    printf "%4d ", $retrans{$key};
    printf "%3d ", $cached{$key};
    printf "%6d ", $matches{$key};
    printf "%4.1f ", $total_time{$key}/$time_ests{$key};
    printf "%2s\n",  $queued{$key}==0 ? "-" : $queued{$key};

}

while (<>) {
    # Build our key
    chop;
    next if ! (/^(..)-(...)-(..).*/o);
    ($day,$time,$host,$rest) = split(' ',$_,4);
    ($di,$dm,$dy) = split('-',$day);
    $day = sprintf("%02d",$dy) . $month{$dm} . sprintf("%02d",$di);
    $dhkey = $day . "@" . substr($time,0,2);
    if (($dhkey ne $prevdhkey) && ($prevdhkey ne "")) {
        &report($prevdhkey);
	$lastrep = $prevdhkey;
    } 
    $prevdhkey = $dhkey;

    if ($rest =~ "ARCHIE/MATCH") {
        $cmd = (split("/",$rest,3))[1];
        $type = substr($cmd,rindex($cmd,",")+1,1);
        $requests{$dhkey} += 1;
        $subrequests{$dhkey,$type} += 1;
        next;
    }
    if ($rest =~ "ARCHIE/HOST") {
        $expands{$dhkey} += 1;
        next;
    }
    if ($rest =~ "Retransmitting") {
        $retrans{$dhkey} += 1;
        next;
    }
    if ($rest =~ "matches") {
        $matches{$dhkey} += (split(":", $rest))[1];
        next;
    }
    if ($host =~ "matches") {   # Old server
        $matches{$dhkey} += $rest;
        next;
    }
    if ($rest =~ "Responding") { # Old server (cached data)
        $cached{$dhkey} += 1;
        next;
    }
    if ($host =~ "Responding") { # Old server (cached data)
        $cached{$dhkey} += 1;
        next;
    }
    if ($rest =~ "Est time:") { 
        $total_time{$dhkey} += (split(":",$rest,2))[1];
        $time_ests{$dhkey} += 1;
        next;
    }
    if (($rest =~ "Queued") && !($rest =~ "Priority")) { 
	# printf "[%s]\n",$rest;
	if ($rest =~ "of") {
	    # printf "{%s}",((split(/\s/,$rest,6))[4]);
	    $queued{$dhkey} = &MAX($queued{$dhkey},(split(/\s/,$rest,6))[4]);
	} else {
	    $queued{$dhkey} = &MAX($queued{$dhkey},(split(/\s/,$rest,4))[2]);
	}
        next;
    }
    if (($host =~ "Startup")) {
        $startups{$dhkey} += 1;
        next;
    }
}

if ($dhkey ne $lastrep) {
     &report($prevdhkey);
} 

sub MAX {
    local($max) = pop(@_);
    foreach $foo (@_) {
          $max = $foo if $max < $foo;
    }
    $max;
}

sub strtime {
    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;
    local(@DoW) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    local(@MoY) = ('Jan','Feb','Mar','Apr','May','Jun',
	           'Jul','Aug','Sep','Oct','Nov','Dec');
    local($[) = 0;

    $year += ($year < 70) ? 2000 : 1900;
    sprintf("%s %s %2d %02d:%02d:%02d %s%4d",
      $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
}

;# getopts.pl - a better getopt.pl
;#  	        getops.pl (c) Part of the Perl distribution
;#
;# Included here for portability...[lucb@bunyip.com]
;#
;# Usage:
;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
;#                           #  side effect.

sub Getopts {
    local($argumentative) = @_;
    local(@args,$_,$first,$rest);
    local($errs) = 0;
    local($[) = 0;

    @args = split( / */, $argumentative );
    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        $pos = index($argumentative,$first);
        if($pos >= $[) {
            if($args[$pos+1] eq ':') {
                shift(@ARGV);
                if($rest eq '') {
                    ++$errs unless @ARGV;
                    $rest = shift(@ARGV);
                }
                eval "\$opt_$first = \$rest;";
            }
            else {
                eval "\$opt_$first = 1";
                if($rest eq '') {
                    shift(@ARGV);
                }
                else {
                    $ARGV[0] = "-$rest";
                }
            }
        }
        else {
            print STDERR "Unknown option: $first\n";
            ++$errs;
            if($rest ne '') {
                $ARGV[0] = "-$rest";
            }
            else {
                shift(@ARGV);
            }
        }
    }
    $errs == 0;
}