#!/usr/bin/perl
use strict;
my $filere = '^[A-Za-z_\-\d]+$';
my $pathfront = '/home/bnaylor/html/irclogs/';
my $pathend = '.txt';
my %nickcolors = ();
my %styles = (
time => 'font:monospace,sans-serif;font-size:12px;color:#333388;',
nick => 'font:monospace,sans-serif;font-size:14px;color:COLOR;',
text => 'font:monospace,sans-serif;font-size:14px;',
);
sub setcolor
{
my $nick = shift;
$nickcolors{$nick} = sprintf("#%.2x%.2x%.2x", rand(220), rand(220), rand(220));
}
sub balanced_tags($$$)
{
my($str,$ctrl,$tag) = @_;
# count tags
my $treval = "\$str =~ tr/$ctrl/$ctrl/";
my $count = eval($treval);
# alternate open/close for each ctrl char found
for(my $i=0; $i<$count; $i++)
{
my $curtag;
if($i%2 == 0)
{
$curtag = "<$tag>";
}
else
{
$curtag = "";
}
$str =~ s/${ctrl}/${curtag}/e;
}
# were they balanced?
if($count%2 != 0)
{
$str .= "";
}
return $str;
}
sub ctrls_to_tags($str)
{
my $str = shift;
$str = &balanced_tags($str, '', 'b');
$str = &balanced_tags($str, ' ', 'u');
$str = &balanced_tags($str, '', 'i');
return $str;
}
sub nickstyle($)
{
my $color = shift;
my $ret = $styles{nick};
## sanity check - do not allow dodginess inside of our regex
if($ret !~ /^[ \d\w\:\,\-;#]+$/)
{
print "You've entered what appears to be a dodgy CSS string. ",
"Sorry, but I have to be kind of a stickler about this one.
";
exit;
}
$ret =~ s/COLOR/$color/e;
return $ret;
}
###
### main
###
srand( time() ^ ($$ + ($$<<15)) );
#my $date = '2003.02.26';
my $file = $ENV{QUERY_STRING};
$file =~ s/^file=//; # check this later
print "Content-type: text/html\n\n";
print "IRC log '$file'\n";
print<
body {
color: #eeccc;
margin: 2em;
}
h2 { font: "Gill Sans", sans-serif; color: #555599; }
EOF
print "\n";
print "\n";
print "\n";
print "
IRC log '$file'
\n\n";
print "\n";
# make sure there's no shit.
if($file !~ /^${filere}$/)
{
print "Fuck off.\n";
exit;
}
my $ts = '';
if(open(IN, "$pathfront$file$pathend") == 0)
{
print "Couldn't open irc log '$file'.\n";
print "\n";
exit;
}
while()
{
my $logstr = ''; # hack..
# outbound privmsg
if(/^(\d\d:\d\d)?.*?<\*([^>]+)>([^>]+)\*> (.+)$/)
{
$logstr .= "$1 ";
if($nickcolors{$2} eq '')
{
&setcolor($2);
}
$logstr .= "<*$2>";
if($nickcolors{$3} eq '')
{
&setcolor($3);
}
$logstr .= "$3*> ";
my $line = $4;
# strip html
$line =~ s/&/&/;
$line =~ s//>/g;
$line = &ctrls_to_tags($line);
$logstr .= "$line
\n";
}
# inbound privmsg
elsif(/^(\d\d:\d\d)?.*?<\*([^>]+)\*> (.+)$/)
{
$logstr .= "$1 ";
if($nickcolors{$2} eq '')
{
&setcolor($2);
}
$logstr .= "<*$2*> ";
my $line = $3;
# strip html
$line =~ s/&/&/;
$line =~ s//>/g;
$line = &ctrls_to_tags($line);
$logstr .= "$line
\n";
}
# normal public
elsif(/^(.*\d\d:\d\d)?.*?<([^>]+)> (.+)$/)
{
$logstr .= "$1 ";
if($nickcolors{$2} eq '')
{
&setcolor($2);
}
$logstr .= "<$2> ";
my $line = $3;
# strip html
$line =~ s/&/&/;
$line =~ s//>/g;
$line = &ctrls_to_tags($line);
$logstr .= "$line
\n";
}
# action
elsif(/^(\d\d:\d\d)\* ([\w\|\-\^\[\]\`]+) (.+)$/)
{
$logstr .= "$1 ";
if($nickcolors{$2} eq '')
{
&setcolor($2);
}
$logstr .= "* $2 ";
my $line = $3;
# strip html
$line =~ s/&/&/;
$line =~ s//>/g;
$line = &ctrls_to_tags($line);
$logstr .= "$line
\n";
}
# my user listings
elsif(/^(\d\d:\d\d)\+--/)
{
$logstr .= "
-----------------------------------------------------------------
\n";
}
elsif(/^(\d\d:\d\d)\| (.*)$/)
{
my $line = $2;
# strip html
$line =~ s/&/&/;
$line =~ s//>/g;
$line = &ctrls_to_tags($line);
$logstr .= "$line
\n";
}
elsif(/^\d\d:\d\dOpening/)
{
}
elsif(/^\d\d:\d\d\*{3} (\w+ is talking about you on|REFNUM|No such window)/)
{
}
elsif(/^(\d\d:\d\d)\*{3} (.+)$/)
{
$logstr .= "$1 ";
my $line = $2;
# strip html
$line =~ s/&/&/;
$line =~ s//>/g;
$logstr .= "*** $line
\n";
}
# continued lines
elsif(/^ /)
{
my $line = &ctrls_to_tags($_);
$logstr .= " $line
\n";
}
# irc server crap, etc.
else
{
$logstr .= "$_
\n";
}
print $logstr;
}
print "