File Coverage

blib/lib/Games/Solitaire/Verify/App/CmdLine/Expand.pm
Criterion Covered Total %
statement 21 77 27.2
branch 0 20 0.0
condition 0 3 0.0
subroutine 7 16 43.7
pod 1 1 100.0
total 29 117 24.7


line stmt bran cond sub pod time code
1             package Games::Solitaire::Verify::App::CmdLine::Expand;
2             $Games::Solitaire::Verify::App::CmdLine::Expand::VERSION = '0.2402';
3 1     1   1297 use strict;
  1         3  
  1         36  
4 1     1   6 use warnings;
  1         3  
  1         35  
5              
6 1     1   6 use parent 'Games::Solitaire::Verify::Base';
  1         2  
  1         20  
7              
8 1     1   751 use Data::Dumper qw(Dumper);
  1         7015  
  1         90  
9              
10 1     1   780 use Getopt::Long qw(GetOptionsFromArray);
  1         10572  
  1         6  
11              
12 1     1   783 use Games::Solitaire::Verify::VariantsMap ();
  1         6  
  1         29  
13 1     1   591 use Games::Solitaire::Verify::Solution::ExpandMultiCardMoves ();
  1         5  
  1         768  
14              
15             __PACKAGE__->mk_acc_ref(
16             [
17             qw(
18             _filename
19             _variant_params
20             )
21             ]
22             );
23              
24             sub _init
25             {
26 0     0     my ( $self, $args ) = @_;
27              
28 0           my $argv = $args->{'argv'};
29              
30 0           my $variant_map = Games::Solitaire::Verify::VariantsMap->new();
31              
32 0           my $variant_params = $variant_map->get_variant_by_id("freecell");
33              
34             GetOptionsFromArray(
35             $argv,
36             'g|game|variant=s' => sub {
37 0     0     my ( undef, $game ) = @_;
38              
39 0           $variant_params = $variant_map->get_variant_by_id($game);
40              
41 0 0         if ( !defined($variant_params) )
42             {
43 0           die "Unknown variant '$game'!\n";
44             }
45             },
46             'freecells-num=i' => sub {
47 0     0     my ( undef, $n ) = @_;
48 0           $variant_params->num_freecells($n);
49             },
50             'stacks-num=i' => sub {
51 0     0     my ( undef, $n ) = @_;
52 0           $variant_params->num_columns($n);
53             },
54             'decks-num=i' => sub {
55 0     0     my ( undef, $n ) = @_;
56              
57 0 0 0       if ( !( ( $n == 1 ) || ( $n == 2 ) ) )
58             {
59 0           die "Decks should be 1 or 2.";
60             }
61              
62 0           $variant_params->num_decks($n);
63             },
64             'sequences-are-built-by=s' => sub {
65 0     0     my ( undef, $val ) = @_;
66              
67             my %seqs_build_by = (
68 0           ( map { $_ => $_ } (qw(alt_color suit rank)) ),
  0            
69             "alternate_color" => "alt_color",
70             );
71              
72 0           my $proc_val = $seqs_build_by{$val};
73              
74 0 0         if ( !defined($proc_val) )
75             {
76 0           die "Unknown sequences-are-built-by '$val'!";
77             }
78              
79 0           $variant_params->seqs_build_by($proc_val);
80             },
81             'empty-stacks-filled-by=s' => sub {
82 0     0     my ( undef, $val ) = @_;
83              
84             my %empty_stacks_filled_by_map =
85 0           ( map { $_ => 1 } (qw(kings any none)) );
  0            
86              
87 0 0         if ( !exists( $empty_stacks_filled_by_map{$val} ) )
88             {
89 0           die "Unknown empty stacks filled by '$val'!";
90             }
91              
92 0           $variant_params->empty_stacks_filled_by($val);
93             },
94             'sequence-move=s' => sub {
95 0     0     my ( undef, $val ) = @_;
96              
97 0           my %seq_moves = ( map { $_ => 1 } (qw(limited unlimited)) );
  0            
98              
99 0 0         if ( !exists( $seq_moves{$val} ) )
100             {
101 0           die "Unknown sequence move '$val'!";
102             }
103              
104 0           $variant_params->sequence_move($val);
105             },
106 0 0         ) or die "Cannot process command line arguments";
107              
108 0           my $filename = shift(@$argv);
109              
110 0 0         if ( !defined($filename) )
111             {
112 0           $filename = "-";
113             }
114              
115 0           $self->_variant_params($variant_params);
116 0           $self->_filename($filename);
117              
118 0           return;
119             }
120              
121             sub run
122             {
123 0     0 1   my $self = shift;
124              
125 0           my $filename = $self->_filename();
126 0           my $variant_params = $self->_variant_params();
127              
128 0           my $fh;
129              
130 0 0         if ( $filename eq "-" )
131             {
132 0           $fh = *STDIN;
133             }
134             else
135             {
136 0 0         open $fh, "<", $filename
137             or die "Cannot open '$filename' - $!";
138             }
139              
140 0           my $solution =
141             Games::Solitaire::Verify::Solution::ExpandMultiCardMoves->new(
142             {
143             input_fh => $fh,
144             variant => "custom",
145             variant_params => $variant_params,
146             output_fh => \*STDOUT,
147             },
148             );
149              
150 0           my $verdict = $solution->verify();
151 0 0         if ( !$verdict )
152             {
153 0           exit(0);
154             }
155             else
156             {
157 0           print STDERR Dumper($verdict);
158 0           print STDERR "Solution is Wrong.\n";
159 0           exit(-1);
160             }
161             }
162              
163             1;
164              
165             __END__