line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
=head1 NAME |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
Weasel::Driver::Mock - Weasel driver for testing purposes |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 VERSION |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
0.02 |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use Weasel; |
13
|
|
|
|
|
|
|
use Weasel::Session; |
14
|
|
|
|
|
|
|
use Weasel::Driver::Mock; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my %opts = ( |
17
|
|
|
|
|
|
|
states => [ |
18
|
|
|
|
|
|
|
{ cmd => 'get', args => [ 'http://localhost/index' ] }, |
19
|
|
|
|
|
|
|
{ cmd => 'find', args => [ '//div[@id="your-id"]' ] }, |
20
|
|
|
|
|
|
|
], |
21
|
|
|
|
|
|
|
); |
22
|
|
|
|
|
|
|
my $weasel = Weasel->new( |
23
|
|
|
|
|
|
|
default_session => 'default', |
24
|
|
|
|
|
|
|
sessions => { |
25
|
|
|
|
|
|
|
default => Weasel::Session->new( |
26
|
|
|
|
|
|
|
driver => Weasel::Driver::Mock->new(%opts), |
27
|
|
|
|
|
|
|
), |
28
|
|
|
|
|
|
|
}); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$weasel->session->get('http://localhost/index'); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
This module implements the L<Weasel::DriverRole> protocol, |
36
|
|
|
|
|
|
|
mimicing a true web driver session. The concept has been |
37
|
|
|
|
|
|
|
very much inspired by DBD::Mock. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
The C<states> attribute of a Weasel::Driver::Mock object contains |
40
|
|
|
|
|
|
|
a reference to an array of hashes. Each hash describes a C<state>. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
[ { |
43
|
|
|
|
|
|
|
cmd => 'get', args => [ 'http://localhost/index' ] |
44
|
|
|
|
|
|
|
}, |
45
|
|
|
|
|
|
|
{ |
46
|
|
|
|
|
|
|
cmd => 'find', args => [ '//div[@id="help-me"]' ], |
47
|
|
|
|
|
|
|
ret => { |
48
|
|
|
|
|
|
|
id => 'abc', |
49
|
|
|
|
|
|
|
}, |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
{ |
52
|
|
|
|
|
|
|
cmd => 'find_all', args => [ '//div' ], |
53
|
|
|
|
|
|
|
ret_array => [ |
54
|
|
|
|
|
|
|
{ id => 'abc' }, |
55
|
|
|
|
|
|
|
{ id => 'def' }, |
56
|
|
|
|
|
|
|
], |
57
|
|
|
|
|
|
|
}, |
58
|
|
|
|
|
|
|
{ |
59
|
|
|
|
|
|
|
cmd => 'click', args => [ 'abc' ], |
60
|
|
|
|
|
|
|
err => 'Element not visible on the page', |
61
|
|
|
|
|
|
|
}, |
62
|
|
|
|
|
|
|
... |
63
|
|
|
|
|
|
|
] |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 STATES |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
A state is a hash where its keys have the following meaning: |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=over |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item cmd (required) |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The name of the function called (e.g. 'find', 'find_all' or 'get'). |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item args (optional) |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
The expected list of arguments passed to the called function. When not |
78
|
|
|
|
|
|
|
provided, the arguments of the call are not validated. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Note that this list excludes any file handles passed in. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item ret (or ret_array) (optional) |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Specifies the value to be returned from the called function, or, |
85
|
|
|
|
|
|
|
in case of C<ret_array>, the values to be returned. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=item err (optional) |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
When a state specifies an C<err> key, the called function (if it is |
90
|
|
|
|
|
|
|
the correct one) die with the value as the argument to C<die>. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item content (optional) |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item content_base64 (optional) |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=item content_from_file (optional) |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Provides the content to be written to the file handle when the called |
99
|
|
|
|
|
|
|
function accepts a file handle argument. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
The string provided as value of C<content> will be printed to the handle. |
102
|
|
|
|
|
|
|
The string provided as the value of C<content_base64> will be passed to |
103
|
|
|
|
|
|
|
C<MIME::Base64::decode>. The decoded content is then written to the handle. |
104
|
|
|
|
|
|
|
The string provided as the value of C<content_from_file> is taken as a file |
105
|
|
|
|
|
|
|
name. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=back |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=cut |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
package Weasel::Driver::Mock; |
120
|
|
|
|
|
|
|
|
121
|
3
|
|
|
3
|
|
148709
|
use strict; |
|
3
|
|
|
|
|
16
|
|
|
3
|
|
|
|
|
72
|
|
122
|
3
|
|
|
3
|
|
14
|
use warnings; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
58
|
|
123
|
|
|
|
|
|
|
|
124
|
3
|
|
|
3
|
|
1110
|
use namespace::autoclean; |
|
3
|
|
|
|
|
43209
|
|
|
3
|
|
|
|
|
10
|
|
125
|
|
|
|
|
|
|
|
126
|
3
|
|
|
3
|
|
163
|
use Carp; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
119
|
|
127
|
3
|
|
|
3
|
|
1197
|
use Data::Compare; |
|
3
|
|
|
|
|
26225
|
|
|
3
|
|
|
|
|
15
|
|
128
|
3
|
|
|
3
|
|
10419
|
use Data::Dumper; |
|
3
|
|
|
|
|
16476
|
|
|
3
|
|
|
|
|
156
|
|
129
|
3
|
|
|
3
|
|
1223
|
use English qw(-no_match_vars); |
|
3
|
|
|
|
|
5425
|
|
|
3
|
|
|
|
|
14
|
|
130
|
3
|
|
|
3
|
|
2111
|
use Time::HiRes; |
|
3
|
|
|
|
|
3359
|
|
|
3
|
|
|
|
|
10
|
|
131
|
3
|
|
|
3
|
|
1375
|
use Weasel::DriverRole; |
|
3
|
|
|
|
|
1183082
|
|
|
3
|
|
|
|
|
104
|
|
132
|
|
|
|
|
|
|
|
133
|
3
|
|
|
3
|
|
24
|
use Moose; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
16
|
|
134
|
|
|
|
|
|
|
with 'Weasel::DriverRole'; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=over |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=item states |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=cut |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
has states => (is => 'ro', isa => 'ArrayRef', default => sub { [] }); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
has _remaining_states => (is => 'rw', isa => 'ArrayRef'); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=back |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 IMPLEMENTATION OF Weasel::DriverRole |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
For the documentation of the methods in this section, |
156
|
|
|
|
|
|
|
see L<Weasel::DriverRole>. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=over |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item implements |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub implements { |
165
|
0
|
|
|
0
|
1
|
0
|
return '0.03'; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=item start |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
A few capabilities can be specified in t/.pherkin.yaml |
172
|
|
|
|
|
|
|
Some can even be specified as environment variables, |
173
|
|
|
|
|
|
|
they will be expanded here if present. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub start { |
178
|
30
|
|
|
30
|
1
|
95
|
my $self = shift; |
179
|
|
|
|
|
|
|
|
180
|
30
|
|
|
|
|
37
|
$self->_remaining_states([ @{$self->states} ]); |
|
30
|
|
|
|
|
657
|
|
181
|
|
|
|
|
|
|
|
182
|
30
|
|
|
|
|
608
|
return $self->started(1); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=item stop |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub stop { |
190
|
25
|
|
|
25
|
1
|
2012
|
my $self = shift; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
carp 'Web driver has states left while stop() called' |
193
|
25
|
100
|
|
|
|
33
|
if scalar @{$self->_remaining_states}; |
|
25
|
|
|
|
|
699
|
|
194
|
|
|
|
|
|
|
|
195
|
25
|
|
|
|
|
700
|
return $self->started(0); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=item find_all |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub find_all { |
203
|
1
|
|
|
1
|
1
|
16
|
my ($self, @args) = @_; |
204
|
|
|
|
|
|
|
|
205
|
1
|
|
|
|
|
3
|
my @rv = $self->_check_state('find_all', \@args); |
206
|
1
|
50
|
|
|
|
5
|
return wantarray ? @rv : \@rv; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item get |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub get { |
214
|
7
|
|
|
7
|
1
|
544
|
my ($self, @args) = @_; |
215
|
|
|
|
|
|
|
|
216
|
7
|
|
|
|
|
19
|
return $self->_check_state('get', \@args); |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=item wait_for |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=cut |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub wait_for { |
224
|
0
|
|
|
0
|
1
|
0
|
my ($self, $callback, %args) = @_; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Do NOT use Selenium::Waiter, it eats all exceptions! |
227
|
0
|
|
|
|
|
0
|
my $end = time() + $args{retry_timeout}; |
228
|
0
|
|
|
|
|
0
|
my $rv; |
229
|
0
|
|
|
|
|
0
|
while (1) { |
230
|
0
|
|
|
|
|
0
|
$rv = $callback->(); |
231
|
0
|
0
|
|
|
|
0
|
return $rv if $rv; |
232
|
|
|
|
|
|
|
|
233
|
0
|
0
|
|
|
|
0
|
if (time() <= $end) { |
|
|
0
|
|
|
|
|
|
234
|
0
|
|
|
|
|
0
|
sleep $args{poll_delay}; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
elsif ($args{on_timeout}) { |
237
|
0
|
|
|
|
|
0
|
$args{on_timeout}->(); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
else { |
240
|
|
|
|
|
|
|
croak "wait_for deadline expired waiting for: $args{description}" |
241
|
0
|
0
|
|
|
|
0
|
if defined $args{description}; |
242
|
|
|
|
|
|
|
|
243
|
0
|
|
|
|
|
0
|
croak 'wait_for deadline expired; consider increasing the deadline'; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
0
|
return; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=item clear |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=cut |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub clear { |
256
|
1
|
|
|
1
|
1
|
16
|
my ($self, @args) = @_; |
257
|
|
|
|
|
|
|
|
258
|
1
|
|
|
|
|
3
|
return $self->_check_state('clear', \@args); |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=item click |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=cut |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub click { |
266
|
2
|
|
|
2
|
1
|
31
|
my ($self, @args) = @_; |
267
|
|
|
|
|
|
|
|
268
|
2
|
|
|
|
|
7
|
return $self->_check_state('click', \@args); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=item dblclick |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=cut |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub dblclick { |
276
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
277
|
|
|
|
|
|
|
|
278
|
1
|
|
|
|
|
4
|
return $self->_check_state('dblclick', \@args); |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=item execute_script |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=cut |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub execute_script { |
286
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
287
|
|
|
|
|
|
|
|
288
|
1
|
|
|
|
|
4
|
return $self->_check_state('execute_script', \@args); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=item get_attribute($id, $att_name) |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=cut |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub get_attribute { |
296
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
297
|
|
|
|
|
|
|
|
298
|
1
|
|
|
|
|
4
|
return $self->_check_state('get_attribute', \@args); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item get_page_source($fh) |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=cut |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub get_page_source { |
306
|
6
|
|
|
6
|
1
|
278
|
my ($self,$fh) = @_; |
307
|
|
|
|
|
|
|
|
308
|
6
|
|
|
|
|
26
|
$self->_check_state('get_page_source', [], $fh); |
309
|
4
|
|
|
|
|
8
|
return; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=item get_text($id) |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=cut |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub get_text { |
317
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
318
|
|
|
|
|
|
|
|
319
|
1
|
|
|
|
|
4
|
return $self->_check_state('get_text', \@args); |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=item is_displayed($id) |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=cut |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub is_displayed { |
327
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
328
|
|
|
|
|
|
|
|
329
|
1
|
|
|
|
|
4
|
return $self->_check_state('is_displayed', \@args); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=item set_attribute($id, $att_name, $value) |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=cut |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub set_attribute { |
337
|
1
|
|
|
1
|
1
|
14
|
my ($self, @args) = @_; |
338
|
|
|
|
|
|
|
|
339
|
1
|
|
|
|
|
4
|
return $self->_check_state('set_attribute', \@args); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=item get_selected($id) |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=cut |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub get_selected { |
347
|
1
|
|
|
1
|
1
|
14
|
my ($self, @args) = @_; |
348
|
|
|
|
|
|
|
|
349
|
1
|
|
|
|
|
4
|
return $self->_check_state('get_selected', \@args); |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=item set_selected($id, $value) |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=cut |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub set_selected { |
357
|
1
|
|
|
1
|
1
|
14
|
my ($self, @args) = @_; |
358
|
|
|
|
|
|
|
|
359
|
1
|
|
|
|
|
4
|
return $self->_check_state('set_selected', \@args); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=item screenshot($fh) |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=cut |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub screenshot { |
367
|
1
|
|
|
1
|
1
|
122
|
my ($self,$fh) = @_; |
368
|
|
|
|
|
|
|
|
369
|
1
|
|
|
|
|
4
|
$self->_check_state('screenshot', [], $fh); |
370
|
1
|
|
|
|
|
3
|
return; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=item send_keys($element_id, @keys) |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub send_keys { |
378
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
379
|
|
|
|
|
|
|
|
380
|
1
|
|
|
|
|
4
|
return $self->_check_state('send_keys', \@args); |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=item tag_name($elem) |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=cut |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub tag_name { |
388
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
389
|
|
|
|
|
|
|
|
390
|
1
|
|
|
|
|
9
|
return $self->_check_state('tag_name', \@args); |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=back |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
This module implements the following methods in addition to the |
398
|
|
|
|
|
|
|
Weasel::DriverRole protocol methods: |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=over |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=item set_wait_timeout |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
Sets the C<wait_timeut> attribute of the object. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=cut |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub set_wait_timeout { |
409
|
0
|
|
|
0
|
1
|
0
|
my ($self, @args) = @_; |
410
|
0
|
|
|
|
|
0
|
my ($value) = @args; |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
0
|
$self->_check_state('set_wait_timeout', \@args); |
413
|
0
|
|
|
|
|
0
|
return $self->_set_wait_timeout($value); |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=item set_window_size |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
Sets the C<window_size> attribute of the object. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=cut |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
sub set_window_size { |
423
|
1
|
|
|
1
|
1
|
15
|
my ($self, @args) = @_; |
424
|
|
|
|
|
|
|
|
425
|
1
|
|
|
|
|
4
|
return $self->_check_state('set_window_size', \@args); |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=back |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=cut |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# PRIVATE IMPLEMENTATIONS |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $cmp = Data::Compare->new; |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub _copy_file { |
437
|
1
|
|
|
1
|
|
2
|
my ($src, $tgt) = @_; |
438
|
|
|
|
|
|
|
|
439
|
1
|
|
|
|
|
2
|
my ($src_h, $tgt_h, $close_src, $close_tgt); |
440
|
|
|
|
|
|
|
|
441
|
1
|
50
|
|
|
|
3
|
if (ref $src) { |
442
|
0
|
|
|
|
|
0
|
$src_h = $src; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
else { |
445
|
1
|
50
|
|
|
|
31
|
open my $sh, '<', $src |
446
|
|
|
|
|
|
|
or croak "Can't open file $src for copying: $ERRNO"; |
447
|
1
|
|
|
|
|
3
|
$src_h = $sh; |
448
|
1
|
|
|
|
|
3
|
$close_src = 1; |
449
|
|
|
|
|
|
|
} |
450
|
1
|
|
|
|
|
3
|
binmode $src_h; |
451
|
|
|
|
|
|
|
|
452
|
1
|
50
|
|
|
|
4
|
if (ref $tgt) { |
453
|
1
|
|
|
|
|
1
|
$tgt_h = $tgt; |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
else { |
456
|
0
|
0
|
|
|
|
0
|
open my $th, '<', $tgt |
457
|
|
|
|
|
|
|
or croak "Can't open file $tgt for copying: $ERRNO"; |
458
|
0
|
|
|
|
|
0
|
$tgt_h = $th; |
459
|
0
|
|
|
|
|
0
|
$close_tgt = 1; |
460
|
|
|
|
|
|
|
} |
461
|
1
|
|
|
|
|
6
|
binmode $tgt_h; |
462
|
|
|
|
|
|
|
|
463
|
1
|
|
|
|
|
5
|
my $buf = ''; |
464
|
1
|
|
|
|
|
1
|
my $size = 1024; |
465
|
1
|
|
|
|
|
2
|
while (1) { |
466
|
2
|
|
|
|
|
29
|
my ($r, $w, $t); |
467
|
2
|
50
|
|
|
|
20
|
defined($r = sysread $src_h, $buf, $size) |
468
|
|
|
|
|
|
|
or croak "Failed to read from source file: $ERRNO"; |
469
|
2
|
100
|
|
|
|
6
|
last unless $r; |
470
|
1
|
|
|
|
|
17
|
for ($w = 0; $w < $r; $w += $t) { |
471
|
1
|
50
|
|
|
|
7
|
$t = syswrite $tgt_h, $buf, $r - $w, $w |
472
|
|
|
|
|
|
|
or croak "Failed to write to target file: $ERRNO"; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
} |
475
|
1
|
50
|
0
|
|
|
2
|
close($tgt_h) || carp "Failed to close target file handle: $ERRNO" |
476
|
|
|
|
|
|
|
if $close_tgt; |
477
|
1
|
50
|
33
|
|
|
11
|
close($src_h) || carp "Failed to close source file handle: $ERRNO" |
478
|
|
|
|
|
|
|
if $close_src; |
479
|
|
|
|
|
|
|
|
480
|
1
|
|
|
|
|
6
|
return 1; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub _check_state { |
485
|
29
|
|
|
29
|
|
55
|
my ($self, $cmd, $args, $fh) = @_; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
croak "States exhausted while '$cmd' called" |
488
|
29
|
100
|
|
|
|
33
|
if ! @{$self->_remaining_states}; |
|
29
|
|
|
|
|
689
|
|
489
|
|
|
|
|
|
|
|
490
|
28
|
|
|
|
|
31
|
my $expect = shift @{$self->_remaining_states}; |
|
28
|
|
|
|
|
611
|
|
491
|
|
|
|
|
|
|
croak "Mismatch between expected ($expect->{cmd}) and actual ($cmd) driver command" |
492
|
28
|
100
|
|
|
|
70
|
if $expect->{cmd} ne $cmd; |
493
|
|
|
|
|
|
|
|
494
|
27
|
100
|
|
|
|
45
|
if ($expect->{args}) { |
495
|
20
|
100
|
|
|
|
62
|
if (! $cmp->Cmp($expect->{args}, $args)) { |
496
|
|
|
|
|
|
|
croak('Mismatch between expected and actual command arguments;' |
497
|
|
|
|
|
|
|
. " expected:\n" . Dumper($expect->{args}) |
498
|
1
|
|
|
|
|
88
|
. "\ngot:\n" . Dumper($args)) |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
26
|
100
|
66
|
|
|
1754
|
if ($fh) { |
|
|
100
|
33
|
|
|
|
|
503
|
6
|
100
|
|
|
|
36
|
if (defined $expect->{content}) { # empty string is false but defined |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
504
|
|
|
|
|
|
|
print ${fh} $expect->{content} |
505
|
3
|
50
|
|
|
|
14
|
or croak "Can't write provided content to file handle for command $cmd: $ERRNO"; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
elsif ($expect->{content_from_file}) { |
508
|
1
|
50
|
|
|
|
4
|
_copy_file $expect->{content_from_file}, $fh |
509
|
|
|
|
|
|
|
or croak "Can't copy $expect->{content_from_file} into file handle for command $cmd: $ERRNO"; |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
elsif ($expect->{content_base64}) { |
512
|
|
|
|
|
|
|
print ${fh} MIME::Base64::decode($expect->{content_base64}) |
513
|
1
|
50
|
|
|
|
7
|
or croak "Can't write provided base64 content to file handle for command $cmd: $ERRNO"; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
else { |
516
|
1
|
|
|
|
|
9
|
croak 'Output handle provided, but one of content/content_from_file/content_base64 missing'; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
elsif ($expect->{content} or $expect->{content_from_file} |
520
|
|
|
|
|
|
|
or $expect->{content_base64}) { |
521
|
1
|
|
|
|
|
9
|
croak "Content provided for command $cmd, but output handle missing"; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
24
|
100
|
|
|
|
109
|
croak $expect->{err} if $expect->{err}; |
525
|
|
|
|
|
|
|
|
526
|
23
|
100
|
|
|
|
38
|
return @{$expect->{ret_array}} if $expect->{ret_array}; |
|
1
|
|
|
|
|
3
|
|
527
|
22
|
|
|
|
|
77
|
return $expect->{ret}; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
__PACKAGE__->meta()->make_immutable(); |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=head1 AUTHOR |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Erik Huelsmann |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
Erik Huelsmann |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=head1 MAINTAINERS |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
Erik Huelsmann |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
Bugs can be filed in the GitHub issue tracker for the |
548
|
|
|
|
|
|
|
Weasel::Driver::Mock project: |
549
|
|
|
|
|
|
|
L<https://github.com/perl-weasel/weasel-driver-mock/issues> |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=head1 SOURCE |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
The source code repository for Weasel::Driver::Mock is at |
554
|
|
|
|
|
|
|
L<https://github.com/perl-weasel/weasel-driver-mock> |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=head1 SUPPORT |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
Community support is available through |
559
|
|
|
|
|
|
|
L<perl-weasel@googlegroups.com|mailto:perl-weasel@googlegroups.com>. |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
(C) 2019 Erik Huelsmann |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
Licensed under the same terms as Perl. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=cut |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
1; |
570
|
|
|
|
|
|
|
|