X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Flogger.pl;h=8309a14fa3f6817fb589eebc0c10472debcd88e9;hb=3f48414ab1bef68209a7edcfea486d412c2f17dc;hp=c7593a7ba064bf374fa87d15ca32ffb8b725fd67;hpb=5b661567bd6bdb15cc1e48e102bda3a26d03bd65;p=infobot.git diff --git a/src/logger.pl b/src/logger.pl index c7593a7..8309a14 100644 --- a/src/logger.pl +++ b/src/logger.pl @@ -16,7 +16,7 @@ use vars qw(%param %file %cache); $logtime = time(); $logcount = 0; $logrepeat = 0; -$logold = ""; +$logold = ''; $param{VEBOSITY} ||= 1; # lame fix for preload @@ -43,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'); @@ -73,7 +73,7 @@ sub cl { # logging support. sub openLog { - return unless (&IsParam("logfile")); + return unless (&IsParam('logfile')); $file{log} = $param{'logfile'}; my $error = 0; @@ -90,13 +90,14 @@ sub openLog { $error++; } - if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) { + 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, ":encoding(UTF-8)"); &status("Opened logfile $file{log}."); LOG->autoflush(1); } else { @@ -106,7 +107,7 @@ sub openLog { sub closeLog { # lame fix for paramlogfile. - return unless (&IsParam("logfile")); + return unless (&IsParam('logfile')); return unless (defined fileno LOG); close LOG; @@ -117,7 +118,7 @@ sub closeLog { # 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) { @@ -148,7 +149,7 @@ sub compress { } sub DEBUG { - return unless (&IsParam("DEBUG")); + return unless (&IsParam('DEBUG')); &status("${b_green}!DEBUG!$ob $_[0]"); } @@ -158,7 +159,7 @@ sub ERROR { } sub WARN { - return unless (&IsParam("WARN")); + return unless (&IsParam('WARN')); return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/); @@ -174,11 +175,11 @@ 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]); } } @@ -187,34 +188,29 @@ sub status { my($input) = @_; my $status; - # a way to hook onto status without looping. - # todo: find why $channels{} is created. - if (0 and $running and !$cache{statusSafe}) { - &ircCheck(); + if ($input =~ /PERL: Use of uninitialized/) { + &debug_perl($input); + return; } if ($input eq $logold) { - # allow perl flooding - if ($input !~ /PERL: Use of uninitialized/) { - $logrepeat++; - return; - } - } else { - $logold = $input; + $logrepeat++; + return; + } - # 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; - } + $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 "") { + if (defined $ref and $ref ne '') { &WARN("status: 'input' is not scalar ($ref)."); - if ($ref eq "ARRAY") { + if ($ref eq 'ARRAY') { foreach (@$input) { &WARN("status: '$_'."); } @@ -228,7 +224,7 @@ sub status { for ($input) { s/\n+$//; - s/\002|037//g; # bold,video,underline => remove. + s/\002|\037//g; # bold,video,underline => remove. } # does this work? @@ -282,12 +278,12 @@ sub status { $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."!%6d!".$ob." ", $statcount; } else { @@ -342,19 +338,19 @@ sub status { } # log the line into a file. - return unless (&IsParam("logfile")); + return unless (&IsParam('logfile')); return unless (defined fileno LOG); # remove control characters from logging to LOGFILE. for ($input) { - last if (&IsParam("logColors")); + 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) { + if (&IsParam('logType') and $param{'logType'} =~ /DAILY/i) { $date = sprintf("%02d:%02d.%02d", (gmtime $time)[2,1,0]); my ($day,$month,$year) = (gmtime $time)[3,4,5]; @@ -371,12 +367,55 @@ sub status { 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, ":encoding(UTF-8)"); + + # TODO: better filename. + open(OUT, ">>debug.log"); + binmode(OUT, ":encoding(UTF-8)"); + 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, ":encoding(UTF-8)"); &status("Opened SQL Debug file: $param{'SQLDebug'}"); return 1; @@ -389,7 +428,7 @@ sub closeSQLDebug { } sub SQLDebug { - return unless (&IsParam("SQLDebug")); + return unless (&IsParam('SQLDebug')); return unless (fileno SQLDEBUG); @@ -397,3 +436,5 @@ sub SQLDebug { } 1; + +# vim:ts=4:sw=4:expandtab:tw=80