#!/usr/bin/perl -w
use strict;
use warnings;

my %piles = (A => [reverse 1..3], B => [], C => []);

dumpPiles ();
hanoi (scalar @{$piles{A}}, keys %piles);

sub hanoi {
   my ($n, $start, $end, $extra) = @_;
   
   dumpStack ();
   
   if ($n == 1) {
        report ($start, $end);
   } else {
        hanoi($n-1, $start, $extra, $end);
        report ($start, $end);
        hanoi($n-1, $extra, $end, $start);
   }
   
   print "Exiting<\n";
}

sub report {
    my ($start, $end) = @_;
    my $disk = pop @{$piles{$start}};

    print "Moved disk $disk from $start to $end.\n";
    push @{$piles{$end}}, $disk;
    dumpPiles ();
}

sub dumpPiles {
    for my $pile (sort keys %piles) {
        print "$pile: @{$piles{$pile}}\n";
    }
    print "\n";
}

sub dumpStack {
    my $index = 1; # Don't care where dumpStack was called so start at 1
    my @stack;
    
    while ((my @params) = caller $index++) {
        unshift @stack, $params[2];
    }
    
    print "Entered> @stack\n";
}

##</code><code>##

A: 3 2 1
B: 
C: 

Entered> 8
Entered> 8 18
Entered> 8 18 18
Moved disk 1 from A to C.
A: 3 2
B: 
C: 1

Exiting<
Moved disk 2 from A to B.
A: 3
B: 2
C: 1

Entered> 8 18 20
Moved disk 1 from C to B.
A: 3
B: 2 1
C: 

Exiting<
Exiting<
Moved disk 3 from A to C.
A: 
B: 2 1
C: 3

Entered> 8 20
Entered> 8 20 18
Moved disk 1 from B to A.
A: 1
B: 2
C: 3

Exiting<
Moved disk 2 from B to C.
A: 1
B: 
C: 3 2

Entered> 8 20 20
Moved disk 1 from A to C.
A: 
B: 
C: 3 2 1

Exiting<
Exiting<
Exiting<