scripts/irclog2html.pl

   1 #!/usr/bin/perl -w
   2
   3 # irclog2html.pl Version 1.5 - 11th May 2000
   4 # Copyright (C) 2000, Jeffrey W. Waugh
   5
   6 # Author:
   7 #   Jeff Waugh <jdub@aphid.net>
   8
   9 # Contributors:
  10 #   Rick Welykochy <rick@praxis.com.au>
  11 #   Alexander Else <aelse@uu.net>
  12
  13 # Released under the terms of the GNU GPL
  14 # http://www.gnu.org/copyleft/gpl.html
  15
  16 # Modified by Tim Riker <Tim@Rikers.org>
  17 # to work with infobot logs
  18 # then modified again for blootbot
  19
  20 # Usage: irclog2html <date> < logfile
  21
  22 # irclog2html will write out a colourised irc log, appending a .html
  23 # extension to the output file.
  24
  25
  26 ####################################################################################
  27 # Perl Configuration
  28
  29 use strict;
  30 $^W = 1;        #RW# turn on warnings
  31 use POSIX qw(strftime);
  32
  33
  34 ####################################################################################
  35 # Preferences
  36
  37 # Comment out the "table" assignment to use the plain version
  38
  39 #my $STYLE              =       "tt";
  40 #my $STYLE              =       "simplett";
  41 #my $STYLE              =       "table";
  42 my $STYLE               =       "simpletable";
  43
  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)
  49
  50 my %prefs_colour_nick = (
  51         "jdub"          =>      "#993333",
  52         "cantanker"     =>      "#006600",
  53         "chuckd"        =>      "#339999",
  54 );
  55
  56
  57 ####################################################################################
  58 # Utility Functions
  59
  60 sub header {
  61         my ($channel, $date) = @_;
  62         my $return = '';
  63
  64         $return .= qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
  65 <html>
  66 <head>
  67         <title>irclog2html for $channel on $date</title>
  68         <meta name="generator" content="irclog2html.pl by Jeff Waugh">
  69         <meta name="version" content="Version 1.5 - 11th May 2000">
  70         <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  71 </head>
  72 <body text="#000000" bgcolor="#ffffff">
  73 <h1>irclog2html for $channel on $date</h1>
  74 };
  75
  76         if ($STYLE =~ /table/) {
  77                 $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
  78         }
  79         return $return;
  80 }
  81
  82 sub footer {
  83         my $return = '';
  84         if ($STYLE =~ /table/) {
  85                 $return .= "</table>\n";
  86         }
  87
  88         $return .= qq{
  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.
  94 </body></html>
  95 };
  96         return $return;
  97 }
  98
  99 my $lastdate = '';
 100
 101 sub add_footers {
 102         my $filename;
 103
 104         return if not $lastdate;
 105
 106         my @files=`ls $lastdate.html */$lastdate.html`;
 107         foreach $filename (@files) {
 108                 chomp $filename;
 109                 if (!open(OUTPUT, ">>$filename")) {
 110                         die "Cannot open $filename for writing!\n\n";
 111                 }
 112                 print OUTPUT footer();
 113                 close OUTPUT;
 114         }
 115 }
 116
 117 sub output_line {
 118         my ($date, $time, $channel, $lineout) = @_;
 119
 120         add_footers() if $lastdate ne $date;
 121
 122         $lastdate = $date;
 123         my $filename = "";
 124         $filename .= "$channel/" if $channel;
 125         $filename .= "$date.html";
 126
 127         mkdir($channel,oct('755')) if ($channel && ! -d $channel);
 128         if (!open(OUTPUT, ">>$filename")) {
 129                 die "Cannot open $filename for writing!\n\n";
 130         }
 131         # Begin output #
 132   print OUTPUT header($channel, $date) if -z $filename;
 133
 134         print OUTPUT $lineout;
 135
 136         close OUTPUT;
 137 }
 138
 139 sub output_timenicktext {
 140         my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_;
 141         my $lineout = '';
 142
 143         if ($STYLE eq "table") {
 144                 $lineout .= "<tr>";
 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";
 148         }
 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";
 154         }
 155         elsif ($STYLE eq "simplett") {
 156                 $lineout .= "$time " if $time;
 157                 $lineout .= "&lt\;$nick&gt\; $text<br>\n";
 158         }
 159         else {
 160                 $lineout .= "$time " if $time;
 161                 $lineout .= "<font color=\"$htmlcolour\">&lt\;$nick&gt\; $text<\/font><br>\n";
 162         }
 163         output_line($date, $time, $channel, $lineout);
 164 }
 165
 166 sub output_timeservermsg {
 167         my ($date, $time, $channel, $line) = @_;
 168         my $lineout = '';
 169
 170         if ($STYLE =~ /table/) {
 171                 $lineout .= "<tr>";
 172                 $lineout .= "<td><tt>$time</tt></td>" if $time;
 173                 $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
 174         }
 175         else {
 176                 $lineout .= "$time " if $time;
 177                 $lineout .= "$line<br>\n";
 178         }
 179         output_line($date, $time, $channel, $lineout);
 180 }
 181
 182 sub html_rgb
 183 {
 184         my ($i,$ncolours) = @_;
 185         $ncolours = 1 if $ncolours == 0;
 186
 187         my $rgbmax = 125;               # tune these two for the outmost ranges of colour depth
 188         my $rgbmin = 240;
 189
 190         my $a = 0.95;                   # tune these for the starting and ending concentrations of R,G,B
 191         my $c = 0.5;
 192
 193         my $rgb = [ [$a,$c,$c], [$c,$a,$c], [$c,$c,$a], [$a,$a,$c], [$a,$c,$a], [$c,$a,$a] ];
 194         my $n = $i % @$rgb;
 195         my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
 196
 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);
 201 }
 202
 203 ####################################################################################
 204 # Main
 205
 206 sub main {
 207         my ($date) = @_;
 208         my $files;
 209
 210         my $line;
 211   my $time;
 212   my $lastdate = "";
 213         my $nick;
 214         my $channel;
 215         my $text;
 216
 217         my $htmlcolour;
 218         my $nickcount = 0;
 219         my $NICKMAX = 30;
 220
 221         my %colour_nick = %prefs_colour_nick;
 222
 223         while ($line = <STDIN>) {
 224
 225                 chomp $line;
 226
 227                 if (!$line eq "") {
 228                         # parse out the time
 229                         if ($line =~ s/^([0-9:\.]*) (.*)$/$2/) {
 230                                 $time = $1;
 231                         } else {
 232                                 $time = '';
 233                         }
 234                         $channel = '';
 235
 236                         # Replace ampersands, pointies, control characters #
 237                         $line =~ s/&/&amp\;/g;
 238                         $line =~ s/</&lt\;/g;
 239                         $line =~ s/>/&gt\;/g;
 240                         $line =~ s/\e\[[0-1]*m//g;
 241                         $line =~ s/[\x00-\x1f]+//g;
 242
 243                         # Replace possible URLs with links #
 244                         $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
 245
 246                         # Colourise the comments
 247                         if ($line =~ /^&lt\;[^\/]*?\/\#.*?&gt\; .*$/) {
 248                                 # Split $nick, $channel and $line
 249                                 $nick = $line;
 250                                 $nick =~ s/^&lt\;([^\/]*?)\/\#.*?&gt\; .*$/$1/;
 251                                 $channel = $line;
 252                                 $channel =~ s/^&lt\;[^\/]*?\/(\#.*?)&gt\; .*$/$1/;
 253
 254                                 # $nick =~ tr/[A-Z]/[a-z]/;
 255                                 # <======= move this into another function when getting nick colour
 256
 257                                 $text = $line;
 258                                 $text =~ s/^&lt\;.*?&gt\; (.*)$/$1/;
 259                                 $text =~ s/^ .*/&lt\;PROTECTED&gt\;/g;
 260                                 $text =~ s/  /&nbsp\;&nbsp\;/g;
 261
 262                                 $htmlcolour = $colour_nick{$nick};
 263                                 if (!defined($htmlcolour)) {
 264                                         # new nick
 265                                         $nickcount++;
 266
 267                                         # if we've exceeded our estimate of the number of nicks, double it
 268                                         $NICKMAX *= 2 if $nickcount >= $NICKMAX;
 269
 270                                         $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
 271                                 }
 272                                 output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour);
 273                         } elsif ($line =~ /^&gt\;&gt\;&gt\; /) {
 274                                 $line =~ s/^&gt\;&gt\;&gt\; /\*\*\* /;
 275
 276                                 # Process changed nick results, and remember colours accordingly #
 277                                 if ($line =~ /\*\*\* (.*?) materializes into (.*)/) {
 278                                         my $nick_old = $1;
 279                                         my $nick_new = $2;
 280
 281                                         #$nick_old = $line;
 282                                         #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
 283                                         #$nick_new = $line;
 284                                         #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
 285
 286                                         $colour_nick{$nick_new} = $colour_nick{$nick_old};
 287                                         $colour_nick{$nick_old} = undef;
 288
 289                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/
 290                                 } elsif ($line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/) {
 291                                         $channel = lc $2;
 292                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
 293                                 } elsif ($line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/) {
 294                                         $channel = lc $2;
 295                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
 296                                 } elsif ($line =~ /\*\*\* .* has signed off IRC .*/) {
 297                                         # Colourise joined/left/server messages #
 298                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
 299                                 } elsif ($line =~ /\*\*\* /) {
 300                                         $line =~ s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
 301                                 } elsif ($line =~ /^\* .*$/) {
 302                                   # Colourise the /me's #
 303                                         $line =~ s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
 304                                 }
 305
 306                                 output_timeservermsg($date, $time, $channel, $line);
 307                         }
 308                 }
 309         }
 310
 311         add_footers();
 312
 313         return 0;
 314 }
 315
 316 if (!scalar @ARGV) {
 317                 print "Usage: irclog2html.pl <date> < logfile\n";
 318     print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n";
 319     exit 0;
 320 }
 321 my $date = shift;
 322 exit &main($date);
 323 # vim: ts=2