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 infobot
20 # Usage: irclog2html <date> < logfile
22 # irclog2html will write out a colourised irc log, appending a .html
23 # extension to the output file.
25 ####################################################################################
29 $^W = 1; #RW# turn on warnings
30 use POSIX qw(strftime);
32 ####################################################################################
35 # Comment out the "table" assignment to use the plain version
38 #my $STYLE = "simplett";
40 my $STYLE = "simpletable";
42 my $colour_left = "#000099"; # nick leaving channel
43 my $colour_joined = "#009900"; # nick joining channel
44 my $colour_server = "#009900"; # server message (***)
45 my $colour_nickchange = "#009900"; # nick change
46 my $colour_action = "#CC00CC"; # nick action (/me waves)
48 my %prefs_colour_nick = (
50 "cantanker" => "#006600",
51 "chuckd" => "#339999",
54 ####################################################################################
58 my ( $channel, $date ) = @_;
62 qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
65 <title>irclog2html for $channel on $date</title>
66 <meta name="generator" content="irclog2html.pl by Jeff Waugh">
67 <meta name="version" content="Version 1.5 - 11th May 2000">
68 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
70 <body text="#000000" bgcolor="#ffffff">
71 <h1>irclog2html for $channel on $date</h1>
74 if ( $STYLE =~ /table/ ) {
75 $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
82 if ( $STYLE =~ /table/ ) {
83 $return .= "</table>\n";
87 <br>Generated by irclog2html.pl by
88 <a href="mailto:jdub\@NOSPAMaphid.net">Jeff Waugh</a> - find it at
89 <a href="http://freshmeat.net/appindex/2000/03/28/954251322.html">freshmeat.net</a>!
90 Modified by <a href="http://www.Rikers.org">Tim Riker</a> to work with
91 <a href="http://infobot.sourceforge.net/">infobot</a> logs, split per channel, etc.
102 return if not $lastdate;
104 my @files = `ls $lastdate.html */$lastdate.html`;
105 foreach $filename (@files) {
107 if ( !open( OUTPUT, ">>$filename" ) ) {
108 print "Cannot open $filename for writing!\n\n";
111 print OUTPUT footer();
117 my ( $date, $time, $channel, $lineout ) = @_;
119 add_footers() if $lastdate ne $date;
123 $filename .= "$channel/" if $channel;
124 $filename .= "$date.html";
126 mkdir( $channel, oct('755') ) if ( $channel && !-d $channel );
127 if ( !open( OUTPUT, ">>$filename" ) ) {
129 #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" ) {
148 "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>"
151 "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
153 "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
155 elsif ( $STYLE eq "simpletable" ) {
156 $lineout .= "<tr bgcolor=\"#eeeeee\">";
157 $lineout .= "<td><tt>$time</tt></td>" if $time;
159 "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
160 $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
162 elsif ( $STYLE eq "simplett" ) {
163 $lineout .= "$time " if $time;
164 $lineout .= "<\;$nick>\; $text<br>\n";
167 $lineout .= "$time " if $time;
169 "<font color=\"$htmlcolour\"><\;$nick>\; $text<\/font><br>\n";
171 output_line( $date, $time, $channel, $lineout );
174 sub output_timeservermsg {
175 my ( $date, $time, $channel, $line ) = @_;
178 if ( $STYLE =~ /table/ ) {
180 $lineout .= "<td><tt>$time</tt></td>" if $time;
181 $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
184 $lineout .= "$time " if $time;
185 $lineout .= "$line<br>\n";
187 output_line( $date, $time, $channel, $lineout );
191 my ( $i, $ncolours ) = @_;
192 $ncolours = 1 if $ncolours == 0;
194 my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
198 0.95; # tune these for the starting and ending concentrations of R,G,B
210 my $m = $rgbmin + ( $rgbmax - $rgbmin ) * ( $ncolours - $i ) / $ncolours;
212 my $r = $rgb->[$n][0] * $m;
213 my $g = $rgb->[$n][1] * $m;
214 my $b = $rgb->[$n][2] * $m;
215 sprintf( "#%02x%02x%02x", $r, $g, $b );
218 ####################################################################################
236 my %colour_nick = %prefs_colour_nick;
238 while ( $line = <STDIN> ) {
242 if ( !$line eq "" ) {
245 if ( $line =~ s/^([0-9:\.]*) (.*)$/$2/ ) {
253 # Replace ampersands, pointies, control characters #
254 $line =~ s/&/&\;/g;
255 $line =~ s/</<\;/g;
256 $line =~ s/>/>\;/g;
257 $line =~ s/\e\[[0-1]*m//g;
258 $line =~ s/[\x00-\x1f]+//g;
260 # Replace possible URLs with links #
262 s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
264 # Colourise the comments
265 if ( $line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/ ) {
267 # Split $nick, $channel and $line
269 $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
271 $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/;
273 # $nick =~ tr/[A-Z]/[a-z]/;
274 # <======= move this into another function when getting nick colour
277 $text =~ s/^<\;.*?>\; (.*)$/$1/;
278 $text =~ s/^ .*/<\;PROTECTED>\;/g;
279 $text =~ s/ / \; \;/g;
281 $htmlcolour = $colour_nick{$nick};
282 if ( !defined($htmlcolour) ) {
287 # if we've exceeded our estimate of the number of nicks, double it
288 $NICKMAX *= 2 if $nickcount >= $NICKMAX;
290 $htmlcolour = $colour_nick{$nick} =
291 html_rgb( $nickcount, $NICKMAX );
293 output_timenicktext( $date, $time, $channel, $nick, $text,
296 elsif ( $line =~ /^>\;>\;>\; / ) {
297 $line =~ s/^>\;>\;>\; /\*\*\* /;
299 # Process changed nick results, and remember colours accordingly #
300 if ( $line =~ /\*\*\* (.*?) materializes into (.*)/ ) {
305 #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
307 #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
309 $colour_nick{$nick_new} = $colour_nick{$nick_old};
310 $colour_nick{$nick_old} = undef;
313 s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/;
315 elsif ( $line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/ ) {
318 s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
320 elsif ( $line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/ ) {
323 s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
325 elsif ( $line =~ /\*\*\* .* has signed off IRC .*/ ) {
327 # Colourise joined/left/server messages #
329 s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
331 elsif ( $line =~ /\*\*\* / ) {
333 s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
335 elsif ( $line =~ /^\* .*$/ ) {
337 # Colourise the /me's #
339 s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
342 output_timeservermsg( $date, $time, $channel, $line );
352 if ( !scalar @ARGV ) {
353 print "Usage: irclog2html.pl <date> < logfile\n";
355 "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n";
361 # vim:ts=4:sw=4:expandtab:tw=80