3 # irclog2html.pl Version 1.5 - 11th May 2000
4 # Copyright (C) 2000, Jeffrey W. Waugh
7 # Jeff Waugh <jdub@aphid.net>
10 # Rick Welykochy <rick@praxis.com.au>
11 # Alexander Else <aelse@uu.net>
13 # Released under the terms of the GNU GPL
14 # http://www.gnu.org/copyleft/gpl.html
16 # Modified by Tim Riker <Tim@Rikers.org>
17 # to work with infobot logs
18 # then modified again for blootbot
20 # Usage: irclog2html <date> < logfile
22 # irclog2html will write out a colourised irc log, appending a .html
23 # extension to the output file.
26 ####################################################################################
30 $^W = 1; #RW# turn on warnings
31 use POSIX qw(strftime);
34 ####################################################################################
37 # Comment out the "table" assignment to use the plain version
40 #my $STYLE = "simplett";
42 my $STYLE = "simpletable";
44 my $colour_left = "#000099"; # nick leaving channel
45 my $colour_joined = "#009900"; # nick joining channel
46 my $colour_server = "#009900"; # server message (***)
47 my $colour_nickchange = "#009900"; # nick change
48 my $colour_action = "#CC00CC"; # nick action (/me waves)
50 my %prefs_colour_nick = (
52 "cantanker" => "#006600",
53 "chuckd" => "#339999",
57 ####################################################################################
61 my ($channel, $date) = @_;
64 $return .= qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
67 <title>irclog2html for $channel on $date</title>
68 <meta name="generator" content="irclog2html.pl by Jeff Waugh">
69 <meta name="version" content="Version 1.5 - 11th May 2000">
70 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
72 <body text="#000000" bgcolor="#ffffff">
73 <h1>irclog2html for $channel on $date</h1>
76 if ($STYLE =~ /table/) {
77 $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
84 if ($STYLE =~ /table/) {
85 $return .= "</table>\n";
89 <br>Generated by irclog2html.pl by
90 <a href="mailto:jdub\@NOSPAMaphid.net">Jeff Waugh</a> - find it at
91 <a href="http://freshmeat.net/appindex/2000/03/28/954251322.html">freshmeat.net</a>!
92 Modified by <a href="http://www.Rikers.org">Tim Riker</a> to work with
93 <a href="http://blootbot.sourceforge.net/">blootbot</a> logs, split per channel, etc.
104 return if not $lastdate;
106 my @files=`ls $lastdate.html */$lastdate.html`;
107 foreach $filename (@files) {
109 if (!open(OUTPUT, ">>$filename")) {
110 print "Cannot open $filename for writing!\n\n";
113 print OUTPUT footer();
119 my ($date, $time, $channel, $lineout) = @_;
121 add_footers() if $lastdate ne $date;
125 $filename .= "$channel/" if $channel;
126 $filename .= "$date.html";
128 mkdir($channel,oct('755')) if ($channel && ! -d $channel);
129 if (!open(OUTPUT, ">>$filename")) {
130 #print "Cannot open $filename for writing!\n\n";
134 print OUTPUT header($channel, $date) if -z $filename;
136 print OUTPUT $lineout;
141 sub output_timenicktext {
142 my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_;
145 if ($STYLE eq "table") {
147 $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>" if $time;
148 $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
149 $lineout .= "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
151 elsif ($STYLE eq "simpletable") {
152 $lineout .= "<tr bgcolor=\"#eeeeee\">";
153 $lineout .= "<td><tt>$time</tt></td>" if $time;
154 $lineout .= "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
155 $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
157 elsif ($STYLE eq "simplett") {
158 $lineout .= "$time " if $time;
159 $lineout .= "<\;$nick>\; $text<br>\n";
162 $lineout .= "$time " if $time;
163 $lineout .= "<font color=\"$htmlcolour\"><\;$nick>\; $text<\/font><br>\n";
165 output_line($date, $time, $channel, $lineout);
168 sub output_timeservermsg {
169 my ($date, $time, $channel, $line) = @_;
172 if ($STYLE =~ /table/) {
174 $lineout .= "<td><tt>$time</tt></td>" if $time;
175 $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
178 $lineout .= "$time " if $time;
179 $lineout .= "$line<br>\n";
181 output_line($date, $time, $channel, $lineout);
186 my ($i,$ncolours) = @_;
187 $ncolours = 1 if $ncolours == 0;
189 my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
192 my $a = 0.95; # tune these for the starting and ending concentrations of R,G,B
195 my $rgb = [ [$a,$c,$c], [$c,$a,$c], [$c,$c,$a], [$a,$a,$c], [$a,$c,$a], [$c,$a,$a] ];
197 my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
199 my $r = $rgb->[$n][0] * $m;
200 my $g = $rgb->[$n][1] * $m;
201 my $b = $rgb->[$n][2] * $m;
202 sprintf("#%02x%02x%02x",$r,$g,$b);
205 ####################################################################################
223 my %colour_nick = %prefs_colour_nick;
225 while ($line = <STDIN>) {
231 if ($line =~ s/^([0-9:\.]*) (.*)$/$2/) {
238 # Replace ampersands, pointies, control characters #
239 $line =~ s/&/&\;/g;
240 $line =~ s/</<\;/g;
241 $line =~ s/>/>\;/g;
242 $line =~ s/\e\[[0-1]*m//g;
243 $line =~ s/[\x00-\x1f]+//g;
245 # Replace possible URLs with links #
246 $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
248 # Colourise the comments
249 if ($line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/) {
250 # Split $nick, $channel and $line
252 $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
254 $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/;
256 # $nick =~ tr/[A-Z]/[a-z]/;
257 # <======= move this into another function when getting nick colour
260 $text =~ s/^<\;.*?>\; (.*)$/$1/;
261 $text =~ s/^ .*/<\;PROTECTED>\;/g;
262 $text =~ s/ / \; \;/g;
264 $htmlcolour = $colour_nick{$nick};
265 if (!defined($htmlcolour)) {
269 # if we've exceeded our estimate of the number of nicks, double it
270 $NICKMAX *= 2 if $nickcount >= $NICKMAX;
272 $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
274 output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour);
275 } elsif ($line =~ /^>\;>\;>\; /) {
276 $line =~ s/^>\;>\;>\; /\*\*\* /;
278 # Process changed nick results, and remember colours accordingly #
279 if ($line =~ /\*\*\* (.*?) materializes into (.*)/) {
284 #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
286 #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
288 $colour_nick{$nick_new} = $colour_nick{$nick_old};
289 $colour_nick{$nick_old} = undef;
291 $line =~ s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/
292 } elsif ($line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/) {
294 $line =~ s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
295 } elsif ($line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/) {
297 $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
298 } elsif ($line =~ /\*\*\* .* has signed off IRC .*/) {
299 # Colourise joined/left/server messages #
300 $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
301 } elsif ($line =~ /\*\*\* /) {
302 $line =~ s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
303 } elsif ($line =~ /^\* .*$/) {
304 # Colourise the /me's #
305 $line =~ s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
308 output_timeservermsg($date, $time, $channel, $line);
319 print "Usage: irclog2html.pl <date> < logfile\n";
320 print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n";