archie/release/B/scripts/trimplog.pl

145 lines
3.3 KiB
Perl
Raw Normal View History

2024-05-28 19:25:49 +02:00
#!/usr/tgcware/bin/perl
2024-05-27 20:18:02 +02:00
# -*- 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;
}
}