src/logger.pl

   1 #
   2 # logger.pl: logger functions!
   3 #    Author: dms
   4 #   Version: v0.4 (20000923)
   5 #  FVersion: 19991205
   6 #      NOTE: Based on code by Kevin Lenzo & Patrick Cole  (c) 1997
   7 #
   8
   9 use strict;
  10
  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);
  15
  16 $logtime        = time();
  17 $logcount       = 0;
  18 $logrepeat      = 0;
  19 $logold         = "";
  20
  21 $param{VEBOSITY} ||= 1;         # lame fix for preload
  22
  23 my %attributes = (
  24         'clear'      => 0,
  25         'reset'      => 0,
  26         'bold'       => 1,
  27         'underline'  => 4,
  28         'underscore' => 4,
  29         'blink'      => 5,
  30         'reverse'    => 7,
  31         'concealed'  => 8,
  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
  40 );
  41
  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);
  45
  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');
  56
  57 ############################################################################
  58 # Implementation (attribute string form)
  59 ############################################################################
  60
  61 # Return the escape code for a given set of color attributes.
  62 sub cl {
  63     my @codes = map { split } @_;
  64     my $attribute = '';
  65     foreach (@codes) {
  66         $_ = lc $_;
  67         unless (defined $attributes{$_}) { die "Invalid attribute name $_" }
  68         $attribute .= $attributes{$_} . ';';
  69     }
  70     chop $attribute;
  71     ($attribute ne '') ? "\e[${attribute}m" : undef;
  72 }
  73
  74 # logging support.
  75 sub openLog {
  76     return unless (&IsParam("logfile"));
  77     $file{log} = $param{'logfile'};
  78
  79     my $error = 0;
  80     my $path = &getPath($file{log});
  81     while (! -d $path) {
  82         if ($error) {
  83             &ERROR("openLog: failed opening log to $file{log}; disabling.");
  84             delete $param{'logfile'};
  85             return;
  86         }
  87
  88         &status("openLog: making $path.");
  89         last if (mkdir $path, 0755);
  90         $error++;
  91     }
  92
  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;
  97     }
  98
  99     if (open(LOG, ">>$file{log}")) {
 100         &status("Opened logfile $file{log}.");
 101         LOG->autoflush(1);
 102     } else {
 103         &status("Cannot open logfile ($file{log}); not logging: $!");
 104     }
 105 }
 106
 107 sub closeLog {
 108     # lame fix for paramlogfile.
 109     return unless (&IsParam("logfile"));
 110     return unless (defined fileno LOG);
 111
 112     close LOG;
 113     &status("Closed logfile ($file{log}).");
 114 }
 115
 116 #####
 117 # Usage: &compress($file);
 118 sub compress {
 119     my ($file) = @_;
 120     my @compress = ("/usr/bin/bzip2","/bin/gzip");
 121     my $okay = 0;
 122
 123     if (! -f $file) {
 124         &WARN("compress: file ($file) does not exist.");
 125         return 0;
 126     }
 127
 128     if ( -f "$file.gz" or -f "$file.bz2" ) {
 129         &WARN("compress: file.(gz|bz2) already exists.");
 130         return 0;
 131     }
 132
 133     foreach (@compress) {
 134         next unless ( -x $_);
 135
 136         &status("Compressing '$file' with $_.");
 137         system("$_ $file &");
 138         $okay++;
 139         last;
 140     }
 141
 142     if (!$okay) {
 143         &ERROR("no compress program found.");
 144         return 0;
 145     }
 146
 147     return 1;
 148 }
 149
 150 sub DEBUG {
 151     return unless (&IsParam("DEBUG"));
 152
 153     &status("${b_green}!DEBUG!$ob $_[0]");
 154 }
 155
 156 sub ERROR {
 157     &status("${b_red}!ERROR!$ob $_[0]");
 158 }
 159
 160 sub WARN {
 161     return unless (&IsParam("WARN"));
 162
 163     return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
 164
 165     &status("${b_yellow}!WARN!$ob $_[0]");
 166 }
 167
 168 sub FIXME {
 169     &status("${b_cyan}!FIXME!$ob $_[0]");
 170 }
 171
 172 sub TODO {
 173     &status("${b_cyan}!TODO!$ob $_[0]");
 174 }
 175
 176 sub VERB {
 177     if (!&IsParam("VERBOSITY")) {
 178         # NOTHING.
 179     } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
 180         &status($_[0]);
 181     } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
 182         &status($_[0]);
 183     }
 184 }
 185
 186 sub status {
 187     my($input) = @_;
 188     my $status;
 189
 190     if ($input =~ /PERL: Use of uninitialized/) {
 191         &debug_perl($input);
 192         return;
 193     }
 194
 195     if ($input eq $logold) {
 196         $logrepeat++;
 197         return;
 198     }
 199
 200     $logold = $input;
 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");
 204         $logrepeat = 0;
 205     }
 206
 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).");
 211
 212         if ($ref eq "ARRAY") {
 213             foreach (@$input) {
 214                 &WARN("status: '$_'.");
 215             }
 216         }
 217     }
 218
 219     # Something is using this w/ NULL.
 220     if (!defined $input or $input =~ /^\s*$/) {
 221         $input = "ERROR: Blank status call? HELP HELP HELP";
 222     }
 223
 224     for ($input) {
 225         s/\n+$//;
 226         s/\002|\037//g; # bold,video,underline => remove.
 227     }
 228
 229     # does this work?
 230     if ($input =~ /\n/) {
 231         foreach (split /\n/, $input) {
 232             &status($_);
 233         }
 234     }
 235
 236     # pump up the stats.
 237     $statcount++;
 238
 239     # fix style of output if process is child.
 240     if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
 241         $statcount      = 1;
 242         $statcountfix   = 1;
 243     }
 244
 245     ### LOG THROTTLING.
 246     ### TODO: move this _after_ printing?
 247     my $time    = time();
 248     my $reset   = 0;
 249
 250     # hrm... what is this supposed to achieve? nothing I guess.
 251     if ($logtime == $time) {
 252         if ($logcount < 25) {                   # too high?
 253             $logcount++;
 254         } else {
 255             sleep 1;
 256             &status("LOG: Throttling.");
 257             $reset++;
 258         }
 259     } else {    # $logtime != $time.
 260         $reset++;
 261     }
 262
 263     if ($reset) {
 264         $logtime        = $time;
 265         $logcount       = 0;
 266     }
 267
 268     # Log differently for forked/non-forked output.
 269     if ($statcountfix) {
 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";
 274             exit 0;
 275         }
 276     } else {
 277         $status = "[$statcount] ".$input;
 278     }
 279
 280     if (&IsParam("backlog")) {
 281         push(@backlog, $status);        # append to end.
 282         shift(@backlog) if (scalar @backlog > $param{'backlog'});
 283     }
 284
 285     if (&IsParam("VERBOSITY")) {
 286         if ($statcountfix) {
 287             printf $_red."!%6d!".$ob." ", $statcount;
 288         } else {
 289             printf $_green."[%6d]".$ob." ", $statcount;
 290         }
 291
 292         # three uberstabs to Derek Moeller. I don't remember why but he
 293         # deserved it :)
 294         my $printable = $input;
 295
 296         if ($printable =~ s/^(<\/\S+>) //) {
 297             # it's me saying something on a channel
 298             my $name = $1;
 299             print "$b_yellow$name $printable$ob\n";
 300         } elsif ($printable =~ s/^(<\S+>) //) {
 301             # public message on channel.
 302             my $name = $1;
 303
 304             if ($addressed) {
 305                 print "$b_red$name $printable$ob\n";
 306             } else {
 307                 print "$b_cyan$name$ob $printable$ob\n";
 308             }
 309
 310         } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
 311             # public action.
 312             print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
 313
 314         } elsif ($printable =~ s/^(-\S+-) //) {
 315             # notice
 316             print "$_green$1 $printable$ob\n";
 317
 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";
 322
 323         } elsif ($printable =~ s/^(>\S+<) //) {
 324             # i'm messaging someone
 325             print "$b_magenta$1 $printable$ob\n";
 326
 327         } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
 328             # something that should be SEEN
 329             print "$b_green$1 $printable$ob\n";
 330
 331         } else {
 332             print "$printable\n";
 333         }
 334
 335     } else {
 336         #print "VERBOSITY IS OFF?\n";
 337     }
 338
 339     # log the line into a file.
 340     return unless (&IsParam("logfile"));
 341     return unless (defined fileno LOG);
 342
 343     # remove control characters from logging to LOGFILE.
 344     for ($input) {
 345         last if (&IsParam("logColors"));
 346         s/\e\[[0-9;]+m//g;      # escape codes.
 347         s/[\cA-\c_]//g;         # control chars.
 348     }
 349     $input = "FORK($$) ".$input if ($statcountfix);
 350
 351     my $date;
 352     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
 353         $date = sprintf("%02d:%02d.%02d", (gmtime $time)[2,1,0]);
 354
 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) {
 358             &closeLog();
 359             &compress( $file{log} );
 360             &openLog();
 361         }
 362     } else {
 363         $date   = $time;
 364     }
 365
 366     printf LOG "%s %s\n", $date, $input;
 367 }
 368
 369 sub debug_perl {
 370     my ($str) = @_;
 371
 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: $!");
 376         return;
 377     }
 378
 379     # TODO: better filename.
 380     open(OUT, ">>debug.log");
 381     print OUT "DEBUG: $str\n";
 382
 383     # note: cannot call external functions because SIG{} does not allow us to.
 384     my $i;
 385     while (<IN>) {
 386         chop;
 387         $i++;
 388         # bleh. this tries to duplicate status().
 389         # TODO: statcountfix
 390         # TODO: rename to log_*someshit*
 391         if ($i == $line) {
 392             my $msg = "$file: $i:!$_";
 393             printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg;
 394             print OUT "DEBUG: $msg\n";
 395             $statcount++;
 396             next;
 397         }
 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";
 402             $statcount++;
 403         }
 404     }
 405     close IN;
 406     close OUT;
 407 }
 408
 409 sub openSQLDebug {
 410     if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
 411         &ERROR("Cannot open ($param{'SQLDebug'}): $!");
 412         delete $param{'SQLDebug'};
 413         return 0;
 414     }
 415
 416     &status("Opened SQL Debug file: $param{'SQLDebug'}");
 417     return 1;
 418 }
 419
 420 sub closeSQLDebug {
 421     close SQLDEBUG;
 422
 423     &status("Closed SQL Debug file: $param{'SQLDebug'}");
 424 }
 425
 426 sub SQLDebug {
 427     return unless (&IsParam("SQLDebug"));
 428
 429     return unless (fileno SQLDEBUG);
 430
 431     print SQLDEBUG $_[0]."\n";
 432 }
 433
 434 1;