use vars qw(@backlog);
use vars qw(%param %file %cache);
-require 5.001;
-
$logtime = time();
$logcount = 0;
$logrepeat = 0;
-$logold = "";
+$logold = '';
$param{VEBOSITY} ||= 1; # lame fix for preload
$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');
# logging support.
sub openLog {
- return unless (&IsParam("logfile"));
+ return unless (&IsParam('logfile'));
$file{log} = $param{'logfile'};
my $error = 0;
$error++;
}
- if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
- my ($day,$month,$year) = (localtime time())[3,4,5];
+ 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);
} else {
sub closeLog {
# lame fix for paramlogfile.
- return unless (&IsParam("logfile"));
+ return unless (&IsParam('logfile'));
return unless (defined fileno LOG);
close 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) {
}
sub DEBUG {
- return unless (&IsParam("DEBUG"));
+ return unless (&IsParam('DEBUG'));
&status("${b_green}!DEBUG!$ob $_[0]");
}
}
sub WARN {
- return unless (&IsParam("WARN"));
+ return unless (&IsParam('WARN'));
return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
}
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]);
}
}
my($input) = @_;
my $status;
- # a way to hook onto status without looping.
- # todo: find why $channels{undef} 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
- $logrepeat++ unless ($input =~ /PERL: Use of uninitialized/);
-
- # todo: prevent massive repetitive throttling.
- if ($logrepeat >= 3) {
- $logrepeat = 0;
- &status("LOG: repeat throttle.");
- # we block it to ensure sequence of logging is intact.
- # could go with $conn->schedule but that's evil :)
- sleep 1;
- }
- } else {
- $logold = $input;
+ $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 "") {
- &status("status: 'input' is not scalar ($ref).");
+ 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: '$_'.");
}
for ($input) {
s/\n+$//;
- s/\002|037//g; # bold,video,underline => remove.
+ s/\002|\037//g; # bold,video,underline => remove.
}
# does this work?
if ($input =~ /\n/) {
- foreach (split(/\n/, $input)) {
+ foreach (split /\n/, $input) {
&status($_);
}
}
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."); # recursive?
+ &status("LOG: Throttling.");
$reset++;
}
} else { # $logtime != $time.
$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 {
} 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 (&IsParam('logfile'));
return unless (defined fileno LOG);
- # remove control characters from logging.
+ # 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();
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 (<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'}): $!");
delete $param{'SQLDebug'};
return 0;
}
+ binmode(SQLDEBUG, ":utf8");
&status("Opened SQL Debug file: $param{'SQLDebug'}");
return 1;
}
sub SQLDebug {
- return unless (&IsParam("SQLDebug"));
+ return unless (&IsParam('SQLDebug'));
return unless (fileno SQLDEBUG);
}
1;
+
+# vim:ts=4:sw=4:expandtab:tw=80
projects / infobot.git / blobdiff