Games::Solitaire::Verify::Solution - verify an entire solution


Games-Solitaire-Verify documentation Contained in the Games-Solitaire-Verify distribution.

Index


Code Index:

NAME

Top

Games::Solitaire::Verify::Solution - verify an entire solution of Freecell Solver (or a similar solve)

VERSION

Top

Version 0.0101

SYNOPSIS

Top

    use Games::Solitaire::Verify::Solution;

    my $input_filename = "freecell-24-solution.txt";

    open (my $input_fh, "<", $input_filename)
        or die "Cannot open file $!";

    # Initialise a column
    my $solution = Games::Solitaire::Verify::Solution->new(
        {
            input_fh => $input_fh,
            variant => "freecell",
        },
    );

    my $ret = $solution->verify();

    close($input_fh);

    if (!$ret)
    {
        die $ret;
    }
    else
    {
        print "Solution is OK";
    }

FUNCTIONS

Top

Games::Solitaire::Verify::Solution->new({variant => $variant, input_fh => $input_fh})

Constructs a new solution verifier with the variant $variant (see Games::Solitaire::Verify::VariantsMap ), and the input file handle $input_fh.

If $variant is "custom", then the constructor also requires a 'variant_params' key which should be a populated Games::Solitaire::Verify::VariantParams object.

$solution->verify()

Traverse the solution verifying it.

AUTHOR

Top

Shlomi Fish, <shlomif at iglu.org.il>

BUGS

Top

Please report any bugs or feature requests to bug-games-solitaire-verifysolution-move at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Games-Solitaire-Verify. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Games::Solitaire::Verify::Solution

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Games-Solitaire-Verify

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Games-Solitaire-Verify

* CPAN Ratings

http://cpanratings.perl.org/d/Games-Solitaire-Verify

* Search CPAN

http://search.cpan.org/dist/Games-Solitaire-Verify

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top


Games-Solitaire-Verify documentation Contained in the Games-Solitaire-Verify distribution.
package Games::Solitaire::Verify::Solution;

use warnings;
use strict;

our $VERSION = '0.0901';

use base 'Games::Solitaire::Verify::Base';

use Games::Solitaire::Verify::Exception;
use Games::Solitaire::Verify::Card;
use Games::Solitaire::Verify::Column;
use Games::Solitaire::Verify::Move;
use Games::Solitaire::Verify::State;

__PACKAGE__->mk_acc_ref([qw(
    _input_fh
    _line_num
    _variant
    _variant_params
    _state
    _move
    _reached_end
    )]);

sub _init
{
    my ($self, $args) = @_;

    $self->_variant($args->{variant});

    if ($self->_variant() eq "custom")
    {
        $self->_variant_params($args->{variant_params});
    }
    $self->_input_fh($args->{input_fh});
    $self->_state(undef);
    $self->_line_num(0);
    $self->_reached_end(0);

    return 0;
}

sub _calc_variant_args
{
    my $self = shift;

    my @ret;
    if ($self->_variant() eq "custom")
    {
        push @ret, ('variant_params' => $self->_variant_params());
    }
    push @ret, (variant => $self->_variant());
    return \@ret;
}

sub _read_state
{
    my $self = shift;

    my $line = $self->_get_line();

    if ($line ne "")
    {
        die "Non empty line before state";
    }

    my $str = "";

    while (($line = $self->_get_line()) && ($line ne ""))
    {
        $str .= $line . "\n";
    }

    my $new_state = Games::Solitaire::Verify::State->new(
            {
                string => $str,
                @{$self->_calc_variant_args()},
            }
        );

    if (!defined($self->_state()))
    {
        # Do nothing.

    }
    else
    {
        if ($self->_state()->to_string() ne $str)
        {
            die "States don't match";
        }
    }
    $self->_state($new_state);

    while (defined($line = $self->_get_line()) && ($line eq ""))
    {
    }

    if ($line !~ m{\A={3,}\z})
    {
        die "No ======== separator";
    }

    return;
}

sub _read_move
{
    my $self = shift;

    my $line = $self->_get_line();

    if ($line ne "")
    {
        die "No empty line before move";
    }

    $line = $self->_get_line();

    if ($line eq "This game is solveable.")
    {
        $self->_reached_end(1);

        return "END";
    }

    $self->_move(Games::Solitaire::Verify::Move->new(
            {
                fcs_string => $line,
                game => $self->_variant(),
            }
        )
    );

    return;
}

sub _apply_move
{
    my $self = shift;

    if (my $verdict = $self->_state()->verify_and_perform_move($self->_move()))
    {
        Games::Solitaire::Verify::Exception::VerifyMove->throw(
            error => "Wrong Move",
            problem => $verdict,
        );
    }

    return;
}

sub _get_line
{
    my $self = shift;

    $self->_line_num($self->_line_num()+1);

    my $ret = readline($self->_input_fh());

    chomp($ret);

    return $ret;
}

sub verify
{
    my $self = shift;

    eval {

        my $line = $self->_get_line();

        if ($line !~ m{\A(-=)+-\z})
        {
            die "Incorrect start";
        }

        $self->_read_state();

        while (!defined(scalar($self->_read_move())))
        {
            $self->_apply_move();
            $self->_read_state();
        }
    };

    my $err;
    if (! $@)
    {
        # Do nothing - no exception was thrown.
    }
    elsif ($err =
        Exception::Class->caught('Games::Solitaire::Verify::Exception::VerifyMove'))
    {
        return { error => $err, line_num => $self->_line_num(), };
    }
    else
    {
        $err = Exception::Class->caught();
        ref $err ? $err->rethrow : die $err;
    }

    return;
}


1; # End of Games::Solitaire::Verify::Move