]> git.donarmstrong.com Git - infobot.git/blobdiff - src/logger.pl
- renamed Factoids/Misc.pl to Factoids/Core.pl
[infobot.git] / src / logger.pl
index 07c678bd80329a7beac990bb265dea19d18f9f11..f550962a6041a6b428fdc0543856d2d865ce55a3 100644 (file)
@@ -1,19 +1,27 @@
 #
 # logger.pl: logger functions!
-#    Author: xk <xk@leguin.openprojects.net>
-#   Version: 19991205
+#    Author: dms
+#   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,
@@ -70,8 +78,22 @@ sub openLog {
     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];
+       my ($day,$month,$year) = (localtime time())[3,4,5];
        $logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
        $file{log} .= "-".$logDate;
     }
@@ -79,21 +101,18 @@ sub openLog {
     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}).");
 }
 
 #####
@@ -104,12 +123,11 @@ sub compress {
     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;
     }
@@ -144,11 +162,17 @@ sub ERROR {
 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]");
+}
+
+sub TODO {
+    &status("${b_cyan}!TODO!$ob $_[0]");
 }
 
 sub VERB {
@@ -165,25 +189,86 @@ 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 eq $logold) {
+       # allow perl flooding
+       $logrepeat++ unless ($input =~ /PERL: Use of uninitialized/);
 
-    # pump up the stats (or loglinenum).
+       # todo: prevent massive repetitive throttling.
+       if ($logrepeat >= 3) {
+           $logrepeat = 0;
+           &status("LOG: repeat throttle.");
+           sleep 1;
+       }
+    } else {
+       $logold = $input;
+    }
+
+    # if it's not a scalar, attempt to warn and fix.
+    my $ref = ref $input;
+    if (defined $ref and $ref ne "") {
+       &status("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 = "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;
+
+    if ($logtime == $time) {
+       if ($logcount < 25) {                   # too high?
+           $logcount++;
+       } else {
+           sleep 1;
+           &status("LOG: Throttling.");        # recursive?
+           $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 {
@@ -197,9 +282,9 @@ sub status {
 
     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.
@@ -238,22 +323,26 @@ sub status {
        } 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;
-    $input =~ s/[\cA-\c_]//g;
+    for ($input) {
+       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]);
+       $date = sprintf("%02d:%02d.%02d", (localtime $time)[2,1,0]);
 
-       my ($day,$month,$year) = (localtime(time()))[3,4,5];
+       my ($day,$month,$year) = (localtime $time)[3,4,5];
        my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
        if (defined $logDate and $newlogDate != $logDate) {
            &closeLog();
@@ -261,10 +350,35 @@ sub status {
            &openLog();
        }
     } else {
-       $date = time();
+       $date   = $time;
     }
 
     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'}");
+}
+
+sub SQLDebug {
+    return unless (&IsParam("SQLDebug"));
+
+    return unless (fileno SQLDEBUG);
+
+    print SQLDEBUG $_[0]."\n";
+}
+
 1;