[SPOILER] Perl Quiz of the Week #24 (Turing Machine simulation)

I was a little surprised at how easy this was. I'd studied Turing 
machines in school, but had never actually implemented one.

I catch one thing I think is an input error that didn't (unless I 
missed it) get mentioned in the problem statement - more than one 
line in the program for a given state/tape symbol.

Thanks, that was fun.

Bill

---------------------------------------------------------------

#!/usr/bin/perl

use strict;

my (@tape, $tapePos, $state, %transitions, $filename, $new, $out, $move);

@tape = ();
$tapePos = 0;
%transitions = ();

sub parse_pgm
     {
     my $filename = shift;
     my ($fh);

     open ($fh,"<$filename") or die "Couldn't open $filename";

     while (<$fh>)
         {
         /^\s*(#.*)?$/ and next; # Skip blank and comment lines
         /^\s*(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+([LR])\s*(#.*)?$/i or 
die "Illegal line at line number $.: $_";
         (defined($state)) or $state = $1;  # This inits the state to 
the first one in the pgm
         (defined($transitions{$1}{$2})) and die "Stop confusing me! 
There are two program lines for state $1, tape value $2";
         $transitions{$1}{$2} = { 'STATE'=>$3, 'VALUE'=>$4, 'MOVE'=>$5 };
         }
     close ($fh);
     }

sub move
     {
     my $direction = shift;

     if (uc($direction) eq "L")
         {
         ($tapePos == 0) ? (unshift (@tape, '_')) : ($tapePos--);
         }
     else    # We made sure the direction was "L" or "R" when we parsed the pgm
         {
         (defined($tape[++$tapePos]))  or push (@tape, '_');
         }
     }

# Start of main

($filename = shift) or die "You didn't give me a program file!";
(@ARGV) ? (@tape = split('',shift)) : ($tape[$tapePos] = '_');

&parse_pgm($filename);

while (defined($transitions{$state}{$tape[$tapePos]}))
     {
     $new = $transitions{$state}{$tape[$tapePos]};
     $state          = $new->{STATE};
     $tape[$tapePos] = $new->{VALUE};
     &move($new->{MOVE});
     }

$out = join('',@tape);
$out =~ s/^\_*(.*?)\_*$/$1/;
print $out."\n";
exit;