src/logger.pl

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