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.0 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 0.9 - 5th April 2000">
70 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
72 <body text="#000000" bgcolor="#ffffff"><tt>
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 die "Cannot open $filename for writing!\n\n";
112 print OUTPUT footer();
118 my ($date, $time, $channel, $lineout) = @_;
120 add_footers() if $lastdate ne $date;
124 $filename .= "$channel/" if $channel;
125 $filename .= "$date.html";
127 mkdir($channel,oct('755')) if ($channel && ! -d $channel);
128 if (!open(OUTPUT, ">>$filename")) {
129 die "Cannot open $filename for writing!\n\n";
132 print OUTPUT header($channel, $date) if -z $filename;
134 print OUTPUT $lineout;
139 sub output_timenicktext {
140 my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_;
143 if ($STYLE eq "table") {
145 $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>" if $time;
146 $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
147 $lineout .= "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
149 elsif ($STYLE eq "simpletable") {
150 $lineout .= "<tr bgcolor=\"#eeeeee\">";
151 $lineout .= "<td><tt>$time</tt></td>" if $time;
152 $lineout .= "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
153 $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
155 elsif ($STYLE eq "simplett") {
156 $lineout .= "$time " if $time;
157 $lineout .= "<\;$nick>\; $text<br>\n";
160 $lineout .= "$time " if $time;
161 $lineout .= "<font color=\"$htmlcolour\"><\;$nick>\; $text<\/font><br>\n";
163 output_line($date, $time,$channel,$lineout);
166 sub output_timeservermsg {
167 my ($date, $time, $line) = @_;
170 if ($STYLE =~ /table/) {
172 $lineout .= "<td><tt>$time</tt></td>" if $time;
173 $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
176 $lineout .= "$time " if $time;
177 $lineout .= "$line<br>\n";
179 output_line($date, $time,'',$lineout);
184 my ($i,$ncolours) = @_;
185 $ncolours = 1 if $ncolours == 0;
187 my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
190 my $a = 0.95; # tune these for the starting and ending concentrations of R,G,B
193 my $rgb = [ [$a,$b,$b], [$b,$a,$b], [$b,$b,$a], [$a,$a,$b], [$a,$b,$a], [$b,$a,$a] ];
195 my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
197 my $r = $rgb->[$n][0] * $m;
198 my $g = $rgb->[$n][1] * $m;
199 my $b = $rgb->[$n][2] * $m;
200 sprintf("#%02x%02x%02x",$r,$g,$b);
203 ####################################################################################
221 my %colour_nick = %prefs_colour_nick;
223 while ($line = <STDIN>) {
230 if ($line =~ s/^([0-9:\.]*) (.*)$/\2/) {
236 # Replace ampersands, pointies, control characters #
237 $line =~ s/&/&\;/g;
238 $line =~ s/</<\;/g;
239 $line =~ s/>/>\;/g;
240 $line =~ s/\e\[[0-1]*m//g;
241 $line =~ s/[\x00-\x1f]+//g;
243 # Replace possible URLs with links #
244 $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
246 # Colourise the comments
247 if ($line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/) {
248 # Split $nick, $channel and $line
250 $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
252 $channel =~ s/^<\;[^\/]*?\/\#(.*?)>\; .*$/$1/;
254 # $nick =~ tr/[A-Z]/[a-z]/;
255 # <======= move this into another function when getting nick colour
258 $text =~ s/^<\;.*?>\; (.*)$/$1/;
259 $text =~ s/ / \; \;/g;
261 $htmlcolour = $colour_nick{$nick};
262 if (!defined($htmlcolour)) {
266 # if we've exceeded our estimate of the number of nicks, double it
267 $NICKMAX *= 2 if $nickcount >= $NICKMAX;
269 $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
271 output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour);
274 elsif ($line =~ /^>\;>\;>\; /) {
275 $line =~ s/^>\;>\;>\; /\*\*\* /;
277 # Process changed nick results, and remember colours accordingly #
278 if ($line =~ /\*\*\* (.*?) are|is now known as (.*)/) {
283 $nick_old =~ s/\*\*\* (.*?) (are|is) now known as .*/$1/;
286 $nick_new =~ s/\*\*\* .*? (are|is) now known as (.*)/$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>/
294 # Colourise joined/left/server messages #
295 elsif ($line =~ /\*\*\* .*left|quit/) {
296 $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
298 elsif ($line =~ /\*\*\* .*joined/) {
299 $line =~ s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
301 elsif ($line =~ /\*\*\* /) {
302 $line =~ s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
305 # Colourise the /me's #
306 elsif ($line =~ /^\* .*$/) {
307 $line =~ s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
310 output_timeservermsg($date, $time, $line);
321 print "Usage: irclog2html.pl <date> < logfile\n";
322 print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n";