2 # logger.pl: logger functions!
3 # Author: xk <xk@leguin.openprojects.net>
5 # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
10 use vars qw($logDate $loggingstatus $statcount $infobot_pid
11 $statcountfix $addressed);
12 use vars qw(@backlog);
13 use vars qw(%param %file);
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
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);
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');
51 ############################################################################
52 # Implementation (attribute string form)
53 ############################################################################
55 # Return the escape code for a given set of color attributes.
57 my @codes = map { split } @_;
61 unless (defined $attributes{$_}) { die "Invalid attribute name $_" }
62 $attribute .= $attributes{$_} . ';';
65 ($attribute ne '') ? "\e[${attribute}m" : undef;
70 return unless (&IsParam("logfile"));
71 $file{log} = $param{'logfile'};
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;
79 if (open(LOG, ">>$file{log}")) {
80 &status("Opened logfile $file{log}.");
84 &status("cannot open logfile $file{log}; disabling.");
90 # lame fix for paramlogfile.
91 return unless (&IsParam("logfile"));
92 return unless ($loggingstatus);
95 &status("Closed logfile ($file{log}).");
100 # Usage: &compress($file);
103 my @compress = ("/usr/bin/bzip2","/bin/gzip");
107 # ironically this does not get logged :)
108 &WARN("compress: file ($file) does not exist.");
112 if (-f "$file.gz" or -f "$file.bz2") {
113 &WARN("compress: file.(gz|bz2) already exists.");
117 foreach (@compress) {
118 next unless ( -x $_);
120 &status("Compressing '$file' with $_.");
121 system("$_ $file &");
127 &ERROR("no compress program found.");
135 return unless (&IsParam("DEBUG"));
137 &status("${b_green}!DEBUG!$ob $_[0]");
141 &status("${b_red}!ERROR!$ob $_[0]");
145 return unless (&IsParam("WARN"));
147 &status("${b_yellow}!WARN!$ob $_[0]");
151 &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN)");
155 if (!&IsParam("VERBOSITY")) {
157 } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
159 } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
168 # return if input is null'ish.
169 return '' if ($input =~ /^\s*$/);
171 $input =~ s/\002|037//g; # bold,video,underline => remove.
173 # pump up the stats (or loglinenum).
176 # fix style of output if process is child.
177 if (defined $infobot_pid and $$ != $infobot_pid and !defined $statcountfix) {
182 # for logging and non-ansi control.
184 $status = "!$statcount! ".$input;
185 if ($statcount > 1000) {
186 print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
190 $status = "[$statcount] ".$input;
193 if (&IsParam("backlog")) {
194 push(@backlog, $status); # append to end.
195 shift(@backlog) if (scalar @backlog > $param{'backlog'});
198 if (&IsParam("VERBOSITY")) {
200 printf $_red."!%5d!".$ob." ", $statcount;
202 printf $_green."[%5d]".$ob." ", $statcount;
205 # three uberstabs to Derek Moeller.
206 my $printable = $input;
208 if ($printable =~ s/^(<\/\S+>) //) {
209 # it's me saying something on a channel
211 print "$b_yellow$name $printable$ob\n";
212 } elsif ($printable =~ s/^(<\S+>) //) {
213 # public message on channel.
217 print "$b_red$name $printable$ob\n";
219 print "$b_cyan$name$ob $printable$ob\n";
222 } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
224 print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
225 } elsif ($printable =~ s/^(-\S+-) //) {
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";
239 print "$printable\n";
243 # log the line into a file.
244 return unless (&IsParam("logfile"));
245 return unless ($loggingstatus);
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);
253 if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
254 $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]);
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) {
260 &compress($file{log});
267 print LOG sprintf("%s %s\n", $date, $input);