archie/release/B/scripts/trimplog.pl

#!/usr/tgcware/bin/perl
# -*- perl -*-
#
# trimplog.pl - perl script to trim log files.
#
#	1995 (c) Bunyip Information Systems Inc. 
#	         written by Luc Boulianne <lucb@bunyip.com>
#
# $Id: trimplog.pl,v 1.2 1995/03/12 22:53:40 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("hd:g:v");

if (defined($opt_h)) {
print "trimplog - split the pfs log file by day.
usage: trimplog [-h] [-d directory] [-g y|n]
        -h              this message
        -d directory    directory where to store the trimmed log files
        -g y|n          gzip is available? yes or no 
	-v 		verbose
";
exit;
}

if (defined($opt_v)) {
    $verbose="y";
}
if (defined($opt_d)) {
    $directory = $opt_d;
} else {
    $directory = ".";
}

if (defined($opt_g)) {
    if ($opt_g ne "y") {
	$compress = "";
	& debug ("gzip is not available\n");
    } else {
	$compress = "|gzip -c ";
	& debug ("gzip is available\n");
    }
} else {
    $compress = "";
}

%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');

$tag="";
$oday="";
while (<>) {
    if (/^(..)-(...)-(..).*/o) {
	$day = sprintf("%02d",$1); $mon = $2; $year = $3; 
	if ($day ne $oday) {
	    if ($tag ne "") {
		close (OUTLOG) || die "Can't close $logfile: $!";
	    }
	    $oday = $day;
	    $tag = $year.$month{$mon}.$day;
	    if ($compress eq "") {
		$logfile = $directory . "/pfs.log" . $tag ;
		$outlog=">> $logfile";
	    } else {
		$logfile = $directory . "/pfs.log" . $tag . ".gz";
		$outlog="$compress>> $logfile";
	    }
	    & debug ("$outlog\n");
	    open (OUTLOG, $outlog) || 
		die "Can't pipe/append to $outlog: $!";
	    # print STDERR $logfile,"\n";
	}
	print OUTLOG $_;
    } elsif (! /dirsrv: Bad recvfrom n = -1 errno = 9 Bad file number/) {
	if ($tag ne "") {
	    print OUTLOG $_;
	}
    }
}

;# 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;
}


sub debug {
    local($string) = @_;

    if ($verbose eq "y") {
	print $string;
    }
}