X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Flogger.pl;h=5a8fd1a893c3db31de7e3053a4f9ecddfb531bea;hb=cb81fea9939f349b36e3b5a0cdc0343a6b781da1;hp=79f49d7cc6f17713c17527c399ef719c49f1dc12;hpb=3780524a411a9fb1618a26e49c40d36923b7afcc;p=infobot.git diff --git a/src/logger.pl b/src/logger.pl index 79f49d7..5a8fd1a 100644 --- a/src/logger.pl +++ b/src/logger.pl @@ -1,18 +1,24 @@ # # 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 $running); use vars qw(@backlog); -use vars qw(%param %file); +use vars qw(%param %file %cache); -require 5.001; +$logtime = time(); +$logcount = 0; +$logrepeat = 0; +$logold = ''; + +$param{VEBOSITY} ||= 1; # lame fix for preload my %attributes = ( 'clear' => 0, @@ -37,7 +43,7 @@ use vars qw($b_black $_black $b_red $_red $b_green $_green $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'); @@ -67,49 +73,60 @@ sub cl { # logging support. sub openLog { - return unless (&IsParam("logfile")); + return unless (&IsParam('logfile')); $file{log} = $param{'logfile'}; - if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) { - my ($day,$month,$year) = (localtime(time()))[3,4,5]; + 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) = (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; } @@ -132,7 +149,7 @@ sub compress { } sub DEBUG { - return unless (&IsParam("DEBUG")); + return unless (&IsParam('DEBUG')); &status("${b_green}!DEBUG!$ob $_[0]"); } @@ -142,21 +159,27 @@ sub ERROR { } sub WARN { - return unless (&IsParam("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]"); +} + +sub TODO { + &status("${b_cyan}!TODO!$ob $_[0]"); } 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]); } } @@ -165,44 +188,110 @@ sub status { 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; + } + + # 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)."); - # pump up the stats (or loglinenum). + 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. - 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; + + # 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."); + $reset++; + } + } else { # $logtime != $time. + $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 { $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+>) //) { @@ -222,49 +311,130 @@ sub status { } 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"; } # 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; + } + + 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 () { + 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'}): $!"); + delete $param{'SQLDebug'}; + return 0; + } + binmode(SQLDEBUG, ":utf8"); + + &status("Opened SQL Debug file: $param{'SQLDebug'}"); + return 1; +} + +sub closeSQLDebug { + close SQLDEBUG; + + &status("Closed SQL Debug file: $param{'SQLDebug'}"); +} + +sub SQLDebug { + return unless (&IsParam('SQLDebug')); - print LOG sprintf("%s %s\n", $date, $input); + return unless (fileno SQLDEBUG); + + print SQLDEBUG $_[0]."\n"; } 1; + +# vim:ts=4:sw=4:expandtab:tw=80