usr_bin/irclog2html-2.1.pl

   1 #!/usr/bin/perl
   2
   3 # irclog2html.pl Version 2.1 - 27th July, 2001
   4 # Copyright (C) 2000, Jeffrey W. Waugh
   5
   6 # Author:
   7 #   Jeff Waugh <jdub@perkypants.org>
   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 # Usage: irclog2html filename
  17
  18 # irclog2html will write out a colourised irc log, appending a .html
  19 # extension to the output file.
  20
  21
  22 ####################################################################################
  23 # Perl Configuration
  24
  25 use strict;
  26 #$^W = 1;       #RW# turn on warnings
  27
  28 my $VERSION = "2.1";
  29 my $RELEASE = "27th July, 2001";
  30
  31
  32 # Colouring stuff
  33 my $a = 0.95;                   # tune these for the starting and ending concentrations of R,G,B
  34 my $b = 0.5;
  35 my $rgb = [ [$a,$b,$b], [$b,$a,$b], [$b,$b,$a], [$a,$a,$b], [$a,$b,$a], [$b,$a,$a] ];
  36
  37 my $rgbmax = 125;               # tune these two for the outmost ranges of colour depth
  38 my $rgbmin = 240;
  39
  40
  41 ####################################################################################
  42 # Preferences
  43
  44 # Comment out the "table" assignment to use the plain version
  45
  46 my %prefs_colours = (
  47         "part"                  =>      "#000099",
  48         "join"                  =>      "#009900",
  49         "server"                =>      "#009900",
  50         "nickchange"    =>      "#009900",
  51         "action"                =>      "#CC00CC",
  52 );
  53
  54 my %prefs_colour_nick = (
  55         "jdub"                  =>      "#993333",
  56         "cantanker"             =>      "#006600",
  57         "chuckd"                =>      "#339999",
  58 );
  59
  60 my %prefs_styles = (
  61         "simplett"              =>      "Text style with little use of colour",
  62         "tt"                    =>      "Text style using colours for each nick",
  63         "simpletable"   =>      "Table style, without heavy use of colour",
  64         "table"                 =>      "Default style, using a table with bold colours",
  65 );
  66
  67 my $STYLE = "table";
  68
  69
  70 ####################################################################################
  71 # Utility Functions & Variables
  72
  73 sub output_nicktext {
  74         my ($nick, $text, $htmlcolour) = @_;
  75
  76         if ($STYLE eq "table") {
  77                 print OUTPUT "<tr><th bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></th>";
  78                 print OUTPUT "<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
  79         } elsif ($STYLE eq "simpletable") {
  80                 print OUTPUT "<tr bgcolor=\"#eeeeee\"><th><font color=\"$htmlcolour\"><tt>$nick</tt></font></th>";
  81                 print OUTPUT "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
  82         } elsif ($STYLE eq "simplett") {
  83                 print OUTPUT "&lt\;$nick&gt\; $text<br>\n";
  84         } else {
  85                 print OUTPUT "<font color=\"$htmlcolour\">&lt\;$nick&gt\;<\/font> <font color=\"#000000\">$text<\/font><br>\n";
  86         }
  87 }
  88
  89 sub output_servermsg {
  90         my ($line) = @_;
  91
  92         if ($STYLE =~ /table/) {
  93                 print OUTPUT "<tr><td colspan=2><tt>$line</tt></td></tr>\n";
  94         } else {
  95                 print OUTPUT "$line<br>\n";
  96         }
  97 }
  98
  99 sub html_rgb
 100 {
 101         my ($i,$ncolours) = @_;
 102         $ncolours = 1 if $ncolours == 0;
 103
 104         my $n = $i % @$rgb;
 105         my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
 106
 107         my $r = $rgb->[$n][0] * $m;
 108         my $g = $rgb->[$n][1] * $m;
 109         my $b = $rgb->[$n][2] * $m;
 110         sprintf("#%02x%02x%02x",$r,$g,$b);
 111 }
 112
 113 my $msg_usage = "Usage: irclog2html.pl [OPTION]... [FILE]
 114 Colourises and converts IRC logs to HTML format for easy web reading.
 115
 116   -s, --style=[STYLE]     format log according to specific style. style formats
 117                           described using irclog2html [-s|--style]
 118
 119   --colour-<attribute>=[COLOUR]     format output colour scheme. attributes
 120                                     described using irclog2html [--colour]
 121
 122 Report bugs to Jeff Waugh <jdub\@perkypants.org>.
 123 ";
 124
 125 my $msg_styles = "The following styles are available for use with irclog2html.pl:
 126
 127   simplett
 128     Text style with little use of colour
 129
 130   tt
 131     Text style using colours for each nick
 132
 133   simpletable
 134     Table style, without heavy use of colour
 135
 136   table
 137     Default style, using a table with bold colours
 138 ";
 139
 140 my $msg_colours = "The following attributes may be customized using the --colour
 141 parameter:
 142
 143   join, part, action, server, nickchange
 144 ";
 145
 146
 147 ################################################################################
 148 # Main
 149
 150 sub main {
 151
 152         my $inputfile;
 153
 154         my $nick;
 155         my $time;
 156         my $line;
 157         my $text;
 158
 159         my $htmlcolour;
 160         my $nickcount = 0;
 161         my $NICKMAX = 30;
 162
 163         my %colours = %prefs_colours;
 164         my %colour_nick = %prefs_colour_nick;
 165         my %styles = %prefs_styles;
 166
 167
 168         # Quit if there is no filename specified on the command line #
 169         if ($#ARGV == -1) {
 170                 die "Required parameter missing\n\n$msg_usage";
 171         }
 172
 173
 174         # Loop through parameters, bringing filenames into $files #
 175         my $count = 0;
 176
 177         while ($ARGV[$count]) {
 178
 179                 if ($ARGV[$count] =~ /-s|--style.*/) {
 180                         $STYLE = $ARGV[$count];
 181
 182                         if ($STYLE =~ /--style=.*/) {
 183                                 $STYLE =~ s/--style=(.*)/$1/;
 184
 185                         } else {
 186                                 $count++;
 187                                 $STYLE = $ARGV[$count];
 188                         }
 189
 190                         if ($STYLE eq "") {
 191                                 print $msg_styles;
 192                                 return 0;
 193
 194                         } elsif (!defined($styles{$STYLE})) {
 195                                 die "irclog2html.pl: invalid style: `$STYLE'\n\n$msg_styles";
 196                         }
 197
 198                 } elsif ($ARGV[$count] =~ /--colou?r.*/) {
 199                         my $colour_pref = $ARGV[$count];
 200                         my $colour = $colour_pref;
 201
 202                         if ($colour_pref =~ /--colou?r$/) {
 203                                 print $msg_colours;
 204                                 return 0;
 205
 206                         } else {
 207                                 $colour_pref =~ s/--colou?r-(.*)?=.*/$1/;
 208                                 $colour =~ s/--colou?r-.*?=(.*)/$1/;
 209
 210                                 $colours{$colour_pref} = $colour;
 211                         }
 212
 213                 } else {
 214                         $inputfile = $ARGV[$count];
 215                 }
 216                 $count++;
 217         }
 218
 219         # Open input and output files #
 220         if (!$inputfile) {
 221                 # no file to open, print appropriate usage information
 222                 die "\n$msg_usage";
 223
 224         } elsif (!open(INPUT, $inputfile)) {
 225                 # not a vaild file to open, spew error and usage information
 226                 die "irclog2html.pl: cannot open $inputfile for reading\n\n$msg_usage";
 227         }
 228         if (!open(OUTPUT, ">$inputfile.html")) {
 229                 # can't open file for output, spew error
 230                 die "irclog2html.pl: cannot open $inputfile.html for writing\n";
 231         }
 232
 233
 234         # Begin output #
 235         print OUTPUT qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
 236 <html>
 237 <head>
 238         <title>$inputfile</title>
 239         <meta name="generator" content="irclog2html.pl $VERSION by Jeff Waugh">
 240         <meta name="version" content="$VERSION - $RELEASE">
 241         <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
 242 </head>
 243 <body text="#000000" bgcolor="#ffffff"><tt>
 244 };
 245
 246         if ($STYLE =~ /table/) {
 247                 print OUTPUT "<table cellspacing=3 cellpadding=2 border=0>\n";
 248         }
 249
 250         while ($line = <INPUT>) {
 251
 252                 chomp $line;
 253
 254                 if ($line ne "") {
 255
 256                         # Replace ampersands, pointies, control characters #
 257                         $line =~ s/&/&amp\;/g;
 258                         $line =~ s/</&lt\;/g;
 259                         $line =~ s/>/&gt\;/g;
 260                         $line =~ s/[\x00-\x1f]+//g;
 261
 262                         # Replace possible URLs with links #
 263                         $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;
 264
 265                         # Rip out the time #
 266                         if ($line =~ /^\[?\d\d:\d\d(:\d\d)?\]? .*$/) {
 267                                 $time = $line;
 268                                 $time =~ s/^\[?(\d\d:\d\d(:\d\d)?)\]? .*$/$1/;
 269                                 $line =~ s/^\[?\d\d:\d\d(:\d\d)?\]? (.*)$/$2/;
 270                                 print $time;
 271                         }
 272
 273                         # Colourise the comments
 274                         if ($line =~ /^&lt\;.*?&gt\;\s.*/) {
 275
 276                                 # Split $nick and $line
 277                                 $nick = $line;
 278                                 $nick =~ s/^&lt\;(.*?)&gt\;\s.*$/$1/;
 279
 280                                 # $nick =~ tr/[A-Z]/[a-z]/;
 281                                 # <======= move this into another function when getting nick colour
 282
 283                                 $text = $line;
 284                                 $text =~ s/^&lt\;.*?&gt\;\s(.*)$/$1/;
 285                                 $text =~ s/  /&nbsp\;&nbsp\;/g;
 286
 287                                 $htmlcolour = $colour_nick{$nick};
 288                                 if (!defined($htmlcolour)) {
 289                                         # new nick
 290                                         $nickcount++;
 291
 292                                         # if we've exceeded our estimate of the number of nicks, double it
 293                                         $NICKMAX *= 2 if $nickcount >= $NICKMAX;
 294
 295                                         $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
 296                                 }
 297                                 output_nicktext($nick, $text, $htmlcolour);
 298
 299                         } else {
 300                                 # Colourise the /me's #
 301                                 if ($line =~ /^\* .*$/) {
 302                                         $line =~ s/^(\*.*)$/<font color=\"$colours{"action"}\">$1<\/font>/;
 303                                 }
 304
 305                                 # Colourise joined/left messages #
 306                                 elsif ($line =~ /^(\*\*\*|--&gt;) .*joined/) {
 307                                         $line =~ s/(^(\*\*\*|--&gt;) .*)/<font color=\"$colours{"join"}\">$1<\/font>/;
 308                                 }
 309                                 elsif ($line =~ /^(\*\*\*|&lt;--) .*left|quit/) {
 310                                         $line =~ s/(^(\*\*\*|&lt;--) .*)/<font color=\"$colours{"part"}\">$1<\/font>/;
 311                                 }
 312
 313                                 # Process changed nick results, and remember colours accordingly #
 314                                 elsif ($line =~ /^(\*\*\*|---) (.*?) are|is now known as (.*)/) {
 315                                         my $nick_old;
 316                                         my $nick_new;
 317
 318                                         $nick_old = $line;
 319                                         $nick_old =~ s/^(\*\*\*|---) (.*?) (are|is) now known as .*/$1/;
 320
 321                                         $nick_new = $line;
 322                                         $nick_new =~ s/^(\*\*\*|---) .*? (are|is) now known as (.*)/$2/;
 323
 324                                         $colour_nick{$nick_new} = $colour_nick{$nick_old};
 325                                         $colour_nick{$nick_old} = undef;
 326
 327                                         $line =~ s/^((\*\*\*|---) .*)/<font color=\"$colours{"nickchange"}\">$1<\/font>/
 328                                 }
 329                                 # server messages
 330                                 elsif ($line =~ /^(\*\*\*|---) /) {
 331                                         $line =~ s/^((\*\*\*|---) .*)$/<font color=\"$colours{"server"}\">$1<\/font>/;
 332                                 }
 333
 334                                 output_servermsg($line);
 335                         }
 336                 }
 337         }
 338
 339         if ($STYLE =~ /table/) {
 340                 print OUTPUT "</table>\n";
 341         }
 342
 343         print OUTPUT qq{
 344 <br>Generated by irclog2html.pl $VERSION by <a href="mailto:jdub\@NOSPAMperkypants.org">Jeff Waugh</a>
 345  - find it at <a href="http://freshmeat.net/projects/irclog2html.pl/">freshmeat.net</a>!
 346 </tt></body></html>};
 347
 348         close INPUT;
 349         close OUTPUT;
 350
 351         return 0;
 352 }
 353
 354 exit main;