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);
  13 use vars qw(@backlog);
  14 use vars qw(%param %file);
  15
  16 require 5.001;
  17
  18 $logtime        = time();
  19 $logcount       = 0;
  20 $logrepeat      = 0;
  21 $logold         = "";
  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) = (localtime(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     &status("Closed logfile ($file{log}).");
 113     close 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         # ironically this does not get logged :)
 125         &WARN("compress: file ($file) does not exist.");
 126         return 0;
 127     }
 128
 129     if (-f "$file.gz" or -f "$file.bz2") {
 130         &WARN("compress: file.(gz|bz2) already exists.");
 131         return 0;
 132     }
 133
 134     foreach (@compress) {
 135         next unless ( -x $_);
 136
 137         &status("Compressing '$file' with $_.");
 138         system("$_ $file &");
 139         $okay++;
 140         last;
 141     }
 142
 143     if (!$okay) {
 144         &ERROR("no compress program found.");
 145         return 0;
 146     }
 147
 148     return 1;
 149 }
 150
 151 sub DEBUG {
 152     return unless (&IsParam("DEBUG"));
 153
 154     &status("${b_green}!DEBUG!$ob $_[0]");
 155 }
 156
 157 sub ERROR {
 158     &status("${b_red}!ERROR!$ob $_[0]");
 159 }
 160
 161 sub WARN {
 162     return unless (&IsParam("WARN"));
 163
 164     return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
 165
 166     &status("${b_yellow}!WARN!$ob $_[0]");
 167 }
 168
 169 sub FIXME {
 170     &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN?)");
 171 }
 172
 173 sub TODO {
 174     &status("${b_cyan}!TODO!$ob $_[0]");
 175 }
 176
 177 sub VERB {
 178     if (!&IsParam("VERBOSITY")) {
 179         # NOTHING.
 180     } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
 181         &status($_[0]);
 182     } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
 183         &status($_[0]);
 184     }
 185 }
 186
 187 sub status {
 188     my($input) = @_;
 189     my $status;
 190
 191     if ($input eq $logold) {
 192         $logrepeat++;
 193
 194         if ($logrepeat >= 3) {
 195             &status("LOG: repeat throttle.");
 196             sleep 1;
 197             $logrepeat = 0;
 198         }
 199     }
 200     $logold = $input;
 201
 202     # if it's not a scalar, attempt to warn and fix.
 203     if (ref($input) ne "") {
 204         &status("status: 'input' is not scalar (".ref($input).").");
 205         if (ref($input) eq "ARRAY") {
 206             foreach (@$input) {
 207                 &WARN("status: '$_'.");
 208             }
 209         }
 210     }
 211
 212     # Something is using this w/ NULL.
 213     if (!defined $input or $input =~ /^\s*$/) {
 214         $input = "Blank status call?";
 215     }
 216     $input =~ s/\n+$//;
 217     $input =~ s/\002|037//g;    # bold,video,underline => remove.
 218
 219     # pump up the stats (or loglinenum).
 220     $statcount++;
 221
 222     # fix style of output if process is child.
 223     if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
 224         $statcount      = 1;
 225         $statcountfix   = 1;
 226     }
 227
 228     ### LOG THROTTLING.
 229     ### TODO: move this _after_ printing?
 230     my $time = time();
 231     my $reset = 0;
 232     if ($logtime != $time) {
 233         $reset++;
 234     } elsif ($logtime == $time) {
 235         if ($logcount < 25) {           # too high?
 236             $logcount++;
 237         } else {
 238             sleep 1;
 239             &status("LOG: Throttling.");        # recursive?
 240             $reset++;
 241         }
 242     }
 243     if ($reset) {
 244         $logtime        = $time;
 245         $logcount       = 0;
 246     }
 247
 248     # Log differently for forked/non-forked output.
 249     if ($statcountfix) {
 250         $status = "!$statcount! ".$input;
 251         if ($statcount > 1000) {
 252             print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
 253             print LOG "VERB: ".(&Time2String(time() - $forkedtime))."\n";
 254             exit 0;
 255         }
 256     } else {
 257         $status = "[$statcount] ".$input;
 258     }
 259
 260     if (&IsParam("backlog")) {
 261         push(@backlog, $status);        # append to end.
 262         shift(@backlog) if (scalar @backlog > $param{'backlog'});
 263     }
 264
 265     if (&IsParam("VERBOSITY")) {
 266         if ($statcountfix) {
 267             printf $_red."!%5d!".$ob." ", $statcount;
 268         } else {
 269             printf $_green."[%5d]".$ob." ", $statcount;
 270         }
 271
 272         # three uberstabs to Derek Moeller.
 273         my $printable = $input;
 274
 275         if ($printable =~ s/^(<\/\S+>) //) {
 276             # it's me saying something on a channel
 277             my $name = $1;
 278             print "$b_yellow$name $printable$ob\n";
 279         } elsif ($printable =~ s/^(<\S+>) //) {
 280             # public message on channel.
 281             my $name = $1;
 282
 283             if ($addressed) {
 284                 print "$b_red$name $printable$ob\n";
 285             } else {
 286                 print "$b_cyan$name$ob $printable$ob\n";
 287             }
 288
 289         } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
 290             # public action.
 291             print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
 292         } elsif ($printable =~ s/^(-\S+-) //) {
 293             # notice
 294             print "$_green$1 $printable$ob\n";
 295         } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
 296             # message/private action from someone
 297             print "$b_white$1$ob" if (defined $1);
 298             print "$b_red$2 $printable$ob\n";
 299         } elsif ($printable =~ s/^(>\S+<) //) {
 300             # i'm messaging someone
 301             print "$b_magenta$1 $printable$ob\n";
 302         } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
 303             # something that should be SEEN
 304             print "$b_green$1 $printable$ob\n";
 305         } else {
 306             print "$printable\n";
 307         }
 308     } else {
 309         print "VERBOSITY IS OFF?\n";
 310     }
 311
 312     # log the line into a file.
 313     return unless (&IsParam("logfile"));
 314     return unless (defined fileno LOG);
 315
 316     # remove control characters from logging.
 317     $input =~ s/\e\[[0-9;]+m//g;
 318     $input =~ s/[\cA-\c_]//g;
 319     $input = "FORK($$) ".$input if ($statcountfix);
 320
 321     my $date;
 322     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
 323         $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]);
 324
 325         my ($day,$month,$year) = (localtime(time()))[3,4,5];
 326         my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
 327         if (defined $logDate and $newlogDate != $logDate) {
 328             &closeLog();
 329             &compress($file{log});
 330             &openLog();
 331         }
 332     } else {
 333         $date = time();
 334     }
 335
 336     print LOG sprintf("%s %s\n", $date, $input);
 337 }
 338
 339 sub openSQLDebug {
 340     if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
 341         &ERROR("cannot open $param{'SQLDebug'}...");
 342         delete $param{'SQLDebug'};
 343         return 0;
 344     }
 345
 346     &status("Opened SQL Debug file: $param{'SQLDebug'}");
 347     return 1;
 348 }
 349
 350 sub closeSQLDebug {
 351     close SQLDEBUG;
 352
 353     &status("Closed SQL Debug file: $param{'SQLDebug'}");
 354 }
 355
 356 1;