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                         print "Cannot open $filename for writing!\n\n";
 111                         return;
 112                 }
 113                 print OUTPUT footer();
 114                 close OUTPUT;
 115         }
 116 }
 117
 118 sub output_line {
 119         my ($date, $time, $channel, $lineout) = @_;
 120
 121         add_footers() if $lastdate ne $date;
 122
 123         $lastdate = $date;
 124         my $filename = "";
 125         $filename .= "$channel/" if $channel;
 126         $filename .= "$date.html";
 127
 128         mkdir($channel,oct('755')) if ($channel && ! -d $channel);
 129         if (!open(OUTPUT, ">>$filename")) {
 130                 #print "Cannot open $filename for writing!\n\n";
 131                 return;
 132         }
 133         # Begin output #
 134   print OUTPUT header($channel, $date) if -z $filename;
 135
 136         print OUTPUT $lineout;
 137
 138         close OUTPUT;
 139 }
 140
 141 sub output_timenicktext {
 142         my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_;
 143         my $lineout = '';
 144
 145         if ($STYLE eq "table") {
 146                 $lineout .= "<tr>";
 147                 $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>" if $time;
 148                 $lineout .= "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
 149                 $lineout .= "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
 150         }
 151         elsif ($STYLE eq "simpletable") {
 152                 $lineout .= "<tr bgcolor=\"#eeeeee\">";
 153                 $lineout .= "<td><tt>$time</tt></td>" if $time;
 154                 $lineout .= "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
 155                 $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
 156         }
 157         elsif ($STYLE eq "simplett") {
 158                 $lineout .= "$time " if $time;
 159                 $lineout .= "&lt\;$nick&gt\; $text<br>\n";
 160         }
 161         else {
 162                 $lineout .= "$time " if $time;
 163                 $lineout .= "<font color=\"$htmlcolour\">&lt\;$nick&gt\; $text<\/font><br>\n";
 164         }
 165         output_line($date, $time, $channel, $lineout);
 166 }
 167
 168 sub output_timeservermsg {
 169         my ($date, $time, $channel, $line) = @_;
 170         my $lineout = '';
 171
 172         if ($STYLE =~ /table/) {
 173                 $lineout .= "<tr>";
 174                 $lineout .= "<td><tt>$time</tt></td>" if $time;
 175                 $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
 176         }
 177         else {
 178                 $lineout .= "$time " if $time;
 179                 $lineout .= "$line<br>\n";
 180         }
 181         output_line($date, $time, $channel, $lineout);
 182 }
 183
 184 sub html_rgb
 185 {
 186         my ($i,$ncolours) = @_;
 187         $ncolours = 1 if $ncolours == 0;
 188
 189         my $rgbmax = 125;               # tune these two for the outmost ranges of colour depth
 190         my $rgbmin = 240;
 191
 192         my $a = 0.95;                   # tune these for the starting and ending concentrations of R,G,B
 193         my $c = 0.5;
 194
 195         my $rgb = [ [$a,$c,$c], [$c,$a,$c], [$c,$c,$a], [$a,$a,$c], [$a,$c,$a], [$c,$a,$a] ];
 196         my $n = $i % @$rgb;
 197         my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
 198
 199         my $r = $rgb->[$n][0] * $m;
 200         my $g = $rgb->[$n][1] * $m;
 201         my $b = $rgb->[$n][2] * $m;
 202         sprintf("#%02x%02x%02x",$r,$g,$b);
 203 }
 204
 205 ####################################################################################
 206 # Main
 207
 208 sub main {
 209         my ($date) = @_;
 210         my $files;
 211
 212         my $line;
 213   my $time;
 214   my $lastdate = "";
 215         my $nick;
 216         my $channel;
 217         my $text;
 218
 219         my $htmlcolour;
 220         my $nickcount = 0;
 221         my $NICKMAX = 30;
 222
 223         my %colour_nick = %prefs_colour_nick;
 224
 225         while ($line = <STDIN>) {
 226
 227                 chomp $line;
 228
 229                 if (!$line eq "") {
 230                         # parse out the time
 231                         if ($line =~ s/^([0-9:\.]*) (.*)$/$2/) {
 232                                 $time = $1;
 233                         } else {
 234                                 $time = '';
 235                         }
 236                         $channel = '';
 237
 238                         # Replace ampersands, pointies, control characters #
 239                         $line =~ s/&/&amp\;/g;
 240                         $line =~ s/</&lt\;/g;
 241                         $line =~ s/>/&gt\;/g;
 242                         $line =~ s/\e\[[0-1]*m//g;
 243                         $line =~ s/[\x00-\x1f]+//g;
 244
 245                         # Replace possible URLs with links #
 246                         $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
 247
 248                         # Colourise the comments
 249                         if ($line =~ /^&lt\;[^\/]*?\/\#.*?&gt\; .*$/) {
 250                                 # Split $nick, $channel and $line
 251                                 $nick = $line;
 252                                 $nick =~ s/^&lt\;([^\/]*?)\/\#.*?&gt\; .*$/$1/;
 253                                 $channel = $line;
 254                                 $channel =~ s/^&lt\;[^\/]*?\/(\#.*?)&gt\; .*$/$1/;
 255
 256                                 # $nick =~ tr/[A-Z]/[a-z]/;
 257                                 # <======= move this into another function when getting nick colour
 258
 259                                 $text = $line;
 260                                 $text =~ s/^&lt\;.*?&gt\; (.*)$/$1/;
 261                                 $text =~ s/^ .*/&lt\;PROTECTED&gt\;/g;
 262                                 $text =~ s/  /&nbsp\;&nbsp\;/g;
 263
 264                                 $htmlcolour = $colour_nick{$nick};
 265                                 if (!defined($htmlcolour)) {
 266                                         # new nick
 267                                         $nickcount++;
 268
 269                                         # if we've exceeded our estimate of the number of nicks, double it
 270                                         $NICKMAX *= 2 if $nickcount >= $NICKMAX;
 271
 272                                         $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
 273                                 }
 274                                 output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour);
 275                         } elsif ($line =~ /^&gt\;&gt\;&gt\; /) {
 276                                 $line =~ s/^&gt\;&gt\;&gt\; /\*\*\* /;
 277
 278                                 # Process changed nick results, and remember colours accordingly #
 279                                 if ($line =~ /\*\*\* (.*?) materializes into (.*)/) {
 280                                         my $nick_old = $1;
 281                                         my $nick_new = $2;
 282
 283                                         #$nick_old = $line;
 284                                         #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
 285                                         #$nick_new = $line;
 286                                         #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
 287
 288                                         $colour_nick{$nick_new} = $colour_nick{$nick_old};
 289                                         $colour_nick{$nick_old} = undef;
 290
 291                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/
 292                                 } elsif ($line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/) {
 293                                         $channel = lc $2;
 294                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
 295                                 } elsif ($line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/) {
 296                                         $channel = lc $2;
 297                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
 298                                 } elsif ($line =~ /\*\*\* .* has signed off IRC .*/) {
 299                                         # Colourise joined/left/server messages #
 300                                         $line =~ s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
 301                                 } elsif ($line =~ /\*\*\* /) {
 302                                         $line =~ s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
 303                                 } elsif ($line =~ /^\* .*$/) {
 304                                   # Colourise the /me's #
 305                                         $line =~ s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
 306                                 }
 307
 308                                 output_timeservermsg($date, $time, $channel, $line);
 309                         }
 310                 }
 311         }
 312
 313         add_footers();
 314
 315         return 0;
 316 }
 317
 318 if (!scalar @ARGV) {
 319                 print "Usage: irclog2html.pl <date> < logfile\n";
 320     print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n";
 321     exit 0;
 322 }
 323 my $date = shift;
 324 exit &main($date);
 325 # vim: ts=2