#
# logger.pl: logger functions!
# Author: dms
-# Version: v0.3 (20000731)
+# Version: v0.4 (20000923)
# FVersion: 19991205
# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
#
use strict;
-use vars qw($logDate $loggingstatus $statcount $bot_pid $forkedtime
- $statcountfix $addressed $logcount $logtime);
+use vars qw($statcount $bot_pid $forkedtime $statcountfix $addressed);
+use vars qw($logDate $logold $logcount $logtime $logrepeat $running);
use vars qw(@backlog);
-use vars qw(%param %file);
-
-require 5.001;
+use vars qw(%param %file %cache);
$logtime = time();
$logcount = 0;
+$logrepeat = 0;
+$logold = '';
+
+$param{VEBOSITY} ||= 1; # lame fix for preload
my %attributes = (
'clear' => 0,
$b_yellow $_yellow $b_blue $_blue $b_magenta $_magenta
$b_cyan $_cyan $b_white $_white $_reset $_bold $ob $b);
-$b_black = cl('bold black'); $_black = cl('black');
+$b_black = cl('bold black'); $_black = cl('black');
$b_red = cl('bold red'); $_red = cl('red');
$b_green = cl('bold green'); $_green = cl('green');
$b_yellow = cl('bold yellow'); $_yellow = cl('yellow');
# logging support.
sub openLog {
- return unless (&IsParam("logfile"));
+ return unless (&IsParam('logfile'));
$file{log} = $param{'logfile'};
my $error = 0;
$error++;
}
- if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
- my ($day,$month,$year) = (localtime(time()))[3,4,5];
+ if (&IsParam('logType') and $param{'logType'} =~ /DAILY/i) {
+ my ($day,$month,$year) = (gmtime time())[3,4,5];
$logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
- $file{log} .= "-".$logDate;
+ $file{log} .= $logDate;
}
if (open(LOG, ">>$file{log}")) {
+ binmode(LOG, ":utf8");
&status("Opened logfile $file{log}.");
LOG->autoflush(1);
- $loggingstatus = 1;
} else {
- &status("cannot open logfile $file{log}; disabling.");
- $loggingstatus = 0;
+ &status("Cannot open logfile ($file{log}); not logging: $!");
}
}
sub closeLog {
# lame fix for paramlogfile.
- return unless (&IsParam("logfile"));
- return unless ($loggingstatus);
+ return unless (&IsParam('logfile'));
+ return unless (defined fileno LOG);
- $loggingstatus = 0;
- &status("Closed logfile ($file{log}).");
close LOG;
+ &status("Closed logfile ($file{log}).");
}
#####
# Usage: &compress($file);
sub compress {
my ($file) = @_;
- my @compress = ("/usr/bin/bzip2","/bin/gzip");
+ my @compress = ('/usr/bin/bzip2','/bin/bzip2','/bin/gzip');
my $okay = 0;
if (! -f $file) {
- # ironically this does not get logged :)
&WARN("compress: file ($file) does not exist.");
return 0;
}
- if (-f "$file.gz" or -f "$file.bz2") {
+ if ( -f "$file.gz" or -f "$file.bz2" ) {
&WARN("compress: file.(gz|bz2) already exists.");
return 0;
}
}
sub DEBUG {
- return unless (&IsParam("DEBUG"));
+ return unless (&IsParam('DEBUG'));
&status("${b_green}!DEBUG!$ob $_[0]");
}
}
sub WARN {
- return unless (&IsParam("WARN"));
+ return unless (&IsParam('WARN'));
return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
}
sub FIXME {
- &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN?)");
+ &status("${b_cyan}!FIXME!$ob $_[0]");
}
sub TODO {
}
sub VERB {
- if (!&IsParam("VERBOSITY")) {
+ if (!&IsParam('VERBOSITY')) {
# NOTHING.
- } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
+ } elsif ($param{'VERBOSITY'} eq '1' and $_[1] <= 1) {
&status($_[0]);
- } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
+ } elsif ($param{'VERBOSITY'} eq '2' and $_[1] <= 2) {
&status($_[0]);
}
}
my($input) = @_;
my $status;
- # return if input is null'ish.
- return '' if ($input =~ /^\s*$/);
- $input =~ s/\n+$//;
- $input =~ s/\002|037//g; # bold,video,underline => remove.
+ if ($input =~ /PERL: Use of uninitialized/) {
+ &debug_perl($input);
+ return;
+ }
+
+ if ($input eq $logold) {
+ $logrepeat++;
+ return;
+ }
+
+ $logold = $input;
+ # if only I had followed how sysklogd does it, heh. lame me. -xk
+ if ($logrepeat >= 3) {
+ &status("LOG: last message repeated $logrepeat times");
+ $logrepeat = 0;
+ }
- # pump up the stats (or loglinenum).
+ # if it's not a scalar, attempt to warn and fix.
+ my $ref = ref $input;
+ if (defined $ref and $ref ne '') {
+ &WARN("status: 'input' is not scalar ($ref).");
+
+ if ($ref eq 'ARRAY') {
+ foreach (@$input) {
+ &WARN("status: '$_'.");
+ }
+ }
+ }
+
+ # Something is using this w/ NULL.
+ if (!defined $input or $input =~ /^\s*$/) {
+ $input = "ERROR: Blank status call? HELP HELP HELP";
+ }
+
+ for ($input) {
+ s/\n+$//;
+ s/\002|\037//g; # bold,video,underline => remove.
+ }
+
+ # does this work?
+ if ($input =~ /\n/) {
+ foreach (split /\n/, $input) {
+ &status($_);
+ }
+ }
+
+ # pump up the stats.
$statcount++;
# fix style of output if process is child.
### LOG THROTTLING.
### TODO: move this _after_ printing?
- my $time = time();
- my $reset = 0;
- if ($logtime != $time) {
- $reset++;
- } elsif ($logtime == $time) {
- if ($logcount < 25) { # too high?
+ my $time = time();
+ my $reset = 0;
+
+ # hrm... what is this supposed to achieve? nothing I guess.
+ if ($logtime == $time) {
+ if ($logcount < 25) { # too high?
$logcount++;
} else {
sleep 1;
- &status("LOG: Throttling."); # recursive?
+ &status("LOG: Throttling.");
$reset++;
}
+ } else { # $logtime != $time.
+ $reset++;
}
+
if ($reset) {
$logtime = $time;
$logcount = 0;
$status = "!$statcount! ".$input;
if ($statcount > 1000) {
print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
- print LOG "VERB: ".(&Time2String(time() - $forkedtime))."\n";
+ print LOG "VERB: ".(&Time2String($time - $forkedtime))."\n";
exit 0;
}
} else {
$status = "[$statcount] ".$input;
}
- if (&IsParam("backlog")) {
+ if (&IsParam('backlog')) {
push(@backlog, $status); # append to end.
shift(@backlog) if (scalar @backlog > $param{'backlog'});
}
- if (&IsParam("VERBOSITY")) {
+ if (&IsParam('VERBOSITY')) {
if ($statcountfix) {
- printf $_red."!%5d!".$ob." ", $statcount;
+ printf $_red."!%6d!".$ob." ", $statcount;
} else {
- printf $_green."[%5d]".$ob." ", $statcount;
+ printf $_green."[%6d]".$ob." ", $statcount;
}
- # three uberstabs to Derek Moeller.
+ # three uberstabs to Derek Moeller. I don't remember why but he
+ # deserved it :)
my $printable = $input;
if ($printable =~ s/^(<\/\S+>) //) {
} elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
# public action.
print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
+
} elsif ($printable =~ s/^(-\S+-) //) {
# notice
print "$_green$1 $printable$ob\n";
+
} elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
# message/private action from someone
print "$b_white$1$ob" if (defined $1);
print "$b_red$2 $printable$ob\n";
+
} elsif ($printable =~ s/^(>\S+<) //) {
# i'm messaging someone
print "$b_magenta$1 $printable$ob\n";
+
} elsif ($printable =~ s/^(enter:|update:|forget:) //) {
# something that should be SEEN
print "$b_green$1 $printable$ob\n";
+
} else {
print "$printable\n";
}
+
} else {
- print "VERBOSITY IS OFF?\n";
+ #print "VERBOSITY IS OFF?\n";
}
# log the line into a file.
- return unless (&IsParam("logfile"));
- return unless ($loggingstatus);
-
- # remove control characters from logging.
- $input =~ s/\e\[[0-9;]+m//g;
- $input =~ s/[\cA-\c_]//g;
+ return unless (&IsParam('logfile'));
+ return unless (defined fileno LOG);
+
+ # remove control characters from logging to LOGFILE.
+ for ($input) {
+ last if (&IsParam('logColors'));
+ s/\e\[[0-9;]+m//g; # escape codes.
+ s/[\cA-\c_]//g; # control chars.
+ }
$input = "FORK($$) ".$input if ($statcountfix);
my $date;
- if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
- $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]);
+ if (&IsParam('logType') and $param{'logType'} =~ /DAILY/i) {
+ $date = sprintf("%02d:%02d.%02d", (gmtime $time)[2,1,0]);
- my ($day,$month,$year) = (localtime(time()))[3,4,5];
+ my ($day,$month,$year) = (gmtime $time)[3,4,5];
my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
if (defined $logDate and $newlogDate != $logDate) {
&closeLog();
- &compress($file{log});
+ &compress( $file{log} );
&openLog();
}
} else {
- $date = time();
+ $date = $time;
}
- print LOG sprintf("%s %s\n", $date, $input);
+ printf LOG "%s %s\n", $date, $input;
+}
+
+sub debug_perl {
+ my ($str) = @_;
+
+ return unless ($str =~ /^WARN: Use of uninitialized value .* at (\S+) line (\d+)/);
+ my ($file,$line) = ($1,$2);
+ if (!open(IN,$file)) {
+ &status("WARN: cannot open $file: $!");
+ return;
+ }
+ binmode(IN, ":utf8");
+
+ # TODO: better filename.
+ open(OUT, ">>debug.log");
+ binmode(OUT, ":utf8");
+ print OUT "DEBUG: $str\n";
+
+ # note: cannot call external functions because SIG{} does not allow us to.
+ my $i;
+ while (<IN>) {
+ chop;
+ $i++;
+ # bleh. this tries to duplicate status().
+ # TODO: statcountfix
+ # TODO: rename to log_*someshit*
+ if ($i == $line) {
+ my $msg = "$file: $i:!$_";
+ printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg;
+ print OUT "DEBUG: $msg\n";
+ $statcount++;
+ next;
+ }
+ if ($i+3 > $line && $i-3 < $line) {
+ my $msg = "$file: $i: $_";
+ printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg;
+ print OUT "DEBUG: $msg\n";
+ $statcount++;
+ }
+ }
+ close IN;
+ close OUT;
}
sub openSQLDebug {
if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
- &ERROR("cannot open $param{'SQLDebug'}...");
+ &ERROR("Cannot open ($param{'SQLDebug'}): $!");
delete $param{'SQLDebug'};
return 0;
}
+ binmode(SQLDEBUG, ":utf8");
&status("Opened SQL Debug file: $param{'SQLDebug'}");
return 1;
&status("Closed SQL Debug file: $param{'SQLDebug'}");
}
+sub SQLDebug {
+ return unless (&IsParam('SQLDebug'));
+
+ return unless (fileno SQLDEBUG);
+
+ print SQLDEBUG $_[0]."\n";
+}
+
1;
+
+# vim:ts=4:sw=4:expandtab:tw=80
projects / infobot.git / blobdiff