Return To The Other End

It was suggested in the comments that there was a better way to pass the history around, and the suggestion was correct. I tried Storable and was not able to make it do what I wanted, so I went with Clone.

The Revised Code

#!/usr/bin/perl

use Modern::Perl ;
use Clone qw(clone) ;
use subs qw{ solve_sudoku test_solution display_puzzle no_go_list } ;

my @array ;
my @test ;
my $x = 0 ;
my $debug = 0 ;
my $outcount = 0 ;

#READ IN DATA
while ( my $line =  ) {
    chomp $line ;
    $line =~ s{\D}{ }mxg ;
    my @line = split m{|}mx , $line ;
    for my $y ( 0 .. 8 ) {
        if ( $line[$y] =~ m{\d}mx ) { $array[$x][$y] = $line[$y] ; }
        else {                        $array[$x][$y] = '' ; }
        }
    $x++ ;
    }

solve_sudoku( 0 , 0 , \@array ) ;

#-------------------------------------------------------------------------------
sub solve_sudoku {
    my $x = shift ;     my $nx ;
    my $y = shift ;     my $ny ;
    my $history = shift ;
    my $local = clone( $history ) ;
    return if ! test_solution( $local ) ; #0 if fail
    my $current = $$local[$x][$y] ;
    $nx = $x ;
    $ny = $y + 1 ;
    if ( $ny > 8 ) {
        $ny = 0 ;
        $nx = $x + 1 ;
        }
    exit if !defined $nx ;
    exit if !defined $ny ;
    if ( $current =~ m{\d}mx ) { # current position is filled
        solve_sudoku( $nx , $ny , $local ) ;
        }
    else { # current possition is empty ;
        for my $v ( 1 .. 9 ) {
            $$local[$x][$y] = $v ;
            solve_sudoku( $nx , $ny , $local ) ;
            }
        }
    }
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
sub test_solution {
    # If incomplete and wrong, return 0
    # If incomplete and right, return 1
    # If complete   and right, exit and display
    my $ptr_array = shift ; #pointer to a potentially solved puzzle

    {   # Horizontal
        for my $x (0 .. 8 ) {
            my %error ;
            for my $y ( 0 .. 8 ) {
                my $val = $$ptr_array[$x][$y] ;
                if ( defined $val ) {
                    next if $val =~ m{\D}mx ;
                    $error{ $val }++ ;
                    }
                }
            for my $e ( sort keys %error ) {
                if ( $error{$e} > 1 && $e =~ m{\d}mx ) {
                    $debug and say 'FAIL HORIZONTAL ' . $e ;
                    return 0 ;
                    }
                }
            }
        }

    {   # Vertical
        for my $y ( 0 .. 8 ) {
            my %error ;
            for my $x ( 0 .. 8 ) {
                my $val = $$ptr_array[$x][$y] ;
                if ( defined $val ) {
                    next if $val =~ m{\D}mx ;
                    $error{ $val }++ ;
                    }
                }
            for my $e ( sort keys %error ) {
                if ( $error{$e} > 1 && $e =~ m{\d}mx ) {
                    $debug and say 'FAIL VERTICAL ' . $e ;
                    return 0 ;
                    }
                }
            }
        }

    {   # blocks
        my @range ;
        $range[0][0] = 0 ;        $range[0][1] = 1 ;        $range[0][2] = 2 ;
        $range[1][0] = 3 ;        $range[1][1] = 4 ;        $range[1][2] = 5 ;
        $range[2][0] = 6 ;        $range[2][1] = 7 ;        $range[2][2] = 8 ;

        for my $a ( 0 ..2 ) {
            for my $b ( 0 ..2 ) {
                my @x = $range[$a] ;
                my @y = $range[$b] ;
                my %error ;
                for my $i ( 0 .. 2 ) {
                    for my $j ( 0 .. 2 ) {
                        my $x = $range[$a][$i] ;
                        my $y = $range[$b][$j] ;
                        my $val = $$ptr_array[$x][$y] ;
                        if ( defined $val ) {
                            next if $val =~ m{\D}mx ;
                            $error{ $val }++ ;
                            }
                        }
                    }
                for my $e ( sort keys %error ) {
                    if ( $error{$e} > 1 && $e =~ m{\d}mx ) {
                        $debug and say 'FAIL BLOCK ' . $e ;
                        return 0 ;
                        }
                    }
                }
            }
        }

    {   # ALL GOOD
        my $c = 0 ; #numberof numbers in array
        for my $y ( 0 .. 8 ) {
            for my $x ( 0 .. 8 ) {
                my $val = $$ptr_array[$x][$y] ;
                if ( defined $val && $val =~ m{\d}mx ) {
                    $c++ ;
                    }
                }
            }
        if ( $c == 81 ) {
            say 'GOOD' ;
            display_puzzle $ptr_array ;
            exit ;
            }
        }
    return 1 ;
    }
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
sub display_puzzle {
    my $ptr_array = shift ; #pointer to a potentially solved puzzle
    say '        -------------' ;
    for my $x ( 0 .. 8 ) {
        print '        ' ;
        for my $y ( 0 .. 8 ) {
            my $v = $$ptr_array[$x][$y] ;
            if ( $v !~ m{\d}mx ) { $v = '_' ; }
            print $v  ;
            print '  ' if $y == 2 ;
            print '  ' if $y == 5 ;
            }
        say '' ;
        say '' if $x == 2 ;
        say '' if $x == 5 ;
        }
    say '        -------------  ' ;
    say '' ;
    }
#-------------------------------------------------------------------------------


exit 0 ;
#===============================================================================

__DATA__
9__3____6
_8______7
__52_89__
__8__4_73
_9_____4_
76_1__2__
__78_14__
1______5_
8____9__1

The main loop is much cleaner, and it works. Yay me! Yay readers! Yay Clone! Yay Perl! Next steps are to integrate this into a Sudoku maker, connect that via Ajax to my puzzle, and to to find good ways to input the puzzles in the first place.