2 # logger.pl: logger functions!
4 # Version: v0.4 (20000923)
6 # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
11 use vars qw($statcount $bot_pid $forkedtime $statcountfix $addressed);
12 use vars qw($logDate $logold $logcount $logtime $logrepeat $running);
13 use vars qw(@backlog);
14 use vars qw(%param %file %cache);
21 $param{VEBOSITY} ||= 1; # lame fix for preload
32 'black' => 30, 'on_black' => 40,
33 'red' => 31, 'on_red' => 41,
34 'green' => 32, 'on_green' => 42,
35 'yellow' => 33, 'on_yellow' => 43,
36 'blue' => 34, 'on_blue' => 44,
37 'magenta' => 35, 'on_magenta' => 45,
38 'cyan' => 36, 'on_cyan' => 46,
39 'white' => 37, 'on_white' => 47
42 use vars qw($b_black $_black $b_red $_red $b_green $_green
43 $b_yellow $_yellow $b_blue $_blue $b_magenta $_magenta
44 $b_cyan $_cyan $b_white $_white $_reset $_bold $ob $b);
46 $b_black = cl('bold black'); $_black = cl('black');
47 $b_red = cl('bold red'); $_red = cl('red');
48 $b_green = cl('bold green'); $_green = cl('green');
49 $b_yellow = cl('bold yellow'); $_yellow = cl('yellow');
50 $b_blue = cl('bold blue'); $_blue = cl('blue');
51 $b_magenta = cl('bold magenta'); $_magenta = cl('magenta');
52 $b_cyan = cl('bold cyan'); $_cyan = cl('cyan');
53 $b_white = cl('bold white'); $_white = cl('white');
54 $_reset = cl('reset'); $_bold = cl('bold');
55 $ob = cl('reset'); $b = cl('bold');
57 ############################################################################
58 # Implementation (attribute string form)
59 ############################################################################
61 # Return the escape code for a given set of color attributes.
63 my @codes = map { split } @_;
67 unless (defined $attributes{$_}) { die "Invalid attribute name $_" }
68 $attribute .= $attributes{$_} . ';';
71 ($attribute ne '') ? "\e[${attribute}m" : undef;
76 return unless (&IsParam("logfile"));
77 $file{log} = $param{'logfile'};
80 my $path = &getPath($file{log});
83 &ERROR("openLog: failed opening log to $file{log}; disabling.");
84 delete $param{'logfile'};
88 &status("openLog: making $path.");
89 last if (mkdir $path, 0755);
93 if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
94 my ($day,$month,$year) = (gmtime time())[3,4,5];
95 $logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
96 $file{log} .= "-".$logDate;
99 if (open(LOG, ">>$file{log}")) {
100 &status("Opened logfile $file{log}.");
103 &status("Cannot open logfile ($file{log}); not logging: $!");
108 # lame fix for paramlogfile.
109 return unless (&IsParam("logfile"));
110 return unless (defined fileno LOG);
113 &status("Closed logfile ($file{log}).");
117 # Usage: &compress($file);
120 my @compress = ("/usr/bin/bzip2","/bin/gzip");
124 &WARN("compress: file ($file) does not exist.");
128 if ( -f "$file.gz" or -f "$file.bz2" ) {
129 &WARN("compress: file.(gz|bz2) already exists.");
133 foreach (@compress) {
134 next unless ( -x $_);
136 &status("Compressing '$file' with $_.");
137 system("$_ $file &");
143 &ERROR("no compress program found.");
151 return unless (&IsParam("DEBUG"));
153 &status("${b_green}!DEBUG!$ob $_[0]");
157 &status("${b_red}!ERROR!$ob $_[0]");
161 return unless (&IsParam("WARN"));
163 return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
165 &status("${b_yellow}!WARN!$ob $_[0]");
169 &status("${b_cyan}!FIXME!$ob $_[0]");
173 &status("${b_cyan}!TODO!$ob $_[0]");
177 if (!&IsParam("VERBOSITY")) {
179 } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
181 } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
190 if ($input =~ /PERL: Use of uninitialized/) {
195 if ($input eq $logold) {
201 # if only I had followed how sysklogd does it, heh. lame me. -xk
202 if ($logrepeat >= 3) {
203 &status("LOG: last message repeated $logrepeat times");
207 # if it's not a scalar, attempt to warn and fix.
208 my $ref = ref $input;
209 if (defined $ref and $ref ne "") {
210 &WARN("status: 'input' is not scalar ($ref).");
212 if ($ref eq "ARRAY") {
214 &WARN("status: '$_'.");
219 # Something is using this w/ NULL.
220 if (!defined $input or $input =~ /^\s*$/) {
221 $input = "ERROR: Blank status call? HELP HELP HELP";
226 s/\002|037//g; # bold,video,underline => remove.
230 if ($input =~ /\n/) {
231 foreach (split /\n/, $input) {
239 # fix style of output if process is child.
240 if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
246 ### TODO: move this _after_ printing?
250 # hrm... what is this supposed to achieve? nothing I guess.
251 if ($logtime == $time) {
252 if ($logcount < 25) { # too high?
256 &status("LOG: Throttling.");
259 } else { # $logtime != $time.
268 # Log differently for forked/non-forked output.
270 $status = "!$statcount! ".$input;
271 if ($statcount > 1000) {
272 print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
273 print LOG "VERB: ".(&Time2String($time - $forkedtime))."\n";
277 $status = "[$statcount] ".$input;
280 if (&IsParam("backlog")) {
281 push(@backlog, $status); # append to end.
282 shift(@backlog) if (scalar @backlog > $param{'backlog'});
285 if (&IsParam("VERBOSITY")) {
287 printf $_red."!%6d!".$ob." ", $statcount;
289 printf $_green."[%6d]".$ob." ", $statcount;
292 # three uberstabs to Derek Moeller. I don't remember why but he
294 my $printable = $input;
296 if ($printable =~ s/^(<\/\S+>) //) {
297 # it's me saying something on a channel
299 print "$b_yellow$name $printable$ob\n";
300 } elsif ($printable =~ s/^(<\S+>) //) {
301 # public message on channel.
305 print "$b_red$name $printable$ob\n";
307 print "$b_cyan$name$ob $printable$ob\n";
310 } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
312 print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
314 } elsif ($printable =~ s/^(-\S+-) //) {
316 print "$_green$1 $printable$ob\n";
318 } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
319 # message/private action from someone
320 print "$b_white$1$ob" if (defined $1);
321 print "$b_red$2 $printable$ob\n";
323 } elsif ($printable =~ s/^(>\S+<) //) {
324 # i'm messaging someone
325 print "$b_magenta$1 $printable$ob\n";
327 } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
328 # something that should be SEEN
329 print "$b_green$1 $printable$ob\n";
332 print "$printable\n";
336 #print "VERBOSITY IS OFF?\n";
339 # log the line into a file.
340 return unless (&IsParam("logfile"));
341 return unless (defined fileno LOG);
343 # remove control characters from logging to LOGFILE.
345 last if (&IsParam("logColors"));
346 s/\e\[[0-9;]+m//g; # escape codes.
347 s/[\cA-\c_]//g; # control chars.
349 $input = "FORK($$) ".$input if ($statcountfix);
352 if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
353 $date = sprintf("%02d:%02d.%02d", (gmtime $time)[2,1,0]);
355 my ($day,$month,$year) = (gmtime $time)[3,4,5];
356 my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
357 if (defined $logDate and $newlogDate != $logDate) {
359 &compress( $file{log} );
366 printf LOG "%s %s\n", $date, $input;
372 return unless ($str =~ /^WARN: Use of uninitialized value .* at (\S+) line (\d+)/);
373 my ($file,$line) = ($1,$2);
374 if (!open(IN,$file)) {
375 &status("WARN: cannot open $file: $!");
379 # TODO: better filename.
380 open(OUT, ">>debug.log");
381 print OUT "DEBUG: $str\n";
383 # note: cannot call external functions because SIG{} does not allow us to.
388 # bleh. this tries to duplicate status().
390 # TODO: rename to log_*someshit*
392 my $msg = "$file: $i:!$_";
393 printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg;
394 print OUT "DEBUG: $msg\n";
398 if ($i+3 > $line && $i-3 < $line) {
399 my $msg = "$file: $i: $_";
400 printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg;
401 print OUT "DEBUG: $msg\n";
410 if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
411 &ERROR("Cannot open ($param{'SQLDebug'}): $!");
412 delete $param{'SQLDebug'};
416 &status("Opened SQL Debug file: $param{'SQLDebug'}");
423 &status("Closed SQL Debug file: $param{'SQLDebug'}");
427 return unless (&IsParam("SQLDebug"));
429 return unless (fileno SQLDEBUG);
431 print SQLDEBUG $_[0]."\n";