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.2403';
3 3     3   78753 use warnings;
  3         16  
  3         132  
4 3     3   18 use strict;
  3         6  
  3         65  
5              
6 3     3   66 use 5.008;
  3         12  
7              
8              
9 3     3   462 use parent 'Games::Solitaire::Verify::Solution::Base';
  3         329  
  3         16  
10              
11 3     3   598 use Games::Solitaire::Verify::Exception ();
  3         8  
  3         55  
12 3     3   1493 use Games::Solitaire::Verify::Card ();
  3         9  
  3         81  
13 3     3   1359 use Games::Solitaire::Verify::Column ();
  3         10  
  3         69  
14 3     3   1430 use Games::Solitaire::Verify::Move ();
  3         9  
  3         75  
15 3     3   1568 use Games::Solitaire::Verify::State ();
  3         12  
  3         2018  
16              
17              
18             sub _init
19             {
20 16     16   42 my ( $self, $args ) = @_;
21              
22 16         93 $self->SUPER::_init($args);
23              
24 16         45 $self->_st(undef);
25 16         67 $self->_reached_end(0);
26              
27 16         34 return 0;
28             }
29              
30             sub _read_state
31             {
32 1343     1343   2360 my $self = shift;
33              
34 1343         3348 my $line = $self->_l();
35              
36 1343 50       3136 if ( $line ne "\n" )
37             {
38 0         0 die "Non empty line before state";
39             }
40              
41 1343         2071 my $str = "";
42              
43 1343   66     3142 while ( ( $line = $self->_l() ) && ( $line ne "\n" ) )
44             {
45 13774         31082 $str .= $line;
46             }
47              
48 1343 100       3736 if ( !defined( $self->_st() ) )
49             {
50             $self->_st(
51             Games::Solitaire::Verify::State->new(
52             {
53             string => $str,
54 16         43 @{ $self->_V },
  16         169  
55             }
56             )
57             );
58             }
59             else
60             {
61 1327 50       3498 if ( $self->_st()->to_string() ne $str )
62             {
63 0         0 die "States don't match";
64             }
65             }
66              
67 1343   66     3712 while ( defined( $line = $self->_l() ) && ( $line eq "\n" ) )
68             {
69             }
70              
71 1343 50       5131 if ( $line !~ m{\A={3,}\n\z} )
72             {
73 0         0 die "No ======== separator";
74             }
75              
76 1343         3684 return ();
77             }
78              
79             sub _read_move
80             {
81 1343     1343   2213 my $self = shift;
82              
83 1343         3146 my $line = $self->_l();
84              
85 1343 50       3060 if ( $line ne "\n" )
86             {
87 0         0 die "No empty line before move";
88             }
89              
90 1343         2761 $line = $self->_l();
91              
92 1343 100       3378 if ( $line eq "This game is solveable.\n" )
93             {
94 10         32 $self->_reached_end(1);
95              
96 10         46 return "END";
97             }
98              
99 1333         2470 chomp($line);
100              
101 1333         6142 $self->_move(
102             Games::Solitaire::Verify::Move->new(
103             {
104             fcs_string => $line,
105             game => $self->_variant(),
106             }
107             )
108             );
109              
110 1333         3627 return ();
111             }
112              
113             sub _apply_move
114             {
115 1333     1333   2200 my $self = shift;
116              
117 1333 100       4024 if ( my $verdict = $self->_st()->verify_and_perform_move( $self->_move() ) )
118             {
119 6         65 Games::Solitaire::Verify::Exception::VerifyMove->throw(
120             error => "Wrong Move",
121             problem => $verdict,
122             );
123             }
124              
125 1327         2417 return ();
126             }
127              
128              
129             sub verify
130             {
131 16     16 1 549 my $self = shift;
132              
133 16         45 eval {
134              
135 16         315 my $line = $self->_l();
136              
137 16 50       139 if ( $line !~ m{\A(-=)+-\n\z} )
138             {
139 0         0 die "Incorrect start";
140             }
141              
142 16         65 $self->_read_state();
143 16         120 $self->_st->verify_contents( { max_rank => $self->_max_rank } );
144              
145 16         77 while ( !defined( scalar( $self->_read_move() ) ) )
146             {
147 1333         3480 $self->_apply_move();
148 1327         3252 $self->_read_state();
149             }
150             };
151              
152 16         4235 my $err;
153 16 100       64 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         48 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         48 return ();
171             }
172              
173             1; # End of Games::Solitaire::Verify::Solution
174              
175             __END__