File Coverage

blib/lib/Games/Solitaire/Verify/Solution.pm
Criterion Covered Total %
statement 71 78 91.0
branch 14 22 63.6
condition 4 6 66.6
subroutine 14 14 100.0
pod 1 1 100.0
total 104 121 85.9


line stmt bran cond sub pod time code
1             package Games::Solitaire::Verify::Solution;
2             $Games::Solitaire::Verify::Solution::VERSION = '0.2402';
3 3     3   77725 use warnings;
  3         20  
  3         117  
4 3     3   16 use strict;
  3         6  
  3         77  
5              
6 3     3   62 use 5.008;
  3         11  
7              
8              
9 3     3   452 use parent 'Games::Solitaire::Verify::Solution::Base';
  3         303  
  3         16  
10              
11 3     3   603 use Games::Solitaire::Verify::Exception ();
  3         7  
  3         56  
12 3     3   1574 use Games::Solitaire::Verify::Card ();
  3         9  
  3         137  
13 3     3   1429 use Games::Solitaire::Verify::Column ();
  3         10  
  3         71  
14 3     3   1395 use Games::Solitaire::Verify::Move ();
  3         8  
  3         75  
15 3     3   1569 use Games::Solitaire::Verify::State ();
  3         13  
  3         1964  
16              
17              
18             sub _init
19             {
20 16     16   50 my ( $self, $args ) = @_;
21              
22 16         111 $self->SUPER::_init($args);
23              
24 16         48 $self->_st(undef);
25 16         73 $self->_reached_end(0);
26              
27 16         45 return 0;
28             }
29              
30             sub _read_state
31             {
32 1343     1343   2304 my $self = shift;
33              
34 1343         3579 my $line = $self->_l();
35              
36 1343 50       3521 if ( $line ne "\n" )
37             {
38 0         0 die "Non empty line before state";
39             }
40              
41 1343         2276 my $str = "";
42              
43 1343   66     3183 while ( ( $line = $self->_l() ) && ( $line ne "\n" ) )
44             {
45 13774         31778 $str .= $line;
46             }
47              
48 1343 100       3661 if ( !defined( $self->_st() ) )
49             {
50             $self->_st(
51             Games::Solitaire::Verify::State->new(
52             {
53             string => $str,
54 16         38 @{ $self->_V },
  16         159  
55             }
56             )
57             );
58             }
59             else
60             {
61 1327 50       3613 if ( $self->_st()->to_string() ne $str )
62             {
63 0         0 die "States don't match";
64             }
65             }
66              
67 1343   66     3967 while ( defined( $line = $self->_l() ) && ( $line eq "\n" ) )
68             {
69             }
70              
71 1343 50       5726 if ( $line !~ m{\A={3,}\n\z} )
72             {
73 0         0 die "No ======== separator";
74             }
75              
76 1343         3406 return;
77             }
78              
79             sub _read_move
80             {
81 1343     1343   2215 my $self = shift;
82              
83 1343         3184 my $line = $self->_l();
84              
85 1343 50       3180 if ( $line ne "\n" )
86             {
87 0         0 die "No empty line before move";
88             }
89              
90 1343         2888 $line = $self->_l();
91              
92 1343 100       2937 if ( $line eq "This game is solveable.\n" )
93             {
94 10         41 $self->_reached_end(1);
95              
96 10         44 return "END";
97             }
98              
99 1333         2331 chomp($line);
100              
101 1333         6496 $self->_move(
102             Games::Solitaire::Verify::Move->new(
103             {
104             fcs_string => $line,
105             game => $self->_variant(),
106             }
107             )
108             );
109              
110 1333         3609 return;
111             }
112              
113             sub _apply_move
114             {
115 1333     1333   2121 my $self = shift;
116              
117 1333 100       3742 if ( my $verdict = $self->_st()->verify_and_perform_move( $self->_move() ) )
118             {
119 6         59 Games::Solitaire::Verify::Exception::VerifyMove->throw(
120             error => "Wrong Move",
121             problem => $verdict,
122             );
123             }
124              
125 1327         2414 return;
126             }
127              
128              
129             sub verify
130             {
131 16     16 1 533 my $self = shift;
132              
133 16         42 eval {
134              
135 16         352 my $line = $self->_l();
136              
137 16 50       159 if ( $line !~ m{\A(-=)+-\n\z} )
138             {
139 0         0 die "Incorrect start";
140             }
141              
142 16         62 $self->_read_state();
143 16         136 $self->_st->verify_contents( { max_rank => $self->_max_rank } );
144              
145 16         72 while ( !defined( scalar( $self->_read_move() ) ) )
146             {
147 1333         3733 $self->_apply_move();
148 1327         2927 $self->_read_state();
149             }
150             };
151              
152 16         4348 my $err;
153 16 100       66 if ( !$@ )
    50          
154             {
155             # Do nothing - no exception was thrown.
156             }
157             elsif (
158             $err = Exception::Class->caught(
159             'Games::Solitaire::Verify::Exception::VerifyMove')
160             )
161             {
162 6         54 return { error => $err, line_num => $self->_ln(), };
163             }
164             else
165             {
166 0         0 $err = Exception::Class->caught();
167 0 0       0 ref $err ? $err->rethrow : die $err;
168             }
169              
170 10         59 return;
171             }
172              
173             1; # End of Games::Solitaire::Verify::Solution
174              
175             __END__