Perl script to extract tradeskill runs from a log file

[jawn]

I have written a perl script which reads a log file and prints out three kinds of lines for tradeskills. It matches up the skill up to the combine which produced the skill up. The three kinds of lines are:

1. When you fail a combine, and the matching skill up if any, or matching trivial message.
2. When you succeed a combine, and the matching skill up if any, or matching trivial message.
3. Any thing you say to a global channel, with the channel name sanitized.

The purpose of printing out the lines for global channels is that you can make notes for yourself.

Here is some example output:

You tell channel 2, 'Working on enchanted electrum fire opal'
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!
You lacked the skills to fashion the items together.
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!	You have become better at Jewelry Making! (120)
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!
You lacked the skills to fashion the items together.		You have become better at Jewelry Making! (121)
You have fashioned the items together to create something new!	You have become better at Jewelry Making! (122)
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!	You have become better at Jewelry Making! (123)
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!
You have fashioned the items together to create something new!	You have become better at Jewelry Making! (124)
You have fashioned the items together to create something new!	You can no longer advance your skill from making this item.

This script is what I used when I analyzed my skill up run from 0 to 250 in Jewelry Making.

I hope you find the script useful. Here is the script.

#!/usr/local/bin/perl

%makehash = ();
%lackhash = ();
%dinghash = ();
%trivhash = ();
%whenhash = ();
%tellhash = ();
$eventnum = 0;

$makere = '(\[
	[A-Z][a-z][a-z]		# Day abbreviation
	\s
	[A-Z][a-z][a-z]		# Month abbreviation
	\s
	\d\d			# Day number
	\s
	\d\d:\d\d:\d\d		# Time
	\s
	\d\d\d\d		# Year
	\])
	\s
	You\shave\sfashioned\sthe\sitems\stogether\sto\screate\ssomething\snew!';

$lackre = '(\[
	[A-Z][a-z][a-z]		# Day abbreviation
	\s
	[A-Z][a-z][a-z]		# Month abbreviation
	\s
	\d\d			# Day number
	\s
	\d\d:\d\d:\d\d		# Time
	\s
	\d\d\d\d		# Year
	\])
	\s
	You\slacked\sthe\sskills\sto\sfashion\sthe\sitems\stogether\.';

$dingre = '(\[
	[A-Z][a-z][a-z]		# Day abbreviation
	\s
	[A-Z][a-z][a-z]		# Month abbreviation
	\s
	\d\d			# Day number
	\s
	\d\d:\d\d:\d\d		# Time
	\s
	\d\d\d\d		# Year
	\])
	\s
	(You\shave\sbecome\sbetter\sat\s[A-Za-z ]+!\s\(
	\d+
	\))';

$trivre = '(\[
	[A-Z][a-z][a-z]		# Day abbreviation
	\s
	[A-Z][a-z][a-z]		# Month abbreviation
	\s
	\d\d			# Day number
	\s
	\d\d:\d\d:\d\d		# Time
	\s
	\d\d\d\d		# Year
	\])
	\s
	(You\scan\sno\slonger\sadvance\syour\sskill\sfrom\smaking\sthis\sitem\.)';

$tellre = '(\[
	[A-Z][a-z][a-z]		# Day abbreviation
	\s
	[A-Z][a-z][a-z]		# Month abbreviation
	\s
	\d\d			# Day number
	\s
	\d\d:\d\d:\d\d		# Time
	\s
	\d\d\d\d		# Year
	\])
	\s
	You\stell\s[A-Za-z0-9.]+:(\d+, .*)';

while (<>) {
    chomp;
    if ($_ =~ /$makere/x) {
	$when = $1;
	if (exists $whenhash{$when}) {
	    print STDERR "Time stamp already exists: $when\n";
	    exit(-1);
	}
	$whenhash{$when} = $eventnum;
	$makehash{$when} = $eventnum++;
	next;
    }
    if ($_ =~ /$lackre/x) {
	$when = $1;
	if (exists $whenhash{$when}) {
	    print STDERR "Time stamp already exists: $when\n";
	    exit(-1);
	}
	$whenhash{$when} = $eventnum;
	$lackhash{$when} = $eventnum++;
	next;
    }
    if ($_ =~ /$dingre/x) {
	$when = $1;
	$dinghash{$when} = $2;
	next;
    }
    if ($_ =~ /$trivre/x) {
	$when = $1;
	$trivhash{$when} = $2;
	next;
    }
    if ($_ =~ /$tellre/x) {
	$when = $1;
	if (exists $whenhash{$when}) {
	    print STDERR "Time stamp already exists: $when\n";
	    exit(-1);
	}
	$whenhash{$when} = $eventnum++;
	$tellhash{$when} = "You tell channel " . $2;
	next;
    }
}

foreach $when (sort {$whenhash{$a} <=> $whenhash{$b}} keys %whenhash) {
    if (exists $makehash{$when} and exists $lackhash{$when} and exists $tellhash{$when}) {
	print STDERR "Success and failure at the same time: $when\n";
	exit(-1);
    }
    if (exists $makehash{$when}) {
	print STDOUT "You have fashioned the items together to create something new!";
	$tab = "\t";
	delete $makehash{$when};
    }
    if (exists $lackhash{$when}) {
	print STDOUT "You lacked the skills to fashion the items together.";
	$tab = "\t\t";
	delete $lackhash{$when};
    }
    if (exists $dinghash{$when}) {
	print STDOUT "${tab}$dinghash{$when}";
	delete $dinghash{$when};
    }
    if (exists $trivhash{$when}) {
	print STDOUT "${tab}$trivhash{$when}";
	delete $trivhash{$when};
    }
    if (exists $tellhash{$when}) {
	print STDOUT ("\n", $tellhash{$when});
	delete $tellhash{$when};
    }
    print STDOUT "\n";
}

$blankflag = 1;
foreach $when (sort {$makehash{$a} <=> $makehash{$b}} keys %makehash) {
    print STDOUT "\nLeft over items in makehash\n\n" if $blankflag;
    print STDOUT ($when, " ", $makehash{$when}, "\n");
    $blankflag = 0;
}

$blankflag = 1;
foreach $when (sort {$lackhash{$a} <=> $lackhash{$b}} keys %lackhash) {
    print STDOUT "\nLeft over items in lackhash\n\n" if $blankflag;
    print STDOUT ($when, " ", $lackhash{$when}, "\n");
    $blankflag = 0;
}

$blankflag = 1;
foreach $when (sort {$dinghash{$a} <=> $dinghash{$b}} keys %dinghash) {
    print STDOUT "\nLeft over items in dinghash\n\n" if $blankflag;
    print STDOUT ($when, " ", $dinghash{$when}, "\n");
    $blankflag = 0;
}

$blankflag = 1;
foreach $when (sort {$trivhash{$a} <=> $trivhash{$b}} keys %trivhash) {
    print STDOUT "\nLeft over items in trivhash\n\n" if $blankflag;
    print STDOUT ($when, " ", $trivhash{$when}, "\n");
    $blankflag = 0;
}

$blankflag = 1;
foreach $when (sort {$tellhash{$a} <=> $tellhash{$b}} keys %tellhash) {
    print STDOUT "\nLeft over items in tellhash\n\n" if $blankflag;
    print STDOUT ($when, " ", $tellhash{$when}, "\n");
    $blankflag = 0;
}

[Panamah]

Today's perl challenge is to take that script and make it one line!

[jawn]

I will leave that challenge up to you. For those who don't know, there is a Perl for Microsoft Windows. You can download it from http://www.activestate.com/Products/ActivePerl

I downloaded it and installed it on my Windows system just to test it. It works. Normally, I use Perl on my Linux system.