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 infobot
  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 # Perl Configuration
  27
  28 use strict;
  29 $^W = 1;    #RW# turn on warnings
  30 use POSIX qw(strftime);
  31
  32 ####################################################################################
  33 # Preferences
  34
  35 # Comment out the "table" assignment to use the plain version
  36
  37 #my $STYLE = "tt";
  38 #my $STYLE = "simplett";
  39 #my $STYLE = "table";
  40 my $STYLE = "simpletable";
  41
  42 my $colour_left       = "#000099";    # nick leaving channel
  43 my $colour_joined     = "#009900";    # nick joining channel
  44 my $colour_server     = "#009900";    # server message (***)
  45 my $colour_nickchange = "#009900";    # nick change
  46 my $colour_action     = "#CC00CC";    # nick action (/me waves)
  47
  48 my %prefs_colour_nick = (
  49     "jdub"      => "#993333",
  50     "cantanker" => "#006600",
  51     "chuckd"    => "#339999",
  52 );
  53
  54 ####################################################################################
  55 # Utility Functions
  56
  57 sub header {
  58     my ( $channel, $date ) = @_;
  59     my $return = '';
  60
  61     $return .=
  62       qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
  63 <html>
  64 <head>
  65  <title>irclog2html for $channel on $date</title>
  66  <meta name="generator" content="irclog2html.pl by Jeff Waugh">
  67  <meta name="version" content="Version 1.5 - 11th May 2000">
  68  <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
  69 </head>
  70 <body text="#000000" bgcolor="#ffffff">
  71 <h1>irclog2html for $channel on $date</h1>
  72 };
  73
  74     if ( $STYLE =~ /table/ ) {
  75         $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
  76     }
  77     return $return;
  78 }
  79
  80 sub footer {
  81     my $return = '';
  82     if ( $STYLE =~ /table/ ) {
  83         $return .= "</table>\n";
  84     }
  85
  86     $return .= qq{
  87 <br>Generated by irclog2html.pl by
  88 <a href="mailto:jdub\@NOSPAMaphid.net">Jeff Waugh</a> - find it at
  89 <a href="http://freshmeat.net/appindex/2000/03/28/954251322.html">freshmeat.net</a>!
  90 Modified by <a href="http://www.Rikers.org">Tim Riker</a> to work with
  91 <a href="http://infobot.sourceforge.net/">infobot</a> logs, split per channel, etc.
  92 </body></html>
  93 };
  94     return $return;
  95 }
  96
  97 my $lastdate = '';
  98
  99 sub add_footers {
 100     my $filename;
 101
 102     return if not $lastdate;
 103
 104     my @files = `ls $lastdate.html */$lastdate.html`;
 105     foreach $filename (@files) {
 106         chomp $filename;
 107         if ( !open( OUTPUT, ">>$filename" ) ) {
 108             print "Cannot open $filename for writing!\n\n";
 109             return;
 110         }
 111         print OUTPUT footer();
 112         close OUTPUT;
 113     }
 114 }
 115
 116 sub output_line {
 117     my ( $date, $time, $channel, $lineout ) = @_;
 118
 119     add_footers() if $lastdate ne $date;
 120
 121     $lastdate = $date;
 122     my $filename = "";
 123     $filename .= "$channel/" if $channel;
 124     $filename .= "$date.html";
 125
 126     mkdir( $channel, oct('755') ) if ( $channel && !-d $channel );
 127     if ( !open( OUTPUT, ">>$filename" ) ) {
 128
 129         #print "Cannot open $filename for writing!\n\n";
 130         return;
 131     }
 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 .=
 148 "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>"
 149           if $time;
 150         $lineout .=
 151 "<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
 152         $lineout .=
 153 "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
 154     }
 155     elsif ( $STYLE eq "simpletable" ) {
 156         $lineout .= "<tr bgcolor=\"#eeeeee\">";
 157         $lineout .= "<td><tt>$time</tt></td>" if $time;
 158         $lineout .=
 159           "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
 160         $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
 161     }
 162     elsif ( $STYLE eq "simplett" ) {
 163         $lineout .= "$time " if $time;
 164         $lineout .= "&lt\;$nick&gt\; $text<br>\n";
 165     }
 166     else {
 167         $lineout .= "$time " if $time;
 168         $lineout .=
 169           "<font color=\"$htmlcolour\">&lt\;$nick&gt\; $text<\/font><br>\n";
 170     }
 171     output_line( $date, $time, $channel, $lineout );
 172 }
 173
 174 sub output_timeservermsg {
 175     my ( $date, $time, $channel, $line ) = @_;
 176     my $lineout = '';
 177
 178     if ( $STYLE =~ /table/ ) {
 179         $lineout .= "<tr>";
 180         $lineout .= "<td><tt>$time</tt></td>" if $time;
 181         $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
 182     }
 183     else {
 184         $lineout .= "$time " if $time;
 185         $lineout .= "$line<br>\n";
 186     }
 187     output_line( $date, $time, $channel, $lineout );
 188 }
 189
 190 sub html_rgb {
 191     my ( $i, $ncolours ) = @_;
 192     $ncolours = 1 if $ncolours == 0;
 193
 194     my $rgbmax = 125;    # tune these two for the outmost ranges of colour depth
 195     my $rgbmin = 240;
 196
 197     my $a =
 198       0.95;    # tune these for the starting and ending concentrations of R,G,B
 199     my $c = 0.5;
 200
 201     my $rgb = [
 202         [ $a, $c, $c ],
 203         [ $c, $a, $c ],
 204         [ $c, $c, $a ],
 205         [ $a, $a, $c ],
 206         [ $a, $c, $a ],
 207         [ $c, $a, $a ]
 208     ];
 209     my $n = $i % @$rgb;
 210     my $m = $rgbmin + ( $rgbmax - $rgbmin ) * ( $ncolours - $i ) / $ncolours;
 211
 212     my $r = $rgb->[$n][0] * $m;
 213     my $g = $rgb->[$n][1] * $m;
 214     my $b = $rgb->[$n][2] * $m;
 215     sprintf( "#%02x%02x%02x", $r, $g, $b );
 216 }
 217
 218 ####################################################################################
 219 # Main
 220
 221 sub main {
 222     my ($date) = @_;
 223     my $files;
 224
 225     my $line;
 226     my $time;
 227     my $lastdate = "";
 228     my $nick;
 229     my $channel;
 230     my $text;
 231
 232     my $htmlcolour;
 233     my $nickcount = 0;
 234     my $NICKMAX   = 30;
 235
 236     my %colour_nick = %prefs_colour_nick;
 237
 238     while ( $line = <STDIN> ) {
 239
 240         chomp $line;
 241
 242         if ( !$line eq "" ) {
 243
 244             # parse out the time
 245             if ( $line =~ s/^([0-9:\.]*) (.*)$/$2/ ) {
 246                 $time = $1;
 247             }
 248             else {
 249                 $time = '';
 250             }
 251             $channel = '';
 252
 253             # Replace ampersands, pointies, control characters #
 254             $line =~ s/&/&amp\;/g;
 255             $line =~ s/</&lt\;/g;
 256             $line =~ s/>/&gt\;/g;
 257             $line =~ s/\e\[[0-1]*m//g;
 258             $line =~ s/[\x00-\x1f]+//g;
 259
 260             # Replace possible URLs with links #
 261             $line =~
 262               s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
 263
 264             # Colourise the comments
 265             if ( $line =~ /^&lt\;[^\/]*?\/\#.*?&gt\; .*$/ ) {
 266
 267                 # Split $nick, $channel and $line
 268                 $nick = $line;
 269                 $nick =~ s/^&lt\;([^\/]*?)\/\#.*?&gt\; .*$/$1/;
 270                 $channel = $line;
 271                 $channel =~ s/^&lt\;[^\/]*?\/(\#.*?)&gt\; .*$/$1/;
 272
 273              # $nick =~ tr/[A-Z]/[a-z]/;
 274              # <======= move this into another function when getting nick colour
 275
 276                 $text = $line;
 277                 $text =~ s/^&lt\;.*?&gt\; (.*)$/$1/;
 278                 $text =~ s/^ .*/&lt\;PROTECTED&gt\;/g;
 279                 $text =~ s/  /&nbsp\;&nbsp\;/g;
 280
 281                 $htmlcolour = $colour_nick{$nick};
 282                 if ( !defined($htmlcolour) ) {
 283
 284                     # new nick
 285                     $nickcount++;
 286
 287                     # if we've exceeded our estimate of the number of nicks, double it
 288                     $NICKMAX *= 2 if $nickcount >= $NICKMAX;
 289
 290                     $htmlcolour = $colour_nick{$nick} =
 291                       html_rgb( $nickcount, $NICKMAX );
 292                 }
 293                 output_timenicktext( $date, $time, $channel, $nick, $text, $htmlcolour );
 294             }
 295             elsif ( $line =~ /^\* ([^ \/]+)\/(\#[^ ]+) (.+)/ ) {
 296                 # Colourise the /me's #
 297                 $nick=$1;
 298                 $channel=$2;
 299                 $text="<font color=\"$colour_action\">$3</font>";
 300                 $htmlcolour = $colour_nick{$nick};
 301                 if ( !defined($htmlcolour) ) {
 302
 303                     # new nick
 304                     $nickcount++;
 305
 306                     # if we've exceeded our estimate of the number of nicks, double it
 307                     $NICKMAX *= 2 if $nickcount >= $NICKMAX;
 308
 309                     $htmlcolour = $colour_nick{$nick} =
 310                       html_rgb( $nickcount, $NICKMAX );
 311                 }
 312                 output_timenicktext( $date, $time, $channel, $nick, $text, $htmlcolour );
 313             }
 314             elsif ( $line =~ /^&gt\;&gt\;&gt\; / ) {
 315                 $line =~ s/^&gt\;&gt\;&gt\; /\*\*\* /;
 316
 317               # Process changed nick results, and remember colours accordingly #
 318                 if ( $line =~ /\*\*\* (.*?) materializes into (.*)/ ) {
 319                     my $nick_old = $1;
 320                     my $nick_new = $2;
 321
 322                     #$nick_old = $line;
 323                     #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
 324                     #$nick_new = $line;
 325                     #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
 326
 327                     $colour_nick{$nick_new} = $colour_nick{$nick_old};
 328                     $colour_nick{$nick_old} = undef;
 329
 330                     $line =~ s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/;
 331                 }
 332                 elsif ( $line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/ ) {
 333                     $channel = lc $2;
 334                     $line =~
 335                       s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
 336                 }
 337                 elsif ( $line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/ ) {
 338                     $channel = lc $2;
 339                     $line =~
 340                       s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
 341                 }
 342                 elsif ( $line =~ /\*\*\* .* has signed off IRC .*/ ) {
 343
 344                     # Colourise joined/left/server messages #
 345                     $line =~
 346                       s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
 347                 }
 348                 elsif ( $line =~ /\*\*\* / ) {
 349                     $line =~
 350                       s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
 351                 }
 352                 elsif ( $line =~ /^\* .*$/ ) {
 353
 354                     # Colourise the /me's #
 355                     $line =~
 356                       s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
 357                 }
 358
 359                 output_timeservermsg( $date, $time, $channel, $line );
 360             }
 361         }
 362     }
 363
 364     add_footers();
 365
 366     return 0;
 367 }
 368
 369 if ( !scalar @ARGV ) {
 370     print "Usage: irclog2html.pl <date> < logfile\n";
 371     print
 372       "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n";
 373     exit 0;
 374 }
 375 my $date = shift;
 376 exit &main($date);
 377
 378 # vim:ts=4:sw=4:expandtab:tw=80