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