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>