print offending perl code with warnings. ripped from my other project.

not tested since ircd is borked on my box.

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@853 c11ca15a-4712-0410-83d8-924469b57eb5

diff --git a/src/logger.pl b/src/logger.pl
index c7593a7ba064bf374fa87d15ca32ffb8b725fd67..a74602d42a1d9aeab2979d3b3e1cb22b331af7ea 100644 (file)
--- a/src/logger.pl
+++ b/src/logger.pl
@@ -187,26 +187,21 @@ 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.
@@ -371,6 +366,46 @@ 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;
+    }
+
+    # todo: better filename.
+    open(OUT, ">>debug.log");
+    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'}): $!");