#!/usr/bin/perl

# irclog2html.pl Version 1.5 - 11th May 2000
# Copyright (C) 2000, Jeffrey W. Waugh

# Author:
#   Jeff Waugh <jdub@aphid.net>

# Contributors:
#   Rick Welykochy <rick@praxis.com.au>
#   Alexander Else <aelse@uu.net>

# Released under the terms of the GNU GPL
# http://www.gnu.org/copyleft/gpl.html

# Modified by Tim Riker <Tim@Rikers.org>
# to work with infobot logs
# then modified again for blootbot

# 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
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 $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",
);


####################################################################################
# Utility Functions

sub header {
	my ($channel, $date) = @_;
	my $return = '';

	$return .= qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 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 0.9 - 5th April 2000">
	<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>
<body text="#000000" bgcolor="#ffffff"><tt>
<h1>irclog2html for $channel on $date</h1>
};

	if ($STYLE =~ /table/) {
		$return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
	}
	return $return;
}

sub footer {
	my $return = '';
	if ($STYLE =~ /table/) {
		$return .= "</table>\n";
	}

	$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.
</tt></body></html>
};
	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;
	}
}

sub output_line {
	my ($date, $time, $channel, $lineout) = @_;

	add_footers() if $lastdate ne $date;

	$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;

	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 .= "&lt\;$nick&gt\; $text<br>\n";
	}
	else {
		$lineout .= "$time " if $time;
		$lineout .= "<font color=\"$htmlcolour\">&lt\;$nick&gt\; $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);
}

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);
}

####################################################################################
# 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/&/&amp\;/g;
			$line =~ s/</&lt\;/g;
			$line =~ s/>/&gt\;/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 =~ /^&lt\;[^\/]*?\/\#.*?&gt\; .*$/) {
				# Split $nick, $channel and $line
				$nick = $line;
				$nick =~ s/^&lt\;([^\/]*?)\/\#.*?&gt\; .*$/$1/;
				$channel = $line;
				$channel =~ s/^&lt\;[^\/]*?\/\#(.*?)&gt\; .*$/$1/;

				# $nick =~ tr/[A-Z]/[a-z]/;
				# <======= move this into another function when getting nick colour

				$text = $line;
				$text =~ s/^&lt\;.*?&gt\; (.*)$/$1/;
				$text =~ s/  /&nbsp\;&nbsp\;/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 =~ /^&gt\;&gt\;&gt\; /) {
				$line =~ s/^&gt\;&gt\;&gt\; /\*\*\* /;
					
				# 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;
}

if (!scalar @ARGV) {
		print "Usage: irclog2html.pl <date> < logfile\n";
    print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n";
    exit 0;
}
my $date = shift;
exit &main($date);
# vim: ts=2
