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     my $error = 0;
  77     my $path = &getPath($file{log});
  78     while (! -d $path) {
  79         if ($error) {
  80             &ERROR("openLog: failed opening log to $file{log}; disabling.");
  81             delete $param{'logfile'};
  82             return;
  83         }
  84
  85         &status("openLog: making $path.");
  86         last if (mkdir $path, 0755);
  87         $error++;
  88     }
  89
  90     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
  91         my ($day,$month,$year) = (localtime(time()))[3,4,5];
  92         $logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
  93         $file{log} .= "-".$logDate;
  94     }
  95
  96     if (open(LOG, ">>$file{log}")) {
  97         &status("Opened logfile $file{log}.");
  98         LOG->autoflush(1);
  99         $loggingstatus = 1;
 100     } else {
 101         &status("cannot open logfile $file{log}; disabling.");
 102         $loggingstatus = 0;
 103     }
 104 }
 105
 106 sub closeLog {
 107     # lame fix for paramlogfile.
 108     return unless (&IsParam("logfile"));
 109     return unless ($loggingstatus);
 110
 111     $loggingstatus = 0;
 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     &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     # return if input is null'ish.
 190     return '' if ($input =~ /^\s*$/);
 191     $input =~ s/\n+$//;
 192     $input =~ s/\002|037//g;    # bold,video,underline => remove.
 193
 194     # pump up the stats (or loglinenum).
 195     $statcount++;
 196
 197     # fix style of output if process is child.
 198     if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) {
 199         $statcount      = 1;
 200         $statcountfix   = 1;
 201     }
 202
 203     ### LOG THROTTLING.
 204     ### TODO: move this _after_ printing?
 205     my $time = time();
 206     my $reset = 0;
 207     if ($logtime != $time) {
 208         $reset++;
 209     } elsif ($logtime == $time) {
 210         if ($logcount < 25) {           # too high?
 211             $logcount++;
 212         } else {
 213             sleep 1;
 214             &status("LOG: Throttling.");        # recursive?
 215             $reset++;
 216         }
 217     }
 218     if ($reset) {
 219         $logtime        = $time;
 220         $logcount       = 0;
 221     }
 222
 223     # Log differently for forked/non-forked output.
 224     if ($statcountfix) {
 225         $status = "!$statcount! ".$input;
 226         if ($statcount > 1000) {
 227             print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
 228             exit 0;
 229         }
 230     } else {
 231         $status = "[$statcount] ".$input;
 232     }
 233
 234     if (&IsParam("backlog")) {
 235         push(@backlog, $status);        # append to end.
 236         shift(@backlog) if (scalar @backlog > $param{'backlog'});
 237     }
 238
 239     if (&IsParam("VERBOSITY")) {
 240         if ($statcountfix) {
 241             printf $_red."!%5d!".$ob." ", $statcount;
 242         } else {
 243             printf $_green."[%5d]".$ob." ", $statcount;
 244         }
 245
 246         # three uberstabs to Derek Moeller.
 247         my $printable = $input;
 248
 249         if ($printable =~ s/^(<\/\S+>) //) {
 250             # it's me saying something on a channel
 251             my $name = $1;
 252             print "$b_yellow$name $printable$ob\n";
 253         } elsif ($printable =~ s/^(<\S+>) //) {
 254             # public message on channel.
 255             my $name = $1;
 256
 257             if ($addressed) {
 258                 print "$b_red$name $printable$ob\n";
 259             } else {
 260                 print "$b_cyan$name$ob $printable$ob\n";
 261             }
 262
 263         } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
 264             # public action.
 265             print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
 266         } elsif ($printable =~ s/^(-\S+-) //) {
 267             # notice
 268             print "$_green$1 $printable$ob\n";
 269         } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
 270             # message/private action from someone
 271             print "$b_white$1$ob" if (defined $1);
 272             print "$b_red$2 $printable$ob\n";
 273         } elsif ($printable =~ s/^(>\S+<) //) {
 274             # i'm messaging someone
 275             print "$b_magenta$1 $printable$ob\n";
 276         } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
 277             # something that should be SEEN
 278             print "$b_green$1 $printable$ob\n";
 279         } else {
 280             print "$printable\n";
 281         }
 282     } else {
 283         print "VERBOSITY IS OFF?\n";
 284     }
 285
 286     # log the line into a file.
 287     return unless (&IsParam("logfile"));
 288     return unless ($loggingstatus);
 289
 290     # remove control characters from logging.
 291     $input =~ s/\e\[[0-9;]+m//g;
 292     $input =~ s/[\cA-\c_]//g;
 293     $input = "FORK($$) ".$input if ($statcountfix);
 294
 295     my $date;
 296     if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
 297         $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]);
 298
 299         my ($day,$month,$year) = (localtime(time()))[3,4,5];
 300         my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
 301         if (defined $logDate and $newlogDate != $logDate) {
 302             &closeLog();
 303             &compress($file{log});
 304             &openLog();
 305         }
 306     } else {
 307         $date = time();
 308     }
 309
 310     print LOG sprintf("%s %s\n", $date, $input);
 311 }
 312
 313 1;