Games::Solitaire::Verify::App::CmdLine - a module implementing a standalone


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

Index


Code Index:

NAME

Top

Games::Solitaire::Verify::App::CmdLine - a module implementing a standalone command line app for verifying the solutions of Solitaire games.

SYNOPSIS

Top

    $ perl -MGames::Solitaire::Verify::App::CmdLine -e 'Games::Solitaire::Verify::App::CmdLine->new({argv => \@ARGV})->run()' -- [ARGS]

DESCRIPTION

Top

This is a module implementing a standalone command line app for verifying the solutions of Solitaire games.

EXPORTS

Top

run()

Actually executed the command-line application.

AUTHOR

Top

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

BUGS

Top

Please report any bugs or feature requests to bug-test-run-cmdline@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Run-CmdLine. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top


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

package Games::Solitaire::Verify::App::CmdLine;

use strict;
use warnings;

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

use Data::Dumper qw(Dumper);

use Getopt::Long qw(GetOptionsFromArray);

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

__PACKAGE__->mk_acc_ref(
    [
        qw(
            _filename
            _variant_params
        )
    ]
);

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

    my $argv = $args->{'argv'};

    my $variant_map = Games::Solitaire::Verify::VariantsMap->new();

    my $variant_params = $variant_map->get_variant_by_id("freecell");

    GetOptionsFromArray(
        $argv,
        'g|game|variant=s' => sub {
            my (undef, $game) = @_;

            $variant_params = $variant_map->get_variant_by_id($game);

            if (!defined($variant_params))
            {
                die "Unknown variant '$game'!\n";
            }
        },
        'freecells-num=i' => sub {
            my (undef, $n) = @_;
            $variant_params->num_freecells($n);
        },
        'stacks-num=i' => sub {
            my (undef, $n) = @_;
            $variant_params->num_columns($n);
        },
        'decks-num=i' => sub {
            my (undef, $n) = @_;

            if (! ( ($n == 1) || ($n == 2) ) )
            {
                die "Decks should be 1 or 2.";
            }

            $variant_params->num_decks($n);
        },
        'sequences-are-built-by=s' => sub {
            my (undef, $val) = @_;

            my %seqs_build_by = 
            (
                (map { $_ => $_ } 
                    (qw(alt_color suit rank))
                ),
                "alternate_color" => "alt_color",
            );
            
            my $proc_val = $seqs_build_by{$val};

            if (! defined($proc_val))
            {
                die "Unknown sequences-are-built-by '$val'!";
            }
            
            $variant_params->seqs_build_by($proc_val);
        },
        'empty-stacks-filled-by=s' => sub {
            my (undef, $val) = @_;

            my %empty_stacks_filled_by_map =
            (map { $_ => 1 } (qw(kings any none)));

            if (! exists($empty_stacks_filled_by_map{$val}))
            {
                die "Unknown empty stacks filled by '$val'!";
            }
            
            $variant_params->empty_stacks_filled_by($val);
        },
        'sequence-move=s' => sub {
            my (undef, $val) = @_;

            my %seq_moves = (map { $_ => 1 } (qw(limited unlimited)));

            if (! exists ($seq_moves{$val}) )
            {
                die "Unknown sequence move '$val'!";
            }

            $variant_params->sequence_move($val);
        },
    )
        or die "Cannot process command line arguments";

    my $filename = shift(@$argv);

    if (!defined($filename))
    {
        $filename = "-";
    }

    $self->_variant_params($variant_params);
    $self->_filename($filename);

    return;
}

sub run
{
    my $self = shift;

    my $filename = $self->_filename();
    my $variant_params = $self->_variant_params();

    my $fh;

    if ($filename eq "-")
    {
        $fh = *STDIN;
    }
    else
    {
        open $fh, "<", $filename
            or die "Cannot open '$filename' - $!";
    }

    my $solution = Games::Solitaire::Verify::Solution->new(
        {
            input_fh => $fh, 
            variant => "custom",
            variant_params => $variant_params,
        },
    );

    my $verdict = $solution->verify();
    if (!$verdict)
    {
        print "Solution is OK.\n";
        exit(0);
    }
    else
    {
        print STDERR Dumper($verdict);
        print "Solution is Wrong.\n";
        exit(-1);
    }
}

1;