X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scripts%2Firclog2html.pl;h=c2affbeeee494e182bc1cec5338ac95e0c0aa81c;hb=d2f87ccd1d5f93afedc8f9f13b9f35260328614a;hp=40e4ed271a65218030ec3e1fa3e8b1cab8b4e44d;hpb=cb81fea9939f349b36e3b5a0cdc0343a6b781da1;p=infobot.git
diff --git a/scripts/irclog2html.pl b/scripts/irclog2html.pl
index 40e4ed2..c2affbe 100755
--- a/scripts/irclog2html.pl
+++ b/scripts/irclog2html.pl
@@ -22,15 +22,13 @@
# irclog2html will write out a colourised irc log, appending a .html
# extension to the output file.
-
####################################################################################
# Perl Configuration
use strict;
-$^W = 1; #RW# turn on warnings
+$^W = 1; #RW# turn on warnings
use POSIX qw(strftime);
-
####################################################################################
# Preferences
@@ -39,29 +37,29 @@ use POSIX qw(strftime);
#my $STYLE = "tt";
#my $STYLE = "simplett";
#my $STYLE = "table";
-my $STYLE = "simpletable";
+my $STYLE = "simpletable";
-my $colour_left = "#000099"; # nick leaving channel
-my $colour_joined = "#009900"; # nick joining channel
-my $colour_server = "#009900"; # server message (***)
-my $colour_nickchange = "#009900"; # nick change
-my $colour_action = "#CC00CC"; # nick action (/me waves)
+my $colour_left = "#000099"; # nick leaving channel
+my $colour_joined = "#009900"; # nick joining channel
+my $colour_server = "#009900"; # server message (***)
+my $colour_nickchange = "#009900"; # nick change
+my $colour_action = "#CC00CC"; # nick action (/me waves)
my %prefs_colour_nick = (
- "jdub" => "#993333",
- "cantanker" => "#006600",
- "chuckd" => "#339999",
+ "jdub" => "#993333",
+ "cantanker" => "#006600",
+ "chuckd" => "#339999",
);
-
####################################################################################
# Utility Functions
sub header {
- my ($channel, $date) = @_;
- my $return = '';
+ my ( $channel, $date ) = @_;
+ my $return = '';
- $return .= qq{
+ $return .=
+ qq{
irclog2html for $channel on $date
@@ -73,19 +71,19 @@ sub header {
irclog2html for $channel on $date
};
- if ($STYLE =~ /table/) {
- $return .= "\n";
- }
- return $return;
+ if ( $STYLE =~ /table/ ) {
+ $return .= "\n";
+ }
+ return $return;
}
sub footer {
- my $return = '';
- if ($STYLE =~ /table/) {
- $return .= "
\n";
- }
+ my $return = '';
+ if ( $STYLE =~ /table/ ) {
+ $return .= "
\n";
+ }
- $return .= qq{
+ $return .= qq{
Generated by irclog2html.pl by
Jeff Waugh - find it at
freshmeat.net!
@@ -93,231 +91,268 @@ Modified by Tim Riker to work with
infobot logs, split per channel, etc.
};
- return $return;
+ return $return;
}
my $lastdate = '';
sub add_footers {
- my $filename;
-
- return if not $lastdate;
-
- my @files=`ls $lastdate.html */$lastdate.html`;
- foreach $filename (@files) {
- chomp $filename;
- if (!open(OUTPUT, ">>$filename")) {
- print "Cannot open $filename for writing!\n\n";
- return;
- }
- print OUTPUT footer();
- close OUTPUT;
- }
+ my $filename;
+
+ return if not $lastdate;
+
+ my @files = `ls $lastdate.html */$lastdate.html`;
+ foreach $filename (@files) {
+ chomp $filename;
+ if ( !open( OUTPUT, ">>$filename" ) ) {
+ print "Cannot open $filename for writing!\n\n";
+ return;
+ }
+ print OUTPUT footer();
+ close OUTPUT;
+ }
}
sub output_line {
- my ($date, $time, $channel, $lineout) = @_;
+ my ( $date, $time, $channel, $lineout ) = @_;
+
+ add_footers() if $lastdate ne $date;
+
+ $lastdate = $date;
+ my $filename = "";
+ $filename .= "$channel/" if $channel;
+ $filename .= "$date.html";
- add_footers() if $lastdate ne $date;
+ mkdir( $channel, oct('755') ) if ( $channel && !-d $channel );
+ if ( !open( OUTPUT, ">>$filename" ) ) {
- $lastdate = $date;
- my $filename = "";
- $filename .= "$channel/" if $channel;
- $filename .= "$date.html";
+ #print "Cannot open $filename for writing!\n\n";
+ return;
+ }
- mkdir($channel,oct('755')) if ($channel && ! -d $channel);
- if (!open(OUTPUT, ">>$filename")) {
- #print "Cannot open $filename for writing!\n\n";
- return;
- }
- # Begin output #
- print OUTPUT header($channel, $date) if -z $filename;
+ # Begin output #
+ print OUTPUT header( $channel, $date ) if -z $filename;
- print OUTPUT $lineout;
+ print OUTPUT $lineout;
- close OUTPUT;
+ close OUTPUT;
}
sub output_timenicktext {
- my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_;
- my $lineout = '';
-
- if ($STYLE eq "table") {
- $lineout .= "";
- $lineout .= "$time | " if $time;
- $lineout .= "$nick | ";
- $lineout .= "$text<\/font> |
\n";
- }
- elsif ($STYLE eq "simpletable") {
- $lineout .= "";
- $lineout .= "$time | " if $time;
- $lineout .= "$nick | ";
- $lineout .= "$text |
\n";
- }
- elsif ($STYLE eq "simplett") {
- $lineout .= "$time " if $time;
- $lineout .= "<\;$nick>\; $text
\n";
- }
- else {
- $lineout .= "$time " if $time;
- $lineout .= "<\;$nick>\; $text<\/font>
\n";
- }
- output_line($date, $time, $channel, $lineout);
+ my ( $date, $time, $channel, $nick, $text, $htmlcolour ) = @_;
+ my $lineout = '';
+
+ if ( $STYLE eq "table" ) {
+ $lineout .= "";
+ $lineout .=
+"$time | "
+ if $time;
+ $lineout .=
+"$nick | ";
+ $lineout .=
+"$text<\/font> |
\n";
+ }
+ elsif ( $STYLE eq "simpletable" ) {
+ $lineout .= "";
+ $lineout .= "$time | " if $time;
+ $lineout .=
+ "$nick | ";
+ $lineout .= "$text |
\n";
+ }
+ elsif ( $STYLE eq "simplett" ) {
+ $lineout .= "$time " if $time;
+ $lineout .= "<\;$nick>\; $text
\n";
+ }
+ else {
+ $lineout .= "$time " if $time;
+ $lineout .=
+ "<\;$nick>\; $text<\/font>
\n";
+ }
+ output_line( $date, $time, $channel, $lineout );
}
sub output_timeservermsg {
- my ($date, $time, $channel, $line) = @_;
- my $lineout = '';
-
- if ($STYLE =~ /table/) {
- $lineout .= "";
- $lineout .= "$time | " if $time;
- $lineout .= "$line |
\n";
- }
- else {
- $lineout .= "$time " if $time;
- $lineout .= "$line
\n";
- }
- output_line($date, $time, $channel, $lineout);
+ my ( $date, $time, $channel, $line ) = @_;
+ my $lineout = '';
+
+ if ( $STYLE =~ /table/ ) {
+ $lineout .= "";
+ $lineout .= "$time | " if $time;
+ $lineout .= "$line |
\n";
+ }
+ else {
+ $lineout .= "$time " if $time;
+ $lineout .= "$line
\n";
+ }
+ output_line( $date, $time, $channel, $lineout );
}
-sub html_rgb
-{
- my ($i,$ncolours) = @_;
- $ncolours = 1 if $ncolours == 0;
-
- my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
- my $rgbmin = 240;
-
- my $a = 0.95; # tune these for the starting and ending concentrations of R,G,B
- my $c = 0.5;
-
- my $rgb = [ [$a,$c,$c], [$c,$a,$c], [$c,$c,$a], [$a,$a,$c], [$a,$c,$a], [$c,$a,$a] ];
- my $n = $i % @$rgb;
- my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours;
-
- my $r = $rgb->[$n][0] * $m;
- my $g = $rgb->[$n][1] * $m;
- my $b = $rgb->[$n][2] * $m;
- sprintf("#%02x%02x%02x",$r,$g,$b);
+sub html_rgb {
+ my ( $i, $ncolours ) = @_;
+ $ncolours = 1 if $ncolours == 0;
+
+ my $rgbmax = 125; # tune these two for the outmost ranges of colour depth
+ my $rgbmin = 240;
+
+ my $a =
+ 0.95; # tune these for the starting and ending concentrations of R,G,B
+ my $c = 0.5;
+
+ my $rgb = [
+ [ $a, $c, $c ],
+ [ $c, $a, $c ],
+ [ $c, $c, $a ],
+ [ $a, $a, $c ],
+ [ $a, $c, $a ],
+ [ $c, $a, $a ]
+ ];
+ my $n = $i % @$rgb;
+ my $m = $rgbmin + ( $rgbmax - $rgbmin ) * ( $ncolours - $i ) / $ncolours;
+
+ my $r = $rgb->[$n][0] * $m;
+ my $g = $rgb->[$n][1] * $m;
+ my $b = $rgb->[$n][2] * $m;
+ sprintf( "#%02x%02x%02x", $r, $g, $b );
}
####################################################################################
# Main
sub main {
- my ($date) = @_;
- my $files;
-
- my $line;
- my $time;
- my $lastdate = "";
- my $nick;
- my $channel;
- my $text;
-
- my $htmlcolour;
- my $nickcount = 0;
- my $NICKMAX = 30;
-
- my %colour_nick = %prefs_colour_nick;
-
- while ($line = ) {
-
- chomp $line;
-
- if (!$line eq "") {
- # parse out the time
- if ($line =~ s/^([0-9:\.]*) (.*)$/$2/) {
- $time = $1;
- } else {
- $time = '';
- }
- $channel = '';
-
- # Replace ampersands, pointies, control characters #
- $line =~ s/&/&\;/g;
- $line =~ s/<\;/g;
- $line =~ s/>/>\;/g;
- $line =~ s/\e\[[0-1]*m//g;
- $line =~ s/[\x00-\x1f]+//g;
-
- # Replace possible URLs with links #
- $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/$1<\/a>/g;
-
- # Colourise the comments
- if ($line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/) {
- # Split $nick, $channel and $line
- $nick = $line;
- $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
- $channel = $line;
- $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/;
-
- # $nick =~ tr/[A-Z]/[a-z]/;
- # <======= move this into another function when getting nick colour
-
- $text = $line;
- $text =~ s/^<\;.*?>\; (.*)$/$1/;
- $text =~ s/^ .*/<\;PROTECTED>\;/g;
- $text =~ s/ / \; \;/g;
-
- $htmlcolour = $colour_nick{$nick};
- if (!defined($htmlcolour)) {
- # new nick
- $nickcount++;
-
- # if we've exceeded our estimate of the number of nicks, double it
- $NICKMAX *= 2 if $nickcount >= $NICKMAX;
-
- $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX);
- }
- output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour);
- } elsif ($line =~ /^>\;>\;>\; /) {
- $line =~ s/^>\;>\;>\; /\*\*\* /;
-
- # Process changed nick results, and remember colours accordingly #
- if ($line =~ /\*\*\* (.*?) materializes into (.*)/) {
- my $nick_old = $1;
- my $nick_new = $2;
-
- #$nick_old = $line;
- #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
- #$nick_new = $line;
- #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
-
- $colour_nick{$nick_new} = $colour_nick{$nick_old};
- $colour_nick{$nick_old} = undef;
-
- $line =~ s/(\*\*\* .*)/$1<\/font>/
- } elsif ($line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/) {
- $channel = lc $2;
- $line =~ s/(\*\*\* .*)/$1<\/font>/;
- } elsif ($line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/) {
- $channel = lc $2;
- $line =~ s/(\*\*\* .*)/$1<\/font>/;
- } elsif ($line =~ /\*\*\* .* has signed off IRC .*/) {
- # Colourise joined/left/server messages #
- $line =~ s/(\*\*\* .*)/$1<\/font>/;
- } elsif ($line =~ /\*\*\* /) {
- $line =~ s/(\*\*\* .*)$/$1<\/font>/;
- } elsif ($line =~ /^\* .*$/) {
- # Colourise the /me's #
- $line =~ s/^(\*.*)$/$1<\/font>/;
- }
-
- output_timeservermsg($date, $time, $channel, $line);
- }
- }
- }
-
- add_footers();
-
- return 0;
+ my ($date) = @_;
+ my $files;
+
+ my $line;
+ my $time;
+ my $lastdate = "";
+ my $nick;
+ my $channel;
+ my $text;
+
+ my $htmlcolour;
+ my $nickcount = 0;
+ my $NICKMAX = 30;
+
+ my %colour_nick = %prefs_colour_nick;
+
+ while ( $line = ) {
+
+ chomp $line;
+
+ if ( !$line eq "" ) {
+
+ # parse out the time
+ if ( $line =~ s/^([0-9:\.]*) (.*)$/$2/ ) {
+ $time = $1;
+ }
+ else {
+ $time = '';
+ }
+ $channel = '';
+
+ # Replace ampersands, pointies, control characters #
+ $line =~ s/&/&\;/g;
+ $line =~ s/<\;/g;
+ $line =~ s/>/>\;/g;
+ $line =~ s/\e\[[0-1]*m//g;
+ $line =~ s/[\x00-\x1f]+//g;
+
+ # Replace possible URLs with links #
+ $line =~
+ s/((http|https|ftp|gopher|news):\/\/\S*)/$1<\/a>/g;
+
+ # Colourise the comments
+ if ( $line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/ ) {
+
+ # Split $nick, $channel and $line
+ $nick = $line;
+ $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/;
+ $channel = $line;
+ $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/;
+
+ # $nick =~ tr/[A-Z]/[a-z]/;
+ # <======= move this into another function when getting nick colour
+
+ $text = $line;
+ $text =~ s/^<\;.*?>\; (.*)$/$1/;
+ $text =~ s/^ .*/<\;PROTECTED>\;/g;
+ $text =~ s/ / \; \;/g;
+
+ $htmlcolour = $colour_nick{$nick};
+ if ( !defined($htmlcolour) ) {
+
+ # new nick
+ $nickcount++;
+
+ # if we've exceeded our estimate of the number of nicks, double it
+ $NICKMAX *= 2 if $nickcount >= $NICKMAX;
+
+ $htmlcolour = $colour_nick{$nick} =
+ html_rgb( $nickcount, $NICKMAX );
+ }
+ output_timenicktext( $date, $time, $channel, $nick, $text,
+ $htmlcolour );
+ }
+ elsif ( $line =~ /^>\;>\;>\; / ) {
+ $line =~ s/^>\;>\;>\; /\*\*\* /;
+
+ # Process changed nick results, and remember colours accordingly #
+ if ( $line =~ /\*\*\* (.*?) materializes into (.*)/ ) {
+ my $nick_old = $1;
+ my $nick_new = $2;
+
+ #$nick_old = $line;
+ #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
+ #$nick_new = $line;
+ #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;
+
+ $colour_nick{$nick_new} = $colour_nick{$nick_old};
+ $colour_nick{$nick_old} = undef;
+
+ $line =~
+s/(\*\*\* .*)/$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/ ) {
+ $channel = lc $2;
+ $line =~
+ s/(\*\*\* .*)/$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/ ) {
+ $channel = lc $2;
+ $line =~
+ s/(\*\*\* .*)/$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* .* has signed off IRC .*/ ) {
+
+ # Colourise joined/left/server messages #
+ $line =~
+ s/(\*\*\* .*)/$1<\/font>/;
+ }
+ elsif ( $line =~ /\*\*\* / ) {
+ $line =~
+ s/(\*\*\* .*)$/$1<\/font>/;
+ }
+ elsif ( $line =~ /^\* .*$/ ) {
+
+ # Colourise the /me's #
+ $line =~
+ s/^(\*.*)$/$1<\/font>/;
+ }
+
+ output_timeservermsg( $date, $time, $channel, $line );
+ }
+ }
+ }
+
+ add_footers();
+
+ return 0;
}
-if (!scalar @ARGV) {
- print "Usage: irclog2html.pl < logfile\n";
- print "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n";
+if ( !scalar @ARGV ) {
+ print "Usage: irclog2html.pl < logfile\n";
+ print
+ "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n";
exit 0;
}
my $date = shift;