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

I didn't like how my first solution didn't do any error checking for
state/value pairs that don't exist.

Figured I should update it a little ... :)

-Tom

#!/usr/local/bin/perl -w
use strict ;
my (%state, %tape, $current_state, $the_line) ;
my ($tape_pointer, $pos, $program_file, $tape) = (0, 0, @ARGV, '') ;

$tape=~ s/^_+// ;                           ## Remove leading _ from tape
map($tape{$pos++}=$_ , split(//, $tape)) ;  ## Convert to hash for easy negative position handling

open(PROGRAM, $program_file) || die "ERROR : Unable to open $program_file : $!\n" ;
while (defined($the_line = <PROGRAM>)) {    ## Store states
    $the_line =~ s/\#.*$// ;                ## Remove comments
    $the_line =~ s/^\s+// ;                 ## Remove leading spaces
    next if $the_line =~ /^\s*$/ ;          ## Skip empty lines
    if ($the_line =~ /(\w+)\s+(\w)\s+(\w+)\s+(\w)\s+([RL])/i) {
	my ($this_state, $this_value, $next_state, $next_value, $dir) = ($1, $2, $3, $4, $5) ;
	$current_state = $this_state unless $current_state ;                     ## Save the starting state
	%{$state{$this_state}{$this_value}}   = (next_state=>$next_state, next_value=>$next_value) ;
	$state{$this_state}{$this_value}{dir} = ($dir =~ /R/i) ? 1 : -1 ;        ## Convert R, L to 1, -1
    } else {
	die "ERROR : Do not understand the following line : $the_line\n" ;
    }
}

while (defined($state{$current_state})) {                                        ## Run the program
    my $current_value = (defined($tape{$tape_pointer})) ? $tape{$tape_pointer} : '_' ;
    die "ERROR : $program_file does not specify a state of $current_state with a tape value of $current_value\n"
      unless (defined($state{$current_state}{$current_value}{next_value})) ;
    $tape{$tape_pointer} = $state{$current_state}{$current_value}{next_value} ;  ## Update the current location's value
    $tape_pointer       += $state{$current_state}{$current_value}{dir} ;         ## Update the tape pointer
    $current_state       = $state{$current_state}{$current_value}{next_state} ;  ## Get the next state
}

undef $tape ;
foreach my $i (sort {$a <=> $b} (keys(%tape))) {  ## Convert tape hash to string in the correct order
    $tape .= $tape{$i} ;
}
$tape =~ s/_+$// ;                                ## Clean up leading and trailing _
$tape =~ s/^_+// ;
print "$tape\n" ;                                 ## Print the tape