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