Office Hours/format transcript

<perl>#!/usr/bin/perl
 
 # transcript formatting script curtsey Dr Scofield
 # modified by Zero Linden
 # modified by Andrew Linden
 # modified by CG Linden
 
 use strict;
 use English;
 use Data::Dumper;
 
 sub eject_header ( );
 sub eject_line ( $$$$ );
 sub eject_footer ( );
 
 my @color = qw(
 FF9900 66FF33 33CC00 66CC66 336633 00CC33 33FF66 66FF99 66FFCC 33FFCC 0099CC
 FF6600 333300 99CC33 66CC33 339900 336600 00FF00 009900 006633 009933 33CC66 33CC99 00FFFF 33CCFF
 FF3300 666600 666633 669900 66CC00 669933 33FF33 339933 339966 00CC66 009966 33FFFF 00CCCC 66CCFF
 99CC00 999900 999933 999966 99FF33 99CC66 66FF66 669966 66CC99 33FF99 66FFFF 33CCCC 009999 6699FF
 CC9900 CCCC00 CCCC33 CCCC66 CCCC99 CCFF99 99FF99 99CC99 99FFCC 99FFFF 66CCCC 339999 006666 3366FF
 FFCC33 FFFF00 FFFF33 FFFF66 FFFF99 FFFFCC CCFFCC FFCCFF CCFFFF 99CCCC 669999 336666 003333 0033CC
 FFCC66 CC9933 996600 996633 CC9966 FFCC99 CC99CC FF99FF 3399FF 0066CC 003366 006699 3399CC 3300CC
 FF9966 CC6633 993300 663300 CC6600 FF9933 996699 FF66FF 99CCFF 6699CC 336699 003399 3366CC
 FF6633 330000 663333 996666 CC9999 FFCCCC 993399 FF33FF CCCCFF 9999FF 6666FF 3333FF 0000FF 00CCFF
 CC3300 660000 993333 CC6666 FF9999 FF99CC 990099 FF00FF CC99FF 9999CC 6666CC 3333CC 0000CC 0099FF
 CC0033 990000 CC3333 FF6666 FF3399 CC6699 663366 CC66CC 9966CC 9933FF 666699 333399 000099 0066FF
 CC0000 FF3333 990033 CC0066 993366 660066 CC33CC 663399 6600CC 330099 333366 000066 0033FF
 FF0000 CC3366 CC3399 990066 660033 330066 660099 9933CC 6633CC 000033
 FF3366 FF6699 FF66CC FF33CC CC0099 9900CC CC33FF CC66FF 9966FF 6633FF
 FF0033 FF0066 FF0099 FF00CC 330033 CC00CC CC00FF 9900FF 6600FF 3300FF
 );
 
 # grab the username and capitalize it
 my $UserName = ucfirst $ENV{'LOGNAME'};
 
 # retrieve persisted state, if present
 my $persist_file = '.format_office_hour_transcripts';
 my $state = undef;
 if (-r $persist_file) {
 $state = eval { do $persist_file }
 } else {
 $state = { NextColor => 0, KnownTalker => {$UserName.' Linden' => "000000"}};
 }
 
 eject_header;
 while (<>) 
 {
 if (m/^(\[\d{1,2}:\d{2}\]\s+)?(.*)$/) 
 {
 my $timestamp = $1 || " ";
 my $line = $2;
 
 if ($line =~ m/
 (You|\S+\s+[^\s:]+) # $1: captures Firstname Lastname
 ([\s:]) # $2: captures (:| )
 (\s*) # $3: gobble up white space
 (.*) # $4: captures actual text
 /x)
 {
 my $who = $1;
 my $sep = $2;
 my $text = $4;
 $who = "$UserName Linden" if $who eq "You";
 $who =~ s/\s/\ /g;
 eject_line $timestamp, $who, $sep, $text
 unless $text =~ /(is Online|is Offline|accepted your inventory offer\.)$/
 or $line =~ /^(Connecting to in-world Voice Chat\.\.\.|Connected)$/
 or $line =~/^Entering god mode, level 200/
 or $line =~/^Teleport completed from/
 or $line =~/^(Chat|Short|Long) Range/
 or $line =~/^You decline/
 or $line =~/^Chair: Press Page Up to move chair up, or Page Down to move chair down/
 or $who =~ /^TwitterBox/;
 next;
 }
 }
 }
 eject_footer;
 
 open(F, ">$persist_file") || die;
 print F Dumper($state);
 close(F);
 
 exit 0;
 
 sub eject_header() {
 printf STDOUT "Transcript of [[User:${UserName}_Linden|$UserName Linden]]'s office hours:\n\n";
 printf STDOUT "{|\n";
 }
 
 my $last_who = undef;
 my $cidx = 0;
 
 sub eject_line($$$$) {
 my $timestamp = shift;
 my $who = shift;
 my $sep = shift;
 my $text = shift;
 
 my $bg = "";
 my $fg = "";
 
 if (exists $state->{KnownTalker}->{$who}) {
 $fg = $state->{KnownTalker}->{$who};
 } else {
 $fg = $color[$state->{NextColor}];
 $state->{NextColor} = ($state->{NextColor} + 1) % scalar(@color);
 $state->{KnownTalker}->{$who} = $fg;
 }
 
 if (defined $last_who and $last_who ne $who) {
 $cidx = ($cidx + 1) % 2;
 }
 $last_who = $who;
 
 if (0 == $cidx) {
 $bg="background-color:#FCFCFC;";
 } else {
 $bg="background-color:#F0F0F0;";
 }
 
 $text =~ s/%/%%/g;
 $who =~ s/\s+/ /g;
 
 printf STDOUT "|- style=\"vertical-align:top;color:#$fg;$bg\"\n";
 printf STDOUT "| $timestamp\n";
 if ($sep =~ /:/) {
 printf STDOUT "| $who:\n";
 printf STDOUT "| style=\"white-space:normal;\"|" . $text . "\n";
 } else {
 printf STDOUT "| colspan=\"2\"|$who " . $text . "\n";
 }
 }
 
 sub eject_footer() {
 printf STDOUT "|}";
 }</perl>