-#!/usr/bin/perl
+#!/usr/bin/perl -w
# irclog2html.pl Version 1.5 - 11th May 2000
# Copyright (C) 2000, Jeffrey W. Waugh
# Modified by Tim Riker <Tim@Rikers.org>
# to work with infobot logs
-# then modified again for blootbot
+# then modified again for infobot
# Usage: irclog2html <date> < logfile
# irclog2html will write out a colourised irc log, appending a .html
# extension to the output file.
-
####################################################################################
# Perl Configuration
use strict;
-$^W = 1; #RW# turn on warnings
+$^W = 1; #RW# turn on warnings
use POSIX qw(strftime);
-
####################################################################################
# Preferences
# Comment out the "table" assignment to use the plain version
-#my $STYLE = "tt";
-#my $STYLE = "simplett";
-#my $STYLE = "table";
-my $STYLE = "simpletable";
+#my $STYLE = "tt";
+#my $STYLE = "simplett";
+#my $STYLE = "table";
+my $STYLE = "simpletable";
-my $colour_left = "#000099"; # nick leaving channel
-my $colour_joined = "#009900"; # nick joining channel
-my $colour_server = "#009900"; # server message (***)
-my $colour_nickchange = "#009900"; # nick change
-my $colour_action = "#CC00CC"; # nick action (/me waves)
+my $colour_left = "#000099"; # nick leaving channel
+my $colour_joined = "#009900"; # nick joining channel
+my $colour_server = "#009900"; # server message (***)
+my $colour_nickchange = "#009900"; # nick change
+my $colour_action = "#CC00CC"; # nick action (/me waves)
my %prefs_colour_nick = (
- "jdub" => "#993333",
- "cantanker" => "#006600",
- "chuckd" => "#339999",
+ "jdub" => "#993333",
+ "cantanker" => "#006600",
+ "chuckd" => "#339999",
);
-
####################################################################################
# Utility Functions
sub header {
- my ($channel, $date) = @_;
- my $return = '';
+ my ( $channel, $date ) = @_;
+ my $return = '';
- $return .= qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+ $return .=
+ qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
- <title>irclog2html for $channel on $date</title>
- <meta name="generator" content="irclog2html.pl by Jeff Waugh">
- <meta name="version" content="Version 1.5 - 11th May 2000">
- <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+ <title>irclog2html for $channel on $date</title>
+ <meta name="generator" content="irclog2html.pl by Jeff Waugh">
+ <meta name="version" content="Version 1.5 - 11th May 2000">
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
</head>
<body text="#000000" bgcolor="#ffffff">
<h1>irclog2html for $channel on $date</h1>
};
- if ($STYLE =~ /table/) {
- $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
- }
- return $return;
+ if ( $STYLE =~ /table/ ) {
+ $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
+ }
+ return $return;
}
sub footer {
- my $return = '';
- if ($STYLE =~ /table/) {
- $return .= "</table>\n";
- }
+ my $return = '';
+ if ( $STYLE =~ /table/ ) {
+ $return .= "</table>\n";
+ }
- $return .= qq{
+ $return .= qq{
<br>Generated by irclog2html.pl by
<a href="mailto:jdub\@NOSPAMaphid.net">Jeff Waugh</a> - find it at
<a href="http://freshmeat.net/appindex/2000/03/28/954251322.html">freshmeat.net</a>!
Modified by <a href="http://www.Rikers.org">Tim Riker</a> to work with
-<a href="http://blootbot.sourceforge.net/">blootbot</a> logs, split per channel, etc.
+<a href="http://infobot.sourceforge.net/">infobot</a> logs, split per channel, etc.
</body></html>
};
- return $return;
+ return $return;
}
my $lastdate = '';
sub add_footers {
- my $filename;
-
- return if not $lastdate;
-
- my @files=`ls $lastdate.html */$lastdate.html`;
- foreach $filename (@files) {
- chomp $filename;
- if (!open(OUTPUT, ">>$filename")) {
- die "Cannot open $filename for writing!\n\n";
- }
- print OUTPUT footer();
- close OUTPUT;
- }
+ my $filename;
+
+ return if not $lastdate;
+
+ my @files = `ls $lastdate.html */$lastdate.html`;
+ foreach $filename (@files) {
+ chomp $filename;
+ if ( !open( OUTPUT, ">>$filename" ) ) {
+ print "Cannot open $filename for writing!\n\n";
+ return;
+ }
+ print OUTPUT footer();
+ close OUTPUT;
+ }
}
sub output_line {
- my ($date, $time, $channel, $lineout) = @_;
+ my ( $date, $time, $channel, $lineout ) = @_;
- add_footers() if $lastdate ne $date;
+ add_footers() if $lastdate ne $date;
- $lastdate = $date;
- my $filename = "";
- $filename .= "$channel/" if $channel;
- $filename .= "$date.html";
+ $lastdate = $date;
+ my $filename = "";
+ $filename .= "$channel/" if $channel;
+ $filename .= "$date.html";
- mkdir($channel,oct('755')) if ($channel && ! -d $channel);
- if (!open(OUTPUT, ">>$filename")) {
- die "Cannot open $filename for writing!\n\n";
- }
- # Begin output #
- print OUTPUT header($channel, $date) if -z $filename;
+ mkdir( $channel, oct('755') ) if ( $channel && !-d $channel );
+ if ( !open( OUTPUT, ">>$filename" ) ) {
- print OUTPUT $lineout;
+ #print "Cannot open $filename for writing!\n\n";
+ return;
+ }
- close OUTPUT;
+ # Begin output #
+ print OUTPUT header( $channel, $date ) if -z $filename;
+
+ print OUTPUT $lineout;
+
+ close OUTPUT;
}
sub output_timenicktext {
- my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_;
- my $lineout = '';
-
- if ($STYLE eq "table") {
- $lineout .= "<tr>";
- $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>" if $time;
- $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
- $lineout .= "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
- }
- elsif ($STYLE eq "simpletable") {
- $lineout .= "<tr bgcolor=\"#eeeeee\">";
- $lineout .= "<td><tt>$time</tt></td>" if $time;
- $lineout .= "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
- $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
- }
- elsif ($STYLE eq "simplett") {
- $lineout .= "$time " if $time;
- $lineout .= "<\;$nick>\; $text<br>\n";
- }
- else {
- $lineout .= "$time " if $time;
- $lineout .= "<font color=\"$htmlcolour\"><\;$nick>\; $text<\/font><br>\n";
- }
- output_line($date, $time, $channel, $lineout);
+ my ( $date, $time, $channel, $nick, $text, $htmlcolour ) = @_;
+ my $lineout = '';
+
+ if ( $STYLE eq "table" ) {
+ $lineout .= "<tr>";
+ $lineout .=
+"<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>"
+ if $time;
+ $lineout .=
+"<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
+ $lineout .=
+"<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
+ }
+ elsif ( $STYLE eq "simpletable" ) {
+ $lineout .= "<tr bgcolor=\"#eeeeee\">";
+ $lineout .= "<td><tt>$time</tt></td>" if $time;
+ $lineout .=
+ "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
+ $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
+ }
+ elsif ( $STYLE eq "simplett" ) {
+ $lineout .= "$time " if $time;
+ $lineout .= "<\;$nick>\; $text<br>\n";
+ }
+ else {
+ $lineout .= "$time " if $time;
+ $lineout .=
+ "<font color=\"$htmlcolour\"><\;$nick>\; $text<\/font><br>\n";
+ }
+ output_line( $date, $time, $channel, $lineout );
}
sub output_timeservermsg {
- my ($date, $time, $line) = @_;
- my $lineout = '';
-
- if ($STYLE =~ /table/) {
- $lineout .= "<tr>";
- $lineout .= "<td><tt>$time</tt></td>" if $time;
- $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
- }
- else {
- $lineout .= "$time " if $time;
- $lineout .= "$line<br>\n";
- }
- output_line($date, $time,'',$lineout);
+ my ( $date, $time, $channel, $line ) = @_;
+ my $lineout = '';
+
+ if ( $STYLE =~ /table/ ) {
+ $lineout .= "<tr>";
+ $lineout .= "<td><tt>$time</tt></td>" if $time;
+ $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
+ }
+ else {
+ $lineout .= "$time " if $time;
+ $lineout .= "$line<br>\n";
+ }
+ output_line( $date, $time, $channel, $lineout );
}
-sub html_rgb
-{
- my ($i,$ncolours) = @_;
- $ncolours = 1 if $ncolours == 0;
-
- my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
- my $rgbmin = 240;
-
- my $a = 0.95; # tune these for the starting and ending concentrations of R,G,B
- my $b = 0.5;
-
- my $rgb = [ [$a,$b,$b], [$b,$a,$b], [$b,$b,$a], [$a,$a,$b], [$a,$b,$a], [$b,$a,$a] ];
- my $n = $i % @$rgb;
- my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
-
- my $r = $rgb->[$n][0] * $m;
- my $g = $rgb->[$n][1] * $m;
- my $b = $rgb->[$n][2] * $m;
- sprintf("#%02x%02x%02x",$r,$g,$b);
+sub html_rgb {
+ my ( $i, $ncolours ) = @_;
+ $ncolours = 1 if $ncolours == 0;
+
+ my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
+ my $rgbmin = 240;
+
+ my $a =
+ 0.95; # tune these for the starting and ending concentrations of R,G,B
+ my $c = 0.5;
+
+ my $rgb = [
+ [ $a, $c, $c ],
+ [ $c, $a, $c ],
+ [ $c, $c, $a ],
+ [ $a, $a, $c ],
+ [ $a, $c, $a ],
+ [ $c, $a, $a ]
+ ];
+ my $n = $i % @$rgb;
+ my $m = $rgbmin + ( $rgbmax - $rgbmin ) * ( $ncolours - $i ) / $ncolours;
+
+ my $r = $rgb->[$n][0] * $m;
+ my $g = $rgb->[$n][1] * $m;
+ my $b = $rgb->[$n][2] * $m;
+ sprintf( "#%02x%02x%02x", $r, $g, $b );
}
####################################################################################
# Main
sub main {
- my ($date) = @_;
- my $files;
-
- my $line;
- my $time;
- my $lastdate = "";
- my $nick;
- my $channel;
- my $text;
-
- my $htmlcolour;
- my $nickcount = 0;
- my $NICKMAX = 30;
-
- my %colour_nick = %prefs_colour_nick;
-
- while ($line = <STDIN>) {
-
- chomp $line;
-
- if (!$line eq "") {
-
- # parse out the time
- if ($line =~ s/^([0-9:\.]*) (.*)$/\2/) {
- $time = $1;
- } else {
- $time = "";
- }
-
- # Replace ampersands, pointies, control characters #
- $line =~ s/&/&\;/g;
- $line =~ s/</<\;/g;
- $line =~ s/>/>\;/g;
- $line =~ s/\e\[[0-1]*m//g;
- $line =~ s/[\x00-\x1f]+//g;
-
- # Replace possible URLs with links #
- $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
-
- # Colourise the comments
- if ($line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/) {
- # Split $nick, $channel and $line
- $nick = $line;
- $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
- $channel = $line;
- $channel =~ s/^<\;[^\/]*?\/\#(.*?)>\; .*$/$1/;
-
- # $nick =~ tr/[A-Z]/[a-z]/;
- # <======= move this into another function when getting nick colour
-
- $text = $line;
- $text =~ s/^<\;.*?>\; (.*)$/$1/;
- $text =~ s/ / \; \;/g;
-
- $htmlcolour = $colour_nick{$nick};
- if (!defined($htmlcolour)) {
- # new nick
- $nickcount++;
-
- # if we've exceeded our estimate of the number of nicks, double it
- $NICKMAX *= 2 if $nickcount >= $NICKMAX;
-
- $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
- }
- output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour);
- }
-
- elsif ($line =~ /^>\;>\;>\; /) {
- $line =~ s/^>\;>\;>\; /\*\*\* /;
-
- # Process changed nick results, and remember colours accordingly #
- if ($line =~ /\*\*\* (.*?) are|is now known as (.*)/) {
- my $nick_old;
- my $nick_new;
-
- $nick_old = $line;
- $nick_old =~ s/\*\*\* (.*?) (are|is) now known as .*/$1/;
-
- $nick_new = $line;
- $nick_new =~ s/\*\*\* .*? (are|is) now known as (.*)/$2/;
-
- $colour_nick{$nick_new} = $colour_nick{$nick_old};
- $colour_nick{$nick_old} = undef;
-
- $line =~ s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/
- }
-
- # Colourise joined/left/server messages #
- elsif ($line =~ /\*\*\* .*left|quit/) {
- $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
- }
- elsif ($line =~ /\*\*\* .*joined/) {
- $line =~ s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
- }
- elsif ($line =~ /\*\*\* /) {
- $line =~ s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
- }
-
- # Colourise the /me's #
- elsif ($line =~ /^\* .*$/) {
- $line =~ s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
- }
-
- output_timeservermsg($date, $time, $line);
- }
- }
- }
-
- add_footers();
-
- return 0;
+ my ($date) = @_;
+ my $files;
+
+ my $line;
+ my $time;
+ my $lastdate = "";
+ my $nick;
+ my $channel;
+ my $text;
+
+ my $htmlcolour;
+ my $nickcount = 0;
+ my $NICKMAX = 30;
+
+ my %colour_nick = %prefs_colour_nick;
+
+ while ( $line = <STDIN> ) {
+
+ chomp $line;
+
+ if ( !$line eq "" ) {
+
+ # parse out the time
+ if ( $line =~ s/^([0-9:\.]*) (.*)$/$2/ ) {
+ $time = $1;
+ }
+ else {
+ $time = '';
+ }
+ $channel = '';
+
+ # Replace ampersands, pointies, control characters #
+ $line =~ s/&/&\;/g;
+ $line =~ s/</<\;/g;
+ $line =~ s/>/>\;/g;
+ $line =~ s/\e\[[0-1]*m//g;
+ $line =~ s/[\x00-\x1f]+//g;
+
+ # Replace possible URLs with links #
+ $line =~
+ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
+
+ # Colourise the comments
+ if ( $line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/ ) {
+
+ # Split $nick, $channel and $line
+ $nick = $line;
+ $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
+ $channel = $line;
+ $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/;
+
+ # $nick =~ tr/[A-Z]/[a-z]/;
+ # <======= move this into another function when getting nick colour
+
+ $text = $line;
+ $text =~ s/^<\;.*?>\; (.*)$/$1/;
+ $text =~ s/^ .*/<\;PROTECTED>\;/g;
+ $text =~ s/ / \; \;/g;
+
+ $htmlcolour = $colour_nick{$nick};
+ if ( !defined($htmlcolour) ) {
+
+ # new nick
+ $nickcount++;
+
+ # if we've exceeded our estimate of the number of nicks, double it
+ $NICKMAX *= 2 if $nickcount >= $NICKMAX;
+
+ $htmlcolour = $colour_nick{$nick} =
+ html_rgb( $nickcount, $NICKMAX );
+ }
+ output_timenicktext( $date, $time, $channel, $nick, $text, $htmlcolour );
+ }
+ elsif ( $line =~ /^\* ([^ \/]+)\/(\#[^ ]+) (.+)/ ) {
+ # Colourise the /me's #
+ $nick=$1;
+ $channel=$2;
+ $text="<font color=\"$colour_action\">$3</font>";
+ $htmlcolour = $colour_nick{$nick};
+ if ( !defined($htmlcolour) ) {
+
+ # new nick
+ $nickcount++;
+
+ # if we've exceeded our estimate of the number of nicks, double it
+ $NICKMAX *= 2 if $nickcount >= $NICKMAX;
+
+ $htmlcolour = $colour_nick{$nick} =
+ html_rgb( $nickcount, $NICKMAX );
+ }
+ output_timenicktext( $date, $time, $channel, $nick, $text, $htmlcolour );
+ }
+ elsif ( $line =~ /^>\;>\;>\; / ) {
+ $line =~ s/^>\;>\;>\; /\*\*\* /;
+
+ # Process changed nick results, and remember colours accordingly #
+ if ( $line =~ /\*\*\* (.*?) materializes into (.*)/ ) {
+ my $nick_old = $1;
+ my $nick_new = $2;
+
+ #$nick_old = $line;
+ #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
+ #$nick_new = $line;
+ #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
+
+ $colour_nick{$nick_new} = $colour_nick{$nick_old};
+ $colour_nick{$nick_old} = undef;
+
+ $line =~ s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/ ) {
+ $channel = lc $2;
+ $line =~
+ s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/ ) {
+ $channel = lc $2;
+ $line =~
+ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* .* has signed off IRC .*/ ) {
+
+ # Colourise joined/left/server messages #
+ $line =~
+ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* / ) {
+ $line =~
+ s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
+ }
+ elsif ( $line =~ /^\* .*$/ ) {
+
+ # Colourise the /me's #
+ $line =~
+ s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
+ }
+
+ output_timeservermsg( $date, $time, $channel, $line );
+ }
+ }
+ }
+
+ add_footers();
+
+ return 0;
}
-if (!scalar @ARGV) {
- print "Usage: irclog2html.pl <date> < logfile\n";
- print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n";
+if ( !scalar @ARGV ) {
+ print "Usage: irclog2html.pl <date> < logfile\n";
+ print
+ "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n";
exit 0;
}
my $date = shift;
exit &main($date);
-# vim: ts=2
+
+# vim:ts=4:sw=4:expandtab:tw=80