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     # a way to hook onto status without looping.
 191     # todo: find why $channels{} is created.
 192     if (0 and $running and !$cache{statusSafe}) {
 193         &ircCheck();
 194     }
 195
 196     if ($input eq $logold) {
 197         # allow perl flooding
 198         if ($input !~ /PERL: Use of uninitialized/) {
 199             $logrepeat++;
 200             return;
 201         }
 202     } else {
 203         $logold = $input;
 204
 205         # if only I had followed how sysklogd does it, heh. lame me. -xk
 206         if ($logrepeat >= 3) {
 207             &status("LOG: last message repeated $logrepeat times");
 208             $logrepeat = 0;
 209         }
 210     }
 211
 212     # if it's not a scalar, attempt to warn and fix.
 213     my $ref = ref $input;
 214     if (defined $ref and $ref ne "") {
 215         &WARN("status: 'input' is not scalar ($ref).");
 216
 217         if ($ref eq "ARRAY") {
 218             foreach (@$input) {
 219                 &WARN("status: '$_'.");
 220             }
 221         }
 222     }
 223
 224     # Something is using this w/ NULL.
 225     if (!defined $input or $input =~ /^\s*$/) {
 226         $input = "ERROR: Blank status call? HELP HELP HELP";
 227     }
 228
 229     for ($input) {
 230         s/\n+$//;
 231         s/\002|037//g;  # bold,video,underline => remove.
 232     }
 233
 234     # does this work?
 235     if ($input =~ /\n/) {
 236         foreach (split /\n/, $input) {
 237             &status($_);
 238         }
 239     }
 240
 241     # pump up the stats.
 242     $statcount++;
 243
 244     # fix style of output if process is child.
 245     if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
 246         $statcount      = 1;
 247         $statcountfix   = 1;
 248     }
 249
 250     ### LOG THROTTLING.
 251     ### TODO: move this _after_ printing?
 252     my $time    = time();
 253     my $reset   = 0;
 254
 255     # hrm... what is this supposed to achieve? nothing I guess.
 256     if ($logtime == $time) {
 257         if ($logcount < 25) {                   # too high?
 258             $logcount++;
 259         } else {
 260             sleep 1;
 261             &status("LOG: Throttling.");
 262             $reset++;
 263         }
 264     } else {    # $logtime != $time.
 265         $reset++;
 266     }
 267
 268     if ($reset) {
 269         $logtime        = $time;
 270         $logcount       = 0;
 271     }
 272
 273     # Log differently for forked/non-forked output.
 274     if ($statcountfix) {
 275         $status = "!$statcount! ".$input;
 276         if ($statcount > 1000) {
 277             print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
 278             print LOG "VERB: ".(&Time2String($time - $forkedtime))."\n";
 279             exit 0;
 280         }
 281     } else {
 282         $status = "[$statcount] ".$input;
 283     }
 284
 285     if (&IsParam("backlog")) {
 286         push(@backlog, $status);        # append to end.
 287         shift(@backlog) if (scalar @backlog > $param{'backlog'});
 288     }
 289
 290     if (&IsParam("VERBOSITY")) {
 291         if ($statcountfix) {
 292             printf $_red."!%6d!".$ob." ", $statcount;
 293         } else {
 294             printf $_green."[%6d]".$ob." ", $statcount;
 295         }
 296
 297         # three uberstabs to Derek Moeller. I don't remember why but he
 298         # deserved it :)
 299         my $printable = $input;
 300
 301         if ($printable =~ s/^(<\/\S+>) //) {
 302             # it's me saying something on a channel
 303             my $name = $1;
 304             print "$b_yellow$name $printable$ob\n";
 305         } elsif ($printable =~ s/^(<\S+>) //) {
 306             # public message on channel.
 307             my $name = $1;
 308
 309             if ($addressed) {
 310                 print "$b_red$name $printable$ob\n";
 311             } else {
 312                 print "$b_cyan$name$ob $printable$ob\n";
 313             }
 314
 315         } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
 316             # public action.
 317             print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
 318
 319         } elsif ($printable =~ s/^(-\S+-) //) {
 320             # notice
 321             print "$_green$1 $printable$ob\n";
 322
 323         } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
 324             # message/private action from someone
 325             print "$b_white$1$ob" if (defined $1);
 326             print "$b_red$2 $printable$ob\n";
 327
 328         } elsif ($printable =~ s/^(>\S+<) //) {
 329             # i'm messaging someone
 330             print "$b_magenta$1 $printable$ob\n";
 331
 332         } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
 333             # something that should be SEEN
 334             print "$b_green$1 $printable$ob\n";
 335
 336         } else {
 337             print "$printable\n";
 338         }
 339
 340     } else {
 341         #print "VERBOSITY IS OFF?\n";
 342     }
 343
 344     # log the line into a file.
 345     return unless (&IsParam("logfile"));
 346     return unless (defined fileno LOG);
 347
 348     # remove control characters from logging to LOGFILE.
 349     for ($input) {
 350         s/\e\[[0-9;]+m//g;      # escape codes.
 351         s/[\cA-\c_]//g;         # control chars.
 352     }
 353     $input = "FORK($$) ".$input if ($statcountfix);
 354
 355     my $date;
 356     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
 357         $date = sprintf("%02d:%02d.%02d", (gmtime $time)[2,1,0]);
 358
 359         my ($day,$month,$year) = (gmtime $time)[3,4,5];
 360         my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
 361         if (defined $logDate and $newlogDate != $logDate) {
 362             &closeLog();
 363             &compress( $file{log} );
 364             &openLog();
 365         }
 366     } else {
 367         $date   = $time;
 368     }
 369
 370     printf LOG "%s %s\n", $date, $input;
 371 }
 372
 373 sub openSQLDebug {
 374     if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
 375         &ERROR("Cannot open ($param{'SQLDebug'}): $!");
 376         delete $param{'SQLDebug'};
 377         return 0;
 378     }
 379
 380     &status("Opened SQL Debug file: $param{'SQLDebug'}");
 381     return 1;
 382 }
 383
 384 sub closeSQLDebug {
 385     close SQLDEBUG;
 386
 387     &status("Closed SQL Debug file: $param{'SQLDebug'}");
 388 }
 389
 390 sub SQLDebug {
 391     return unless (&IsParam("SQLDebug"));
 392
 393     return unless (fileno SQLDEBUG);
 394
 395     print SQLDEBUG $_[0]."\n";
 396 }
 397
 398 1;