src/logger.pl

   1 #
   2 # logger.pl: logger functions!
   3 #    Author: dms
   4 #   Version: v0.3 (20000731)
   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($logDate $statcount $bot_pid $forkedtime
  12             $statcountfix $addressed $logcount $logtime);
  13 use vars qw(@backlog);
  14 use vars qw(%param %file);
  15
  16 require 5.001;
  17
  18 $logtime        = time();
  19 $logcount       = 0;
  20
  21 my %attributes = (
  22         'clear'      => 0,
  23         'reset'      => 0,
  24         'bold'       => 1,
  25         'underline'  => 4,
  26         'underscore' => 4,
  27         'blink'      => 5,
  28         'reverse'    => 7,
  29         'concealed'  => 8,
  30         'black'      => 30,     'on_black'   => 40,
  31         'red'        => 31,     'on_red'     => 41,
  32         'green'      => 32,     'on_green'   => 42,
  33         'yellow'     => 33,     'on_yellow'  => 43,
  34         'blue'       => 34,     'on_blue'    => 44,
  35         'magenta'    => 35,     'on_magenta' => 45,
  36         'cyan'       => 36,     'on_cyan'    => 46,
  37         'white'      => 37,     'on_white'   => 47
  38 );
  39
  40 use vars qw($b_black $_black $b_red $_red $b_green $_green
  41             $b_yellow $_yellow $b_blue $_blue $b_magenta $_magenta
  42             $b_cyan $_cyan $b_white $_white $_reset $_bold $ob $b);
  43
  44 $b_black        = cl('bold black');     $_black         = cl('black');
  45 $b_red          = cl('bold red');       $_red           = cl('red');
  46 $b_green        = cl('bold green');     $_green         = cl('green');
  47 $b_yellow       = cl('bold yellow');    $_yellow        = cl('yellow');
  48 $b_blue         = cl('bold blue');      $_blue          = cl('blue');
  49 $b_magenta      = cl('bold magenta');   $_magenta       = cl('magenta');
  50 $b_cyan         = cl('bold cyan');      $_cyan          = cl('cyan');
  51 $b_white        = cl('bold white');     $_white         = cl('white');
  52 $_reset         = cl('reset');          $_bold          = cl('bold');
  53 $ob             = cl('reset');          $b              = cl('bold');
  54
  55 ############################################################################
  56 # Implementation (attribute string form)
  57 ############################################################################
  58
  59 # Return the escape code for a given set of color attributes.
  60 sub cl {
  61     my @codes = map { split } @_;
  62     my $attribute = '';
  63     foreach (@codes) {
  64         $_ = lc $_;
  65         unless (defined $attributes{$_}) { die "Invalid attribute name $_" }
  66         $attribute .= $attributes{$_} . ';';
  67     }
  68     chop $attribute;
  69     ($attribute ne '') ? "\e[${attribute}m" : undef;
  70 }
  71
  72 # logging support.
  73 sub openLog {
  74     return unless (&IsParam("logfile"));
  75     $file{log} = $param{'logfile'};
  76
  77     my $error = 0;
  78     my $path = &getPath($file{log});
  79     while (! -d $path) {
  80         if ($error) {
  81             &ERROR("openLog: failed opening log to $file{log}; disabling.");
  82             delete $param{'logfile'};
  83             return;
  84         }
  85
  86         &status("openLog: making $path.");
  87         last if (mkdir $path, 0755);
  88         $error++;
  89     }
  90
  91     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
  92         my ($day,$month,$year) = (localtime(time()))[3,4,5];
  93         $logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
  94         $file{log} .= "-".$logDate;
  95     }
  96
  97     if (open(LOG, ">>$file{log}")) {
  98         &status("Opened logfile $file{log}.");
  99         LOG->autoflush(1);
 100     } else {
 101         &status("cannot open logfile $file{log}; not logging.");
 102     }
 103 }
 104
 105 sub closeLog {
 106     # lame fix for paramlogfile.
 107     return unless (&IsParam("logfile"));
 108     return unless (defined fileno LOG);
 109
 110     &status("Closed logfile ($file{log}).");
 111     close LOG;
 112 }
 113
 114 #####
 115 # Usage: &compress($file);
 116 sub compress {
 117     my ($file) = @_;
 118     my @compress = ("/usr/bin/bzip2","/bin/gzip");
 119     my $okay = 0;
 120
 121     if (! -f $file) {
 122         # ironically this does not get logged :)
 123         &WARN("compress: file ($file) does not exist.");
 124         return 0;
 125     }
 126
 127     if (-f "$file.gz" or -f "$file.bz2") {
 128         &WARN("compress: file.(gz|bz2) already exists.");
 129         return 0;
 130     }
 131
 132     foreach (@compress) {
 133         next unless ( -x $_);
 134
 135         &status("Compressing '$file' with $_.");
 136         system("$_ $file &");
 137         $okay++;
 138         last;
 139     }
 140
 141     if (!$okay) {
 142         &ERROR("no compress program found.");
 143         return 0;
 144     }
 145
 146     return 1;
 147 }
 148
 149 sub DEBUG {
 150     return unless (&IsParam("DEBUG"));
 151
 152     &status("${b_green}!DEBUG!$ob $_[0]");
 153 }
 154
 155 sub ERROR {
 156     &status("${b_red}!ERROR!$ob $_[0]");
 157 }
 158
 159 sub WARN {
 160     return unless (&IsParam("WARN"));
 161
 162     return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
 163
 164     &status("${b_yellow}!WARN!$ob $_[0]");
 165 }
 166
 167 sub FIXME {
 168     &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN?)");
 169 }
 170
 171 sub TODO {
 172     &status("${b_cyan}!TODO!$ob $_[0]");
 173 }
 174
 175 sub VERB {
 176     if (!&IsParam("VERBOSITY")) {
 177         # NOTHING.
 178     } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
 179         &status($_[0]);
 180     } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
 181         &status($_[0]);
 182     }
 183 }
 184
 185 sub status {
 186     my($input) = @_;
 187     my $status;
 188
 189     # if it's not a scalar, attempt to warn and fix.
 190     if (ref($input) ne "") {
 191         &status("status: 'input' is not scalar (".ref($input).").");
 192         if (ref($input) eq "ARRAY") {
 193             foreach (@$input) {
 194                 &WARN("status: '$_'.");
 195             }
 196         }
 197     }
 198
 199     # Something is using this w/ NULL.
 200     if (!defined $input or $input =~ /^\s*$/) {
 201         $input = "Blank status call?";
 202     }
 203     $input =~ s/\n+$//;
 204     $input =~ s/\002|037//g;    # bold,video,underline => remove.
 205
 206     # pump up the stats (or loglinenum).
 207     $statcount++;
 208
 209     # fix style of output if process is child.
 210     if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
 211         $statcount      = 1;
 212         $statcountfix   = 1;
 213     }
 214
 215     ### LOG THROTTLING.
 216     ### TODO: move this _after_ printing?
 217     my $time = time();
 218     my $reset = 0;
 219     if ($logtime != $time) {
 220         $reset++;
 221     } elsif ($logtime == $time) {
 222         if ($logcount < 25) {           # too high?
 223             $logcount++;
 224         } else {
 225             sleep 1;
 226             &status("LOG: Throttling.");        # recursive?
 227             $reset++;
 228         }
 229     }
 230     if ($reset) {
 231         $logtime        = $time;
 232         $logcount       = 0;
 233     }
 234
 235     # Log differently for forked/non-forked output.
 236     if ($statcountfix) {
 237         $status = "!$statcount! ".$input;
 238         if ($statcount > 1000) {
 239             print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
 240             print LOG "VERB: ".(&Time2String(time() - $forkedtime))."\n";
 241             exit 0;
 242         }
 243     } else {
 244         $status = "[$statcount] ".$input;
 245     }
 246
 247     if (&IsParam("backlog")) {
 248         push(@backlog, $status);        # append to end.
 249         shift(@backlog) if (scalar @backlog > $param{'backlog'});
 250     }
 251
 252     if (&IsParam("VERBOSITY")) {
 253         if ($statcountfix) {
 254             printf $_red."!%5d!".$ob." ", $statcount;
 255         } else {
 256             printf $_green."[%5d]".$ob." ", $statcount;
 257         }
 258
 259         # three uberstabs to Derek Moeller.
 260         my $printable = $input;
 261
 262         if ($printable =~ s/^(<\/\S+>) //) {
 263             # it's me saying something on a channel
 264             my $name = $1;
 265             print "$b_yellow$name $printable$ob\n";
 266         } elsif ($printable =~ s/^(<\S+>) //) {
 267             # public message on channel.
 268             my $name = $1;
 269
 270             if ($addressed) {
 271                 print "$b_red$name $printable$ob\n";
 272             } else {
 273                 print "$b_cyan$name$ob $printable$ob\n";
 274             }
 275
 276         } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
 277             # public action.
 278             print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
 279         } elsif ($printable =~ s/^(-\S+-) //) {
 280             # notice
 281             print "$_green$1 $printable$ob\n";
 282         } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
 283             # message/private action from someone
 284             print "$b_white$1$ob" if (defined $1);
 285             print "$b_red$2 $printable$ob\n";
 286         } elsif ($printable =~ s/^(>\S+<) //) {
 287             # i'm messaging someone
 288             print "$b_magenta$1 $printable$ob\n";
 289         } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
 290             # something that should be SEEN
 291             print "$b_green$1 $printable$ob\n";
 292         } else {
 293             print "$printable\n";
 294         }
 295     } else {
 296         print "VERBOSITY IS OFF?\n";
 297     }
 298
 299     # log the line into a file.
 300     return unless (&IsParam("logfile"));
 301     return unless (defined fileno LOG);
 302
 303     # remove control characters from logging.
 304     $input =~ s/\e\[[0-9;]+m//g;
 305     $input =~ s/[\cA-\c_]//g;
 306     $input = "FORK($$) ".$input if ($statcountfix);
 307
 308     my $date;
 309     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
 310         $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]);
 311
 312         my ($day,$month,$year) = (localtime(time()))[3,4,5];
 313         my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
 314         if (defined $logDate and $newlogDate != $logDate) {
 315             &closeLog();
 316             &compress($file{log});
 317             &openLog();
 318         }
 319     } else {
 320         $date = time();
 321     }
 322
 323     print LOG sprintf("%s %s\n", $date, $input);
 324 }
 325
 326 sub openSQLDebug {
 327     if (!open(SQLDEBUG, ">>$param{'SQLDebug'}")) {
 328         &ERROR("cannot open $param{'SQLDebug'}...");
 329         delete $param{'SQLDebug'};
 330         return 0;
 331     }
 332
 333     &status("Opened SQL Debug file: $param{'SQLDebug'}");
 334     return 1;
 335 }
 336
 337 sub closeSQLDebug {
 338     close SQLDEBUG;
 339
 340     &status("Closed SQL Debug file: $param{'SQLDebug'}");
 341 }
 342
 343 1;