line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
4
|
|
|
4
|
|
260585
|
use v5.14; |
|
4
|
|
|
|
|
36
|
|
2
|
4
|
|
|
4
|
|
25
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
179
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package App::pherkin 0.85; |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
|
7
|
4
|
|
|
4
|
|
561
|
use lib; |
|
4
|
|
|
|
|
767
|
|
|
4
|
|
|
|
|
29
|
|
8
|
4
|
|
|
4
|
|
3507
|
use Getopt::Long; |
|
4
|
|
|
|
|
46266
|
|
|
4
|
|
|
|
|
20
|
|
9
|
4
|
|
|
4
|
|
1723
|
use Module::Runtime qw(use_module module_notional_filename); |
|
4
|
|
|
|
|
3613
|
|
|
4
|
|
|
|
|
31
|
|
10
|
4
|
|
|
4
|
|
261
|
use List::Util qw(max); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
248
|
|
11
|
4
|
|
|
4
|
|
3138
|
use Pod::Usage; |
|
4
|
|
|
|
|
200250
|
|
|
4
|
|
|
|
|
672
|
|
12
|
4
|
|
|
4
|
|
2240
|
use FindBin qw($RealBin $Script); |
|
4
|
|
|
|
|
4668
|
|
|
4
|
|
|
|
|
471
|
|
13
|
4
|
|
|
4
|
|
1904
|
use YAML qw( LoadFile ); |
|
4
|
|
|
|
|
28649
|
|
|
4
|
|
|
|
|
242
|
|
14
|
4
|
|
|
4
|
|
2743
|
use Data::Dumper; |
|
4
|
|
|
|
|
26082
|
|
|
4
|
|
|
|
|
248
|
|
15
|
4
|
|
|
4
|
|
38
|
use File::Spec; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
105
|
|
16
|
4
|
|
|
4
|
|
1386
|
use Path::Class qw/file dir/; |
|
4
|
|
|
|
|
111979
|
|
|
4
|
|
|
|
|
304
|
|
17
|
|
|
|
|
|
|
|
18
|
4
|
|
|
4
|
|
2022
|
use Cucumber::TagExpressions; |
|
4
|
|
|
|
|
100360
|
|
|
4
|
|
|
|
|
206
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use Test::BDD::Cucumber::I18n |
21
|
4
|
|
|
4
|
|
1545
|
qw(languages langdef readable_keywords keyword_to_subname); |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
410
|
|
22
|
4
|
|
|
4
|
|
1693
|
use Test::BDD::Cucumber::Loader; |
|
4
|
|
|
|
|
29
|
|
|
4
|
|
|
|
|
166
|
|
23
|
|
|
|
|
|
|
|
24
|
4
|
|
|
4
|
|
27
|
use Moo; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
19
|
|
25
|
4
|
|
|
4
|
|
1577
|
use Types::Standard qw( ArrayRef Bool Str ); |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
23
|
|
26
|
|
|
|
|
|
|
has 'step_paths' => ( is => 'rw', isa => ArrayRef, default => sub { [] } ); |
27
|
|
|
|
|
|
|
has 'extensions' => ( is => 'rw', isa => ArrayRef, default => sub { [] } ); |
28
|
|
|
|
|
|
|
has 'tags' => ( is => 'rw', isa => Str, required => 0 ); |
29
|
|
|
|
|
|
|
has 'match_only' => ( is => 'rw', isa => Bool, default => 0 ); |
30
|
|
|
|
|
|
|
has 'matching' => ( is => 'rw', isa => Str, default => 'first'); |
31
|
|
|
|
|
|
|
has 'strict' => ( is => 'rw', isa => Bool, default => 0 ); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
has 'harness' => ( is => 'rw' ); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 NAME |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
App::pherkin - Run Cucumber tests from the command line |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 VERSION |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
version 0.85 |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 SYNOPSIS |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
pherkin |
46
|
|
|
|
|
|
|
pherkin some/path/features/ |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DESCRIPTION |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
C will search the directory specified (or C<./features/>) for |
51
|
|
|
|
|
|
|
feature files (any file matching C<*.feature>) and step definition files (any |
52
|
|
|
|
|
|
|
file matching C<*_steps.pl>), loading the step definitions and then executing |
53
|
|
|
|
|
|
|
the features. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Steps that pass will be printed in green, those that fail in red, and those |
56
|
|
|
|
|
|
|
for which there is no step definition as yellow (for TODO), assuming you're |
57
|
|
|
|
|
|
|
using the default output harness. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 METHODS |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head2 run |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
The C class, which is what the C command uses, makes |
64
|
|
|
|
|
|
|
use of the C method, which accepts currently a single path as a string, |
65
|
|
|
|
|
|
|
or nothing. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Returns a L object for all steps run. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=cut |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub _pre_run { |
72
|
1
|
|
|
1
|
|
3
|
my ( $self, @arguments ) = @_; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# localized features will have utf8 in them and options may output utf8 as |
75
|
|
|
|
|
|
|
# well |
76
|
1
|
|
|
|
|
6
|
binmode STDOUT, ':utf8'; |
77
|
|
|
|
|
|
|
|
78
|
1
|
|
|
|
|
4
|
my ($features_path) = $self->_process_arguments(@arguments); |
79
|
1
|
|
50
|
|
|
4
|
$features_path ||= './features/'; |
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
|
|
8
|
my ( $executor, @features ) = |
82
|
|
|
|
|
|
|
Test::BDD::Cucumber::Loader->load( $features_path ); |
83
|
1
|
50
|
|
|
|
4
|
die "No feature files found in $features_path" unless @features; |
84
|
|
|
|
|
|
|
|
85
|
1
|
|
|
|
|
25
|
$executor->matching( $self->matching ); |
86
|
1
|
|
|
|
|
57
|
$executor->add_extensions($_) for @{ $self->extensions }; |
|
1
|
|
|
|
|
18
|
|
87
|
1
|
|
|
|
|
90
|
$_->pre_execute($self) for @{ $self->extensions }; |
|
1
|
|
|
|
|
18
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Test::BDD::Cucumber::Loader->load_steps( $executor, $_ ) |
90
|
1
|
|
|
|
|
3
|
for @{ $self->step_paths }; |
|
1
|
|
|
|
|
17
|
|
91
|
|
|
|
|
|
|
|
92
|
1
|
|
|
|
|
11
|
return ( $executor, @features ); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub _post_run { |
96
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
97
|
|
|
|
|
|
|
|
98
|
1
|
|
|
|
|
2
|
$_->post_execute() for reverse @{ $self->extensions }; |
|
1
|
|
|
|
|
18
|
|
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub run { |
103
|
1
|
|
|
1
|
1
|
4984
|
my ( $self, @arguments ) = @_; |
104
|
1
|
|
|
|
|
4
|
my ( $executor, @features ) = $self->_pre_run(@arguments); |
105
|
|
|
|
|
|
|
|
106
|
1
|
50
|
|
|
|
19
|
if ( $self->match_only ) { |
107
|
1
|
50
|
|
|
|
21
|
$self->_make_executor_match_only($executor) if $self->match_only; |
108
|
1
|
|
|
|
|
5
|
$self->_rename_feature_steps( @features ); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
1
|
|
|
|
|
46
|
my $result = $self->_run_tests( $executor, @features ); |
112
|
1
|
|
|
|
|
6
|
$self->_post_run; |
113
|
1
|
|
|
|
|
35
|
return $result; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub _run_tests { |
117
|
1
|
|
|
1
|
|
4
|
my ( $self, $executor, @features ) = @_; |
118
|
|
|
|
|
|
|
|
119
|
1
|
|
|
|
|
3
|
my $harness = $self->harness; |
120
|
1
|
|
|
|
|
9
|
$harness->startup(); |
121
|
|
|
|
|
|
|
|
122
|
1
|
|
|
|
|
2
|
my $tag_spec; |
123
|
1
|
50
|
|
|
|
19
|
if ( $self->tags ) { |
124
|
0
|
|
|
|
|
0
|
$tag_spec = Cucumber::TagExpressions->parse( $self->tags ); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
1
|
|
|
|
|
27
|
$executor->execute( $_, $harness, $tag_spec ) for @features; |
128
|
|
|
|
|
|
|
|
129
|
1
|
|
|
|
|
4
|
$harness->shutdown(); |
130
|
|
|
|
|
|
|
|
131
|
1
|
|
|
|
|
32
|
my $exit_code = 0; |
132
|
1
|
|
|
|
|
15
|
my $result = $harness->result->result; |
133
|
1
|
50
|
|
|
|
111
|
if ($result eq 'failing') { |
|
|
50
|
|
|
|
|
|
134
|
0
|
|
|
|
|
0
|
$exit_code = 2; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
elsif ($self->strict) { |
137
|
0
|
0
|
0
|
|
|
0
|
if ($result eq 'pending' |
138
|
|
|
|
|
|
|
or $result eq 'undefined') { |
139
|
0
|
|
|
|
|
0
|
$exit_code = 1; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
1
|
|
|
|
|
14
|
return $exit_code; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _initialize_harness { |
147
|
12
|
|
|
12
|
|
243
|
my ( $self, $harness_module ) = @_; |
148
|
|
|
|
|
|
|
|
149
|
12
|
|
|
|
|
25
|
my $harness_args_string = undef; |
150
|
12
|
|
|
|
|
36
|
( $harness_module, $harness_args_string ) = split /\(/, $harness_module, 2; |
151
|
|
|
|
|
|
|
|
152
|
12
|
100
|
|
|
|
52
|
unless ( $harness_module =~ m/::/ ) { |
153
|
8
|
|
|
|
|
26
|
$harness_module = "Test::BDD::Cucumber::Harness::" . $harness_module; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
12
|
50
|
|
|
|
20
|
eval { use_module($harness_module) } |
|
12
|
|
|
|
|
43
|
|
157
|
|
|
|
|
|
|
|| die "Unable to load harness [$harness_module]: $@"; |
158
|
|
|
|
|
|
|
|
159
|
12
|
100
|
|
|
|
309
|
if ( $harness_args_string ) { |
160
|
1
|
|
|
|
|
3
|
my %harness_args; |
161
|
1
|
50
|
|
|
|
55
|
eval "%harness_args = ($harness_args_string; 1" |
162
|
|
|
|
|
|
|
or die $@; |
163
|
1
|
|
|
|
|
22
|
$self->harness( $harness_module->new( %harness_args ) ); |
164
|
|
|
|
|
|
|
} else { |
165
|
11
|
|
|
|
|
131
|
$self->harness( $harness_module->new() ); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub _find_config_file { |
171
|
18
|
|
|
18
|
|
182
|
my ( $self, $config_filename, $debug ) = @_; |
172
|
|
|
|
|
|
|
|
173
|
18
|
100
|
|
|
|
65
|
return $config_filename if $config_filename; |
174
|
|
|
|
|
|
|
|
175
|
8
|
|
100
|
|
|
47
|
for ( |
176
|
|
|
|
|
|
|
( $ENV{'PHERKIN_CONFIG'} || () ), |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# Allow .yaml or .yml for all of the below |
179
|
40
|
|
|
|
|
2160
|
map { ( "$_.yaml", "$_.yml" ) } ( |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# Relative locations |
182
|
32
|
|
|
|
|
2019
|
( map { file($_) } |
183
|
|
|
|
|
|
|
qw!.pherkin config/pherkin ./.config/pherkin t/.pherkin! |
184
|
|
|
|
|
|
|
), |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Home locations |
187
|
8
|
|
|
|
|
26
|
( map { dir($_)->file('.pherkin') } |
188
|
16
|
|
|
|
|
30
|
grep {$_} map { $ENV{$_} } qw/HOME USERPROFILE/ |
|
16
|
|
|
|
|
574
|
|
189
|
|
|
|
|
|
|
) |
190
|
|
|
|
|
|
|
) |
191
|
|
|
|
|
|
|
) |
192
|
|
|
|
|
|
|
{ |
193
|
71
|
100
|
|
|
|
1006
|
return $_ if -f $_; |
194
|
70
|
50
|
|
|
|
194
|
print "No config file found in $_\n" if $debug; |
195
|
|
|
|
|
|
|
} |
196
|
7
|
|
|
|
|
83
|
return undef; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub _replace_helper { |
200
|
3
|
|
|
3
|
|
8
|
my $inval = shift; |
201
|
|
|
|
|
|
|
|
202
|
3
|
|
66
|
|
|
20
|
return $ENV{$inval} // "Environment variable $inval not defined"; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub _resolve_envvars { |
206
|
170
|
|
|
170
|
|
293
|
my ( $config_data ) = shift; |
207
|
|
|
|
|
|
|
|
208
|
170
|
100
|
|
|
|
272
|
if (ref $config_data) { |
209
|
92
|
100
|
|
|
|
171
|
if (ref $config_data eq 'HASH') { |
|
|
50
|
|
|
|
|
|
210
|
|
|
|
|
|
|
return { |
211
|
|
|
|
|
|
|
map { |
212
|
66
|
|
|
|
|
173
|
$_ => _resolve_envvars( $config_data->{$_} ) |
|
123
|
|
|
|
|
236
|
|
213
|
|
|
|
|
|
|
} keys %$config_data |
214
|
|
|
|
|
|
|
}; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
elsif (ref $config_data eq 'ARRAY') { |
217
|
26
|
|
|
|
|
44
|
return [ map { _resolve_envvars( $_ ) } @$config_data ]; |
|
39
|
|
|
|
|
60
|
|
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
else { |
220
|
0
|
|
|
|
|
0
|
die 'Unhandled reference type in configuration data'; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
else { |
224
|
|
|
|
|
|
|
# replace (in-place) ${ENVVAR_NAME} sequences with the envvar value |
225
|
78
|
|
|
|
|
124
|
$config_data =~ s/(?
|
|
3
|
|
|
|
|
8
|
|
226
|
|
|
|
|
|
|
# remove any escaping double dollar-signs |
227
|
78
|
|
|
|
|
134
|
$config_data =~ s/\$(\$\{[a-zA-Z0-9_]+\})/$1/g; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
78
|
|
|
|
|
317
|
return $config_data; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub _load_config { |
234
|
16
|
|
|
16
|
|
8054
|
my ( $self, $profile_name, $proposed_config_filename, $debug ) = @_; |
235
|
|
|
|
|
|
|
|
236
|
16
|
|
|
|
|
48
|
my $config_filename |
237
|
|
|
|
|
|
|
= $self->_find_config_file( $proposed_config_filename, $debug ); |
238
|
16
|
|
|
|
|
77
|
my $config_data_whole; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# Check we can actually load some data from that file if required |
241
|
16
|
100
|
|
|
|
40
|
if ($config_filename) { |
242
|
9
|
50
|
|
|
|
56
|
print "Found [$config_filename], reading...\n" if $debug; |
243
|
9
|
|
|
|
|
33
|
$config_data_whole = LoadFile($config_filename); |
244
|
8
|
50
|
|
|
|
90861
|
$config_data_whole = _resolve_envvars( $config_data_whole ) |
245
|
|
|
|
|
|
|
if $config_data_whole; |
246
|
|
|
|
|
|
|
} else { |
247
|
7
|
50
|
|
|
|
17
|
if ($profile_name) { |
248
|
0
|
0
|
|
|
|
0
|
print "No configuration files found\n" if $debug; |
249
|
0
|
|
|
|
|
0
|
die |
250
|
|
|
|
|
|
|
"Profile name [$profile_name] specified, but no configuration file found (use --debug-profiles to debug)"; |
251
|
|
|
|
|
|
|
} else { |
252
|
7
|
50
|
|
|
|
24
|
print "No configuration files found, and no profile specified\n" |
253
|
|
|
|
|
|
|
if $debug; |
254
|
7
|
|
|
|
|
27
|
return; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
8
|
100
|
|
|
|
60
|
$profile_name = 'default' unless defined $profile_name; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# Check the config file has the right type of data at the profile name |
261
|
8
|
100
|
|
|
|
35
|
unless ( ref $config_data_whole eq 'HASH' ) { |
262
|
1
|
|
|
|
|
6
|
die |
263
|
|
|
|
|
|
|
"Config file [$config_filename] doesn't return a hashref on parse, instead a [" |
264
|
|
|
|
|
|
|
. ref($config_data_whole) . ']'; |
265
|
|
|
|
|
|
|
} |
266
|
7
|
|
|
|
|
19
|
my $config_data = $config_data_whole->{$profile_name}; |
267
|
|
|
|
|
|
|
my $profile_problem = sub { |
268
|
3
|
|
|
3
|
|
16
|
return "Config file [$config_filename] profile [$profile_name]: " |
269
|
|
|
|
|
|
|
. shift(); |
270
|
7
|
|
|
|
|
37
|
}; |
271
|
7
|
100
|
|
|
|
19
|
unless ($config_data) { |
272
|
1
|
|
|
|
|
8
|
die $profile_problem->("Profile not found"); |
273
|
|
|
|
|
|
|
} |
274
|
6
|
100
|
|
|
|
16
|
unless ( ( my $reftype = ref $config_data ) eq 'HASH' ) { |
275
|
1
|
|
|
|
|
4
|
die $profile_problem->("[$reftype] but needs to be a HASH"); |
276
|
|
|
|
|
|
|
} |
277
|
5
|
50
|
|
|
|
19
|
print "Using profile [$profile_name]\n" if $debug; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Transform it in to an argument list |
280
|
5
|
|
|
|
|
7
|
my @arguments; |
281
|
5
|
|
|
|
|
23
|
for my $key ( sort keys %$config_data ) { |
282
|
9
|
|
|
|
|
18
|
my $value = $config_data->{$key}; |
283
|
|
|
|
|
|
|
|
284
|
9
|
100
|
|
|
|
22
|
if ( my $reftype = ref $value ) { |
285
|
6
|
100
|
|
|
|
23
|
if ( $key ne 'extensions' ) { |
286
|
4
|
100
|
|
|
|
41
|
die $profile_problem->( |
287
|
|
|
|
|
|
|
"Option $key is a [$reftype] but can only be a single value or ARRAY" |
288
|
|
|
|
|
|
|
) unless $reftype eq 'ARRAY'; |
289
|
3
|
|
|
|
|
16
|
push( @arguments, $key, $_ ) for @$value; |
290
|
|
|
|
|
|
|
} else { |
291
|
2
|
50
|
33
|
|
|
18
|
die $profile_problem->( |
292
|
|
|
|
|
|
|
"Option $key is a [$reftype] but can only be a HASH as '$key' is" |
293
|
|
|
|
|
|
|
. " a special case - see the documentation for details" |
294
|
|
|
|
|
|
|
) unless $reftype eq 'HASH' && $key eq 'extensions'; |
295
|
2
|
|
|
|
|
9
|
push( @arguments, $key, $value ); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} else { |
298
|
3
|
|
|
|
|
7
|
push( @arguments, $key, $value ); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
4
|
50
|
|
|
|
11
|
if ($debug) { |
303
|
0
|
|
|
|
|
0
|
print "Arguments to add: " . ( join ' ', @arguments ) . "\n"; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
4
|
|
|
|
|
81
|
return @arguments; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub _process_arguments { |
310
|
7
|
|
|
7
|
|
360
|
my ( $self, @args ) = @_; |
311
|
7
|
|
|
|
|
25
|
local @ARGV = @args; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# Allow -Ilib, -bl |
314
|
7
|
|
|
|
|
41
|
Getopt::Long::Configure( 'bundling', 'pass_through' ); |
315
|
|
|
|
|
|
|
|
316
|
7
|
|
|
|
|
420
|
my %options = ( |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# Relating to other configuration options |
319
|
|
|
|
|
|
|
config => ['g|config=s'], |
320
|
|
|
|
|
|
|
profile => ['p|profile=s'], |
321
|
|
|
|
|
|
|
debug_profiles => ['debug-profiles'], |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Standard |
324
|
|
|
|
|
|
|
help => [ 'h|help|?' ], |
325
|
|
|
|
|
|
|
version => [ 'version' ], |
326
|
|
|
|
|
|
|
includes => [ 'I=s@', [] ], |
327
|
|
|
|
|
|
|
lib => [ 'l|lib' ], |
328
|
|
|
|
|
|
|
blib => [ 'b|blib' ], |
329
|
|
|
|
|
|
|
output => [ 'o|output=s' ], |
330
|
|
|
|
|
|
|
strict => [ 'strict' ], |
331
|
|
|
|
|
|
|
steps => [ 's|steps=s@', [] ], |
332
|
|
|
|
|
|
|
tags => [ 't|tags=s' ], |
333
|
|
|
|
|
|
|
i18n => [ 'i18n=s' ], |
334
|
|
|
|
|
|
|
extensions => [ 'e|extension=s@', [] ], |
335
|
|
|
|
|
|
|
matching => [ 'matching=s' ], |
336
|
|
|
|
|
|
|
match_only => [ 'm|match' ], |
337
|
|
|
|
|
|
|
); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
GetOptions( |
340
|
|
|
|
|
|
|
map { |
341
|
7
|
|
|
|
|
32
|
my $x; |
|
112
|
|
|
|
|
131
|
|
342
|
112
|
100
|
|
|
|
229
|
$_->[1] = \$x unless defined $_->[1]; |
343
|
112
|
|
|
|
|
232
|
( $_->[0] => $_->[1] ); |
344
|
|
|
|
|
|
|
} values %options |
345
|
|
|
|
|
|
|
); |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
my $deref = sub { |
348
|
132
|
|
|
132
|
|
203
|
my $key = shift; |
349
|
132
|
|
|
|
|
211
|
my $value = $options{$key}->[1]; |
350
|
132
|
100
|
|
|
|
734
|
return ( ref $value eq 'ARRAY' ) ? $value : $$value; |
351
|
7
|
|
|
|
|
9936
|
}; |
352
|
|
|
|
|
|
|
|
353
|
7
|
50
|
|
|
|
23
|
if ( $deref->('version') ) { |
354
|
0
|
|
|
|
|
0
|
my ($vol, $dirs, $file) = File::Spec->splitpath( $0 ); |
355
|
0
|
|
0
|
|
|
0
|
my $version = $App::pherkin::VERSION || '(development)'; |
356
|
0
|
|
|
|
|
0
|
print "$file $version\n"; |
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
0
|
exit 0; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
pod2usage( |
362
|
7
|
50
|
|
|
|
21
|
-verbose => 1, |
363
|
|
|
|
|
|
|
-input => "$RealBin/$Script", |
364
|
|
|
|
|
|
|
) if $deref->('help'); |
365
|
|
|
|
|
|
|
|
366
|
7
|
|
|
|
|
14
|
my @parsed_extensions; |
367
|
7
|
|
|
|
|
11
|
for my $e ( @{ $deref->('extensions') } ) { |
|
7
|
|
|
|
|
19
|
|
368
|
2
|
|
|
|
|
5
|
my $e_args = "()"; |
369
|
2
|
50
|
|
|
|
21
|
$e_args = $1 if $e =~ s/\((.+)\)$//; |
370
|
2
|
|
|
|
|
116
|
my @e_args = eval $e_args; |
371
|
2
|
50
|
|
|
|
20
|
die "Bad arguments in [$e]: $@" if $@; |
372
|
|
|
|
|
|
|
|
373
|
2
|
|
|
|
|
12
|
push( @parsed_extensions, [ $e, \@e_args ] ); |
374
|
|
|
|
|
|
|
} |
375
|
7
|
|
|
|
|
33
|
$options{extensions}->[1] = \@parsed_extensions; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# Load the configuration file |
378
|
7
|
|
|
|
|
23
|
my @configuration_options = $self->_load_config( map { $deref->($_) } |
|
21
|
|
|
|
|
38
|
|
379
|
|
|
|
|
|
|
qw/profile config debug_profiles/ ); |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
# Merge those configuration items |
382
|
|
|
|
|
|
|
# First we need a list of matching keys |
383
|
|
|
|
|
|
|
my %keys = map { |
384
|
7
|
|
|
|
|
39
|
my ( $key_basis, $ref ) = @{ $options{$_} }; |
|
112
|
|
|
|
|
141
|
|
|
112
|
|
|
|
|
194
|
|
385
|
301
|
|
|
|
|
593
|
map { $_ => $ref } |
386
|
112
|
|
|
|
|
217
|
map { s/=.+//; $_ } ( split( /\|/, $key_basis ), $_ ); |
|
301
|
|
|
|
|
513
|
|
|
301
|
|
|
|
|
486
|
|
387
|
|
|
|
|
|
|
} keys %options; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# Now let's go through each option. For arrays, we want the configuration |
390
|
|
|
|
|
|
|
# options to appear in order at the front. So if configuration had 1, 2, |
391
|
|
|
|
|
|
|
# and command line options were 3, 4, we want: 1, 2, 3, 4. This is not |
392
|
|
|
|
|
|
|
# straight forward. |
393
|
7
|
|
|
|
|
49
|
my %additions; |
394
|
7
|
|
|
|
|
30
|
while (@configuration_options) { |
395
|
5
|
|
|
|
|
11
|
my ($key) = shift(@configuration_options); |
396
|
5
|
|
|
|
|
11
|
my ($value) = shift(@configuration_options); |
397
|
5
|
|
50
|
|
|
14
|
my $target = $keys{$key} || die "Unknown configuration option [$key]"; |
398
|
|
|
|
|
|
|
|
399
|
5
|
100
|
66
|
|
|
31
|
if ( $key eq 'extensions' || $key eq 'extension' ) { |
|
|
100
|
|
|
|
|
|
400
|
1
|
50
|
|
|
|
8
|
die "Value of $key in config file expected to be HASH but isn't" |
401
|
|
|
|
|
|
|
if ref $value ne 'HASH'; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# if the configuration of the extension is 'undef', then |
404
|
|
|
|
|
|
|
# none was defined. Replace it with an empty hashref, which |
405
|
|
|
|
|
|
|
# is what Moo's 'new()' method wants later on |
406
|
1
|
|
50
|
|
|
4
|
my @e = map { [ $_, [ $value->{$_} || {} ] ] } keys %$value; |
|
1
|
|
|
|
|
8
|
|
407
|
1
|
|
|
|
|
4
|
$value = \@e; |
408
|
1
|
|
50
|
|
|
8
|
my $array = $additions{ 0 + $target } ||= []; |
409
|
1
|
|
|
|
|
4
|
push( @$array, @$value ); |
410
|
1
|
50
|
|
|
|
4
|
print "Adding extensions near the front of $key" |
411
|
|
|
|
|
|
|
if $deref->('debug_profiles'); |
412
|
|
|
|
|
|
|
} elsif ( ref $target ne 'ARRAY' ) { |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# Only use it if we don't have something already |
415
|
2
|
100
|
|
|
|
18
|
if ( defined $$target ) { |
416
|
1
|
50
|
|
|
|
4
|
print |
417
|
|
|
|
|
|
|
"Ignoring $key from config file because set on cmd line as $$target\n" |
418
|
|
|
|
|
|
|
if $deref->('debug_profiles'); |
419
|
|
|
|
|
|
|
} else { |
420
|
1
|
|
|
|
|
6
|
$$target = $value; |
421
|
1
|
50
|
|
|
|
7
|
print "Set $key to $target from config file\n" |
422
|
|
|
|
|
|
|
if $deref->('debug_profiles'); |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
} else { |
426
|
2
|
|
100
|
|
|
15
|
my $array = $additions{ 0 + $target } ||= []; |
427
|
2
|
|
|
|
|
6
|
push( @$array, $value ); |
428
|
2
|
50
|
|
|
|
4
|
print "Adding $value near the front of $key\n" |
429
|
|
|
|
|
|
|
if $deref->('debug_profiles'); |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
7
|
|
|
|
|
33
|
for my $target ( values %options ) { |
433
|
112
|
100
|
|
|
|
221
|
next unless ref $target->[1] eq 'ARRAY'; |
434
|
21
|
|
|
|
|
56
|
my $key = $target->[1] + 0; |
435
|
21
|
100
|
|
|
|
28
|
unshift( @{ $target->[1] }, @{ $additions{$key} || [] } ); |
|
21
|
|
|
|
|
36
|
|
|
21
|
|
|
|
|
101
|
|
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
7
|
50
|
|
|
|
37
|
if ( $deref->('debug_profiles') ) { |
439
|
0
|
|
|
|
|
0
|
print "Values are:\n"; |
440
|
0
|
|
|
|
|
0
|
for ( sort keys %options ) { |
441
|
0
|
|
|
|
|
0
|
printf( " %16s: ", $_ ); |
442
|
0
|
|
|
|
|
0
|
my $value = $deref->($_); |
443
|
0
|
0
|
|
|
|
0
|
if ( ref $value ) { |
444
|
0
|
|
|
|
|
0
|
print join ', ', @$value; |
445
|
|
|
|
|
|
|
} else { |
446
|
0
|
0
|
|
|
|
0
|
print( ( defined $value ) ? $value : '[undefined]' ); |
447
|
|
|
|
|
|
|
} |
448
|
0
|
|
|
|
|
0
|
print "\n"; |
449
|
|
|
|
|
|
|
} |
450
|
0
|
|
|
|
|
0
|
exit; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
7
|
50
|
|
|
|
19
|
if ( my $i18n = $deref->('i18n') ) { |
454
|
0
|
0
|
|
|
|
0
|
_print_langdef($i18n) unless $i18n eq 'help'; |
455
|
0
|
|
|
|
|
0
|
_print_languages(); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
7
|
100
|
|
|
|
21
|
unshift @{ $deref->('includes') }, 'lib' if $deref->('lib'); |
|
3
|
|
|
|
|
6
|
|
459
|
7
|
100
|
|
|
|
15
|
unshift @{ $deref->('includes') }, 'blib/lib', 'blib/arch' |
|
2
|
|
|
|
|
7
|
|
460
|
|
|
|
|
|
|
if $deref->('blib'); |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# We may need some of the imported paths... |
463
|
7
|
|
|
|
|
22
|
lib->import( @{ $deref->('includes') } ); |
|
7
|
|
|
|
|
20
|
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Load any extensions |
466
|
7
|
|
|
|
|
818
|
for my $e ( @{ $deref->('extensions') } ) { |
|
7
|
|
|
|
|
16
|
|
467
|
3
|
|
|
|
|
12
|
my ( $c, $a ) = @$e; |
468
|
3
|
|
|
|
|
13
|
use_module $c; |
469
|
|
|
|
|
|
|
|
470
|
3
|
|
|
|
|
3100
|
my $instance = $c->new(@$a); |
471
|
3
|
|
|
|
|
2163
|
push( @{ $self->extensions }, $instance ); |
|
3
|
|
|
|
|
94
|
|
472
|
|
|
|
|
|
|
|
473
|
3
|
|
|
|
|
33
|
my $dir = file( $INC{ module_notional_filename($c) } )->dir; |
474
|
3
|
|
|
|
|
46
|
my @step_dirs = map { File::Spec->rel2abs( $_, $dir ) } |
475
|
3
|
|
|
|
|
354
|
@{ $instance->step_directories }; |
|
3
|
|
|
|
|
9
|
|
476
|
3
|
|
|
|
|
288
|
unshift( @{ $deref->('steps') }, @step_dirs ); |
|
3
|
|
|
|
|
9
|
|
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
# Munge the output harness |
480
|
7
|
|
50
|
|
|
20
|
$self->_initialize_harness( $deref->('output') || "TermColor" ); |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# Store any extra step paths |
483
|
7
|
|
|
|
|
196
|
$self->step_paths( $deref->('steps') ); |
484
|
|
|
|
|
|
|
|
485
|
7
|
50
|
|
|
|
193
|
$self->matching( $deref->('matching') ) |
486
|
|
|
|
|
|
|
if $deref->('matching'); |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# Match only? |
489
|
7
|
|
|
|
|
21
|
$self->match_only( $deref->('match_only') ); |
490
|
|
|
|
|
|
|
|
491
|
7
|
50
|
|
|
|
196
|
$self->strict( $deref->('strict') ) |
492
|
|
|
|
|
|
|
if $deref->('strict'); |
493
|
|
|
|
|
|
|
|
494
|
7
|
|
|
|
|
120
|
return ( pop @ARGV ); |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub _print_languages { |
498
|
|
|
|
|
|
|
|
499
|
0
|
|
|
0
|
|
0
|
my @languages = languages(); |
500
|
|
|
|
|
|
|
|
501
|
0
|
|
|
|
|
0
|
my $max_code_length = max map {length} @languages; |
|
0
|
|
|
|
|
0
|
|
502
|
|
|
|
|
|
|
my $max_name_length |
503
|
0
|
|
|
|
|
0
|
= max map { length( langdef($_)->{name} ) } @languages; |
|
0
|
|
|
|
|
0
|
|
504
|
|
|
|
|
|
|
my $max_native_length |
505
|
0
|
|
|
|
|
0
|
= max map { length( langdef($_)->{native} ) } @languages; |
|
0
|
|
|
|
|
0
|
|
506
|
|
|
|
|
|
|
|
507
|
0
|
|
|
|
|
0
|
my $format |
508
|
|
|
|
|
|
|
= "| %-${max_code_length}s | %-${max_name_length}s | %-${max_native_length}s |\n"; |
509
|
|
|
|
|
|
|
|
510
|
0
|
|
|
|
|
0
|
for my $language ( sort @languages ) { |
511
|
0
|
|
|
|
|
0
|
my $langdef = langdef($language); |
512
|
0
|
|
|
|
|
0
|
printf $format, $language, $langdef->{name}, $langdef->{native}; |
513
|
|
|
|
|
|
|
} |
514
|
0
|
|
|
|
|
0
|
exit; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub _print_langdef { |
518
|
0
|
|
|
0
|
|
0
|
my ($language) = @_; |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
0
|
my $langdef = langdef($language); |
521
|
|
|
|
|
|
|
|
522
|
0
|
|
|
|
|
0
|
my @keywords = qw(feature background scenario scenarioOutline examples |
523
|
|
|
|
|
|
|
given when then and but); |
524
|
|
|
|
|
|
|
my $max_length |
525
|
0
|
|
|
|
|
0
|
= max map { length readable_keywords( $langdef->{$_} ) } @keywords; |
|
0
|
|
|
|
|
0
|
|
526
|
|
|
|
|
|
|
|
527
|
0
|
|
|
|
|
0
|
my $format = "| %-16s | %-${max_length}s |\n"; |
528
|
0
|
|
|
|
|
0
|
for my $keyword ( |
529
|
|
|
|
|
|
|
qw(feature background scenario scenarioOutline |
530
|
|
|
|
|
|
|
examples given when then and but ) |
531
|
|
|
|
|
|
|
) |
532
|
|
|
|
|
|
|
{ |
533
|
0
|
|
|
|
|
0
|
printf $format, $keyword, readable_keywords( $langdef->{$keyword} ); |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
0
|
|
|
|
|
0
|
my $codeformat = "| %-16s | %-${max_length}s |\n"; |
537
|
0
|
|
|
|
|
0
|
for my $keyword (qw(given when then )) { |
538
|
|
|
|
|
|
|
printf $codeformat, $keyword . ' (code)', |
539
|
0
|
|
|
|
|
0
|
readable_keywords( $langdef->{$keyword}, \&keyword_to_subname ); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
0
|
|
|
|
|
0
|
exit; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
sub _make_executor_match_only { |
546
|
1
|
|
|
1
|
|
12
|
my ($self, $executor) = @_; |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
my $match_sub = sub { |
549
|
3
|
|
|
3
|
|
5
|
my $context = shift; |
550
|
3
|
|
|
|
|
104
|
$Test::Builder::Test->ok( 1, "Test matched" ); |
551
|
3
|
|
|
|
|
1170
|
return 1; |
552
|
1
|
|
|
|
|
4
|
}; |
553
|
|
|
|
|
|
|
|
554
|
1
|
|
|
|
|
2
|
for my $verb ( keys %{$executor->steps} ) { |
|
1
|
|
|
|
|
19
|
|
555
|
3
|
|
|
|
|
14
|
for my $step_tuple ( @{ $executor->steps->{$verb} } ) { |
|
3
|
|
|
|
|
47
|
|
556
|
3
|
|
|
|
|
23
|
$step_tuple->[2] = $match_sub; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
|
560
|
1
|
|
|
|
|
3
|
return 1; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub _rename_feature_steps { |
564
|
1
|
|
|
1
|
|
3
|
my ($self, @features) = @_; |
565
|
|
|
|
|
|
|
|
566
|
1
|
|
|
|
|
2
|
my %steps; |
567
|
1
|
|
|
|
|
2
|
for my $feature ( @features ) { |
568
|
1
|
|
|
|
|
21
|
for my $scenario ( $feature->background, @{ $feature->scenarios } ) { |
|
1
|
|
|
|
|
22
|
|
569
|
2
|
100
|
|
|
|
10
|
next unless $scenario; |
570
|
1
|
|
|
|
|
3
|
for my $step ( @{ $scenario->steps } ) { |
|
1
|
|
|
|
|
16
|
|
571
|
3
|
|
|
|
|
15
|
$steps{ $step . '' } = $step; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
1
|
|
|
|
|
3
|
for my $step_object ( values %steps ) { |
577
|
3
|
|
33
|
|
|
146
|
$step_object->verb_original( |
578
|
|
|
|
|
|
|
'MATCH MODE: ' . ( $step_object->verb_original || $step_object->verb ) |
579
|
|
|
|
|
|
|
); |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head1 AUTHOR |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Peter Sergeant C |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=head1 LICENSE |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
Copyright 2019-2023, Erik Huelsmann |
590
|
|
|
|
|
|
|
Copyright 2011-2019, Peter Sergeant; Licensed under the same terms as Perl |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=cut |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
1; |