#
# logger.pl: logger functions!
# Author: dms
-# Version: 19991205
+# 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 $infobot_pid
- $statcountfix $addressed);
+use vars qw($statcount $bot_pid $forkedtime $statcountfix $addressed);
+use vars qw($logDate $logold $logcount $logtime $logrepeat);
use vars qw(@backlog);
use vars qw(%param %file);
require 5.001;
+$logtime = time();
+$logcount = 0;
+$logrepeat = 0;
+$logold = "";
+
+$param{VEBOSITY} ||= 1; # lame fix for preload
+
my %attributes = (
'clear' => 0,
'reset' => 0,
return unless (&IsParam("logfile"));
$file{log} = $param{'logfile'};
+ my $error = 0;
+ my $path = &getPath($file{log});
+ while (! -d $path) {
+ if ($error) {
+ &ERROR("openLog: failed opening log to $file{log}; disabling.");
+ delete $param{'logfile'};
+ return;
+ }
+
+ &status("openLog: making $path.");
+ last if (mkdir $path, 0755);
+ $error++;
+ }
+
if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
my ($day,$month,$year) = (localtime(time()))[3,4,5];
$logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
if (open(LOG, ">>$file{log}")) {
&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 (defined fileno LOG);
- $loggingstatus = 0;
- &status("Closed logfile ($file{log}).");
close LOG;
+ &status("Closed logfile ($file{log}).");
}
#####
sub WARN {
return unless (&IsParam("WARN"));
+ return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
+
&status("${b_yellow}!WARN!$ob $_[0]");
}
sub FIXME {
- &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN)");
+ &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN?)");
+}
+
+sub TODO {
+ &status("${b_cyan}!TODO!$ob $_[0]");
}
sub VERB {
my($input) = @_;
my $status;
- # return if input is null'ish.
- return '' if ($input =~ /^\s*$/);
+ if ($input eq $logold) {
+ $logrepeat++ unless (/!WARN! PERL: Use of uninitialized/);
+
+ if ($logrepeat >= 3) {
+ $logrepeat = 0;
+ &status("LOG: repeat throttle.");
+ sleep 1;
+ }
+ }
+ $logold = $input;
+
+ # if it's not a scalar, attempt to warn and fix.
+ if (ref($input) ne "") {
+ &status("status: 'input' is not scalar (".ref($input).").");
+ if (ref($input) eq "ARRAY") {
+ foreach (@$input) {
+ &WARN("status: '$_'.");
+ }
+ }
+ }
+
+ # Something is using this w/ NULL.
+ if (!defined $input or $input =~ /^\s*$/) {
+ $input = "Blank status call?";
+ }
$input =~ s/\n+$//;
$input =~ s/\002|037//g; # bold,video,underline => remove.
$statcount++;
# fix style of output if process is child.
- if (defined $infobot_pid and $$ != $infobot_pid and !defined $statcountfix) {
+ if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
$statcount = 1;
$statcountfix = 1;
}
- # for logging and non-ansi control.
+ ### 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?
+ $logcount++;
+ } else {
+ sleep 1;
+ &status("LOG: Throttling."); # recursive?
+ $reset++;
+ }
+ }
+ if ($reset) {
+ $logtime = $time;
+ $logcount = 0;
+ }
+
+ # Log differently for forked/non-forked output.
if ($statcountfix) {
$status = "!$statcount! ".$input;
if ($statcount > 1000) {
print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
+ print LOG "VERB: ".(&Time2String(time() - $forkedtime))."\n";
exit 0;
}
} else {
} else {
print "$printable\n";
}
+ } else {
+ print "VERBOSITY IS OFF?\n";
}
# log the line into a file.
return unless (&IsParam("logfile"));
- return unless ($loggingstatus);
+ return unless (defined fileno LOG);
# remove control characters from logging.
$input =~ s/\e\[[0-9;]+m//g;
print LOG sprintf("%s %s\n", $date, $input);
}
+sub openSQLDebug {
+ if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
+ &ERROR("cannot open $param{'SQLDebug'}...");
+ delete $param{'SQLDebug'};
+ return 0;
+ }
+
+ &status("Opened SQL Debug file: $param{'SQLDebug'}");
+ return 1;
+}
+
+sub closeSQLDebug {
+ close SQLDEBUG;
+
+ &status("Closed SQL Debug file: $param{'SQLDebug'}");
+}
+
1;