#! /usr/bin/perl -w
use strict;
use Getopt::Long;
use Pod::Usage;

GetOptions(
  'pegs=i'      => \ my $peg_count,
  'disks=i'     => \ my $disk_count,
  'program=s'   => \ my $program,
  'verbose'     => \ my $verbose,
  'prompt'      => \ my $prompt,
  'help'        => \ my $help,
) or pod2usage(2);
pod2usage(1) if $help;


$verbose ||= $prompt;
$peg_count ||= 3;
$disk_count ||= 4;
$program ||= "./hanoi.pl";

my @pegs;
my %disks;
my $peg = 'A';
for (1..$peg_count) {
  push @pegs, $peg;
  $disks{$peg} = [];
  $peg++;
}
$disks{A} = [reverse 1..$disk_count];

open (PIPE, "$program $peg_count $disk_count |")
  or die "Cannot run '$program': $!";

my $move = 0;
while (<PIPE>) {
  chomp;
  $move++;

  print "Move $move: $_\n" if $verbose;

  die "Move $move: Invalid input '$_'\n"
    unless (/(\d+):\s*(\w+)\s*->\s*(\w+)/);

  my $disk = $1;
  my $from = $2;
  my $to = $3;

  die "Peg '$from' not found on move $move\n"
    unless exists $disks{$from};
  my $pile_from = $disks{$from};

  die "Disk $disk is not on top of peg '$from' at move $move\n"
    unless $pile_from->[-1] == $disk;

  die "Peg '$to' not found on move $move\n"
    unless exists $disks{$to};
  my $pile_to = $disks{$to};

  if (@$pile_to) {
    my $top = $pile_to->[-1];
    die "Disk $disk cannot go on top of disk $top at move $move\n"
      unless $disk < $top;
  }
  pop @$pile_from;
  
  if ($verbose) {
    foreach my $peg (@pegs) {
      print join " ", "$peg ", @{$disks{$peg}};
      print " -" if $peg eq $from;
      print " +$disk" if $peg eq $to;
      print "\n";
    }
    if ($prompt) {
      <STDIN>;
    }
    else {
      print "\n";
    }
  }
  push @$pile_to, $disk;
}

my @with_disks = grep {@{ $disks{$_} }} @pegs;
if (1 == @with_disks and $with_disks[0] eq 'B') {
  print "Solved in $move moves\n";
}
else {
  die "Not solved after $move moves\n";
}

__END__

=head1 NAME

hanoi-driver.pl

=head1 SYNPOSIS

 hanoi-driver.pl [opts]

=head1 OPTIONS

 -h --help       Print help and exit
 --pegs INT      How many pegs to have.  Default 3.
 --disks INT     How many disks to have.  Default 4.
 --program STR   What test program to run.  Default ./hanoi.pl.
 -v --verbose    Keep a running commentary up about each step
 --prompt        Wait for STDIN on each step.  Implies verbose.

=head1 DESCRIPTION

Test driver for programs that solve the hanoi puzzle.  It will
execute the program, study the output, die if any impossible
moves get made or the puzzle is not solved properly, and then
report how many steps it took.

If you set verbose mode it will show the game being played.

=head1 EXAMPLES

This will execute "./hanoi.pl 3 4" and expect to see a
solution to the hanoi puzzle with 3 pegs and 4 disks.

  ./hanoi-driver.pl

This will execute "./hanoi.pl 3 4" and expect to see a
solution to the hanoi puzzle with 3 pegs and 4 disks.
The output will play the solution out.

This will execute "./another_program" and expect to see a
solution to the hanoi puzzle with 5 pegs and 15 disks.

  ./hanoi-driver.pl --program=./another_program --pegs=5 --disks=15

=head1 AUTHOR

Ben Tilly (tilly on perlmonks)