MUCKmangle-1.7/ 40755 2014 147 0 7254471412 11505 5 ustar doc member MUCKmangle-1.7/index.html 100755 2014 147 1547 7242316503 13605 0 ustar doc member MUCK Log Mangler
MUCK Log Mangler V 1.7
Type the location of your log text file, or click 'browse' to locate it.
Comments, suggestions to DoC@RedBrick.DCU.IE
MUCKmangle-1.7/logconvert.pl 100755 2014 147 14646 7242316525 14357 0 ustar doc member #!/usr/bin/perl -w
use strict;
use vars qw ( %colours @colourlist @notachar);
use CGI;
my $query = new CGI;
my $asking = $query->param('asking');
my $file = $query->param('file');
my $content = "";
#if ($asking eq "yes")
#{
# $content = $query->param('content');
#}
my $stripOOC = $query->param('stripOOC') || 0;
my $stripPUB = $query->param('stripPUB') || 0;
my $colour = $query->param('colour') || 0;
my $guessed = $query->param('chars_guessed') || 0;
my $rmwhowhere = $query->param('rmwhowhere') || 0;
my $rmpages = $query->param('rmpages') || 0;
my @contentlines = ();
#if ($asking ne "yes")
#{
while (<$file>)
{
chomp;
my $line = $_;
$content .= $line;
$line =~ s//\>/g;
push (@contentlines, $line);
}
if ($rmwhowhere eq "on")
{
my @stuff;
foreach my $thingy (@contentlines)
{
next if $thingy =~ /^Player\s+Name/;
next if $thingy =~ /^\s+Name\s+Area.+?/;
next if $thingy =~ /^.+?\s*\|.+?\s*\|.+?/;
next if $thingy =~ /^[\w\_]+\s+\d+?\:\w+\s+\w+/;
next if $thingy =~ /^\-\-\-\-/;
next if $thingy =~ /^\d+\s+players are connected/;
push(@stuff, $thingy);
}
@contentlines = @stuff;
$content = "";
foreach (@contentlines)
{
$content .= $_;
}
}
if ($rmpages eq "on")
{
my @stuff;
foreach my $thingy (@contentlines)
{
next if $thingy =~ /^\w+\s+pages/;
next if $thingy =~ /^You\ page/;
next if $thingy =~ /^You\ page\-pose/;
next if $thingy =~ /^In\ a\ page\-pose/;
push(@stuff, $thingy);
}
@contentlines = @stuff;
$content = "";
foreach (@contentlines)
{
$content .= $_;
}
}
#}
#else
#{
# $content =~ s//\>/g;
# @contentlines = split('\n', $content);
#}
#foreach (@contentlines)
#{
# if (/\>/)
# {
# print STDERR $_;
# }
#}
my @outputlines = ();
my @outlines = ();
@notachar = ( "The", "A", "As", "If", "And", "You", "\<Public\>" );
@colourlist = ("RED", "ORANGE", "GREEN", "BLUE", "INDIGO", "VIOLET", "PINK");
# Unconditional Stripouts.
foreach my $line (@contentlines)
{
if (($line !~ /^Nani/)&&($line !~ /^I\ don\'t/)&&($line !~ /^\#\#/))
{
push (@outlines, $line);
}
}
@contentlines = @outlines;
@outlines = ();
if ($stripOOC eq "on")
{
foreach my $line (@contentlines)
{
if ($line !~ /^\w+\s+\(OOC\)/i)
{
$line .= "\n";
push (@outputlines, $line);
}
}
}
else
{
foreach my $line (@contentlines)
{
push(@outputlines, $line . "\n");
}
}
if ($stripPUB eq "on")
{
foreach my $line (@outputlines)
{
if ($line !~ /^\<Public\>/i)
{
push (@outlines, $line);
}
}
@outputlines = @outlines;
}
if ($colour eq "on")
{
my @chars = guess_names(@contentlines);
if (defined $guessed)
{
if ($guessed eq "on")
{
foreach my $char (@chars)
{
if (defined $query->param("char_$char"))
{
my $is_char = $query->param("char_$char");
if ($is_char eq "on")
{
$colours{$char} = 1;
}
}
}
}
else
{
print $query->header();
print "?\n";
print "Choose Character names
\n";
print "These are the names I've guessed are Character names from the log you gave me.\n";
print "But since I'm just a dumb program, I can't tell if they're actually character names.\n";
print "You have to tell me. Check the boxes beside the real character names. Thanks.
\n";
print "Oh, and select the button to the right of your character.\n";
print "\n";
exit;
}
}
}
my $colourindex = 0;
#Assign a Colour to each Character.
foreach (keys %colours)
{
$colours{$_} = $colourlist[$colourindex++];
}
if ($colour eq "on")
{
$colours{'You'} = $colours{$query->param('me') || ""};
}
print $query->header();
print "MUCK Log\n";
print "\n";
if ($colour eq "on")
{
print "Characters involved are: ";
foreach my $char (keys %colours)
{
if ($char ne "You")
{
print "$char ($colours{$char}), ";
}
}
print "
";
my $me = $query->param('me') || "Unknown";
print "Logged by $me
\n";
}
foreach my $line (@outputlines)
{
my $char = (split(' ',$line))[0];
# Put OOC comments in Italics.
if ($line =~ /^\w+\s+\(OOC\)/i)
{
chomp $line;
$line = "" . $line . "\n";
}
# Boldify the first word, we presume it's the character name
# Yes, i know this doesn't differentiate between says and spoofs, but...
if (grep(/^$char$/, keys %colours))
{
if ($line =~ /^/i)
{
$line =~ s#^()?(\w+)#$1$2#i;
}
else
{
$line =~ s#^(\w+)#$1#i;
}
chomp $line;
$line = "" . $line . "\n";
}
# Replace newlines with
tags.
$line =~ s/\n/
\n/g;
print $line;
}
print "\n";
sub guess_names
{
my @contentlines = @_;
my %charnames = ();
LINE:
foreach my $line (@contentlines)
{
foreach my $reserved (@notachar)
{
if ($line =~ /^$reserved /i)
{
next LINE;
}
}
# At this stage we think the first word is a character name
my $char = (split( ' ', $line))[0];
$charnames{$char} = 1;
}
# print STDERR "Guessed names : " . join( ' ', keys %charnames) . "\n";
return (keys %charnames);
}