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