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

This is my first solution to a qotw.  I was not sure about the use of Data::Dumper, I 
like using it for debuging. I'm think its mentioned in the camel book.

It sounded hard at first but once I started went along quickly.

I used split and then validated each element of a line so I could give more
useful error messages.

I used an array for the tape.  This was simpler than a hash.

I am going to add some way of stopping infinite loops.  I was thinking of a counter
per program line and an overall program counter.  The per line counter would get reset 
on a "state/tape value" change.

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

my $debug = exists $ENV{DEBUG} ? $ENV{DEBUG} : 0;

my $blank = '_';
my @tape = ( $blank );
my $tapepos = 0;
my $state;
my %program;

##########################
# read program from file
##########################

sub read_program ($)
{
   my ($file) = @_;
   my %program;
   my $line = 1;
   my ($os, $od, $ns, $nd, $m, $junk);
   open (F, "< $file") || die "ERROR: Unable to open $file\n";

   while(<F>)
   {
      chop;
      next if /^\s*#/;
      next if /^\s*$/;

      ($os, $od, $ns, $nd, $m, $junk) = split(/[\s#]+/);
      $state = $os if !defined $state;  # initialize state
      if ($os !~ /\w+/) {print STDERR "ERROR line $line: invalid state $os\nline:$_\n";exit 1};
      if ($od !~ /\w/)  {print STDERR "ERROR line $line: invalid data $od\nline:$_\n";exit 1};
      if ($ns !~ /\w+/) {print STDERR "ERROR line $line: invalid state $ns\nline:$_\n";exit 1};
      if ($nd !~ /\w/)  {print STDERR "ERROR line $line: invalid data $nd\nline:$_\n";exit 1};
      if ($m  !~ /L|R/) {print STDERR "ERROR line $line: invalid tape move $m\nline:$_\n";exit 1};
      if (defined $program{$os}{$od})
      {
         print STDERR "ERROR line $line: state/data already defined\nline:$_\n";
	 exit 1
      };
      $program{$os}{$od} = {
	      state => $ns,
	      data => $nd,
	      move => $m};
   }

   close(F);

   return %program;
}

##########################
# Main
##########################

my $file = shift;
die "ERROR: program filename not specified\n" unless defined $file;
@tape = split('', shift) if @ARGV;

print STDERR "tape:", join(":", @tape), "\n" if $debug;

%program = read_program($file);

print Dumper(%program) if $debug;

# Execute program
my $tapedata;
my $curstate;

$tapepos = 0;

while(1)
{
   $curstate = $state;
   $tapedata = $tape[$tapepos];
   if ( $debug )
   {
      print STDERR "$curstate:";
      print STDERR "$tapedata:";
   } 
   last if !defined $program{$curstate}{$tapedata};
   if ($debug) 
   {
      print STDERR "$program{$curstate}{$tapedata}->{state}:";
      print STDERR "$program{$curstate}{$tapedata}->{data}:";
      print STDERR "$program{$curstate}{$tapedata}->{move}:";
      print "\n";
   }

   $state = $program{$curstate}{$tapedata}->{state};
   $tape[$tapepos] = $program{$curstate}{$tapedata}->{data};

   if ($program{$curstate}{$tapedata}->{move} eq 'R')
   {
      $tapepos++;
      if(!defined $tape[$tapepos])
      {
         $tape[$tapepos] = $blank;
      }
   }
   else # tapepos eq L
   {
      $tapepos--;
      if ($tapepos < 0)
      {
	 unshift(@tape,$blank);
	 $tapepos = 0;
      }
   }
   print STDERR "\n>" if $debug;
   my $j = <STDIN> if $debug;
}
print STDERR "\n" if $debug;

# Print tape

my $start;
my $end;

print STDERR "tape:", join(":", @tape), "\n" if $debug;

for ($start = 0; $start < @tape; $start++)
{
   last if $tape[$start] ne $blank;
   #$start++;
}

for ($end = @tape - 1; $end >=0 ; $end--)
{
   last if $tape[$end] ne $blank;
}

print STDERR "start:$start:end:$end\n" if $debug;

for my $i ($start..$end)
{
   print $tape[$i];
}
print "\n";