File Coverage

blib/lib/Test/BDD/Cucumber/StepFile.pm
Criterion Covered Total %
statement 58 61 95.0
branch 6 8 75.0
condition 2 3 66.6
subroutine 21 24 87.5
pod 7 7 100.0
total 94 103 91.2


line stmt bran cond sub pod time code
1 13     13   561 use v5.14;
  13         49  
2 13     13   77 use warnings;
  13         27  
  13         579  
3              
4             package Test::BDD::Cucumber::StepFile 0.86;
5              
6             =head1 NAME
7              
8             Test::BDD::Cucumber::StepFile - Functions for creating and loading Step Definitions
9              
10             =head1 VERSION
11              
12             version 0.86
13              
14             =cut
15              
16 13     13   80 use utf8;
  13         35  
  13         144  
17              
18 13     13   369 use Carp qw/croak/;
  13         27  
  13         626  
19 13     13   82 use File::Spec;
  13         43  
  13         435  
20 13     13   98 use Scalar::Util qw/reftype/;
  13         53  
  13         741  
21              
22 13     13   1243 use Test::BDD::Cucumber::I18n qw(languages langdef keyword_to_subname);
  13         30  
  13         8693  
23              
24             require Exporter;
25             our @ISA = qw(Exporter);
26             our @EXPORT = qw(Step Transform Before After C S);
27              
28             our @definitions;
29              
30             =head1 DESCRIPTION
31              
32             Provides the Given/When/Then functions, and a method for loading Step Definition
33             files and returning the steps.
34              
35             =head1 SYNOPSIS
36              
37             Defining steps:
38              
39             #!perl
40              
41             use strict; use warnings; use Test::More;
42             # or: use strict; use warnings; use Test2::V0;
43              
44             use Test::BDD::Cucumber::StepFile;
45              
46             Given 'something', sub { print "YEAH!" }
47             When qr/smooooth (\d+)/, sub { print "YEEEHAH $1" }
48             Then qr/something (else)/, sub { S->{'match'} = $1 }
49             Step qr/die now/, sub { die "now" }
50             Transform qr/^(\d+)$/, sub { int $1 }
51             Before sub { setup_db() }
52             After sub { teardown() }
53              
54             Loading steps, in a different file:
55              
56             use Test::BDD::Cucumber::StepFile;
57             my @steps = Test::BDD::Cucumber::StepFile->load('filename_steps.pl');
58              
59             =head1 EXPORTED FUNCTIONS
60              
61             =head2 Given
62              
63             =head2 When
64              
65             =head2 Then
66              
67             =head2 Step
68              
69             =head2 Transform
70              
71             =head2 Before
72              
73             =head2 After
74              
75             Accept a regular expression or string, and a coderef. Some cute tricks ensure
76             that when you call the C method on a file with these statements in,
77             these are returned to it...
78              
79             =cut
80              
81             sub _ensure_meta {
82 83     83   500 my ($p, $f, $l) = caller(1);
83 83 100 66     487 if (ref $_[1] and reftype $_[1] eq 'HASH') {
84 1         4 $_[1]->{source} = $f;
85 1         4 $_[1]->{line} = $l;
86 1         10 return @_;
87             }
88             else {
89 82         547 return ($_[0], { source => $f, line => $l }, $_[1]);
90             }
91             }
92              
93             # Mapped to Given, When, and Then as part of the i18n mapping below
94 33     33   20107 sub _Given { push( @definitions, [ Given => _ensure_meta(@_) ] ) }
95 24     24   120 sub _When { push( @definitions, [ When => _ensure_meta(@_) ] ) }
96 18     18   125 sub _Then { push( @definitions, [ Then => _ensure_meta(@_) ] ) }
97              
98 0     0 1 0 sub Step { push( @definitions, [ Step => _ensure_meta(@_) ] ) }
99              
100 4     4 1 11 sub Transform { push( @definitions, [ Transform => _ensure_meta(@_) ] ) }
101 2     2 1 16 sub Before { push( @definitions, [ Before => _ensure_meta(qr//, @_) ] ) }
102 2     2 1 10 sub After { push( @definitions, [ After => _ensure_meta(qr//, @_) ] ) }
103              
104             my @SUBS;
105              
106             for my $language ( languages() ) {
107             my $langdef = langdef($language);
108              
109             _alias_function( $langdef->{given}, \&_Given );
110             _alias_function( $langdef->{when}, \&_When );
111             _alias_function( $langdef->{then}, \&_Then );
112              
113             # Hm ... in cucumber, all step defining keywords are the same.
114             # Here, the parser replaces 'and' and 'but' with the last verb. Tricky ...
115             # _alias_function( $langdef->{and}, \&And);
116             # _alias_function( $langdef->{but}, \&But);
117             }
118              
119             push @EXPORT, @SUBS;
120              
121             sub _alias_function {
122 3003     3003   5529 my ( $keywords, $f ) = @_;
123              
124 3003         7429 my @keywords = split( '\|', $keywords );
125 3003         4938 for my $word (@keywords) {
126              
127             # asterisks won't be aliased to any sub
128 5109 50       9394 next if $word eq '*';
129              
130 5109         9449 my $subname = keyword_to_subname($word);
131 5109 100       10492 next unless length $subname;
132              
133             {
134 13     13   128 no strict 'refs';
  13         39  
  13         517  
  5070         6542  
135 13     13   88 no warnings 'redefine';
  13         39  
  13         582  
136 13     13   82 no warnings 'once';
  13         27  
  13         3673  
137              
138 5070         18455 *$subname = $f;
139 5070         13494 push @SUBS, $subname;
140             }
141             }
142             }
143              
144             =head2 C
145              
146             =head2 S
147              
148             Return the context and the Scenario stash, respectively, B
149             inside a step definition>.
150              
151             =cut
152              
153             # We need an extra level of indirection when we want to support step functions
154             # loaded into their own packages (which we do, for cleanliness); the exporter
155             # binds the subs declared below to S and C symbols in the imported-into package
156             # That prevents us from binding a different function to these symbols at
157             # execution time.
158             # We *can* bind the _S and _C functions declared below.
159 702     702 1 14539 sub S { _S() }
160 265     265 1 775 sub C { _C() }
161              
162 0     0   0 sub _S { croak "You can only call `S` inside a step definition" }
163 0     0   0 sub _C { croak "You can only call `C` inside a step definition" }
164              
165             =head2 load
166              
167             Loads a file containing step definitions, and returns a list of the steps
168             defined in it, of the form:
169              
170             (
171             [ 'Given', qr/abc/, sub { etc } ],
172             [ 'Step', 'asdf', sub { etc } ]
173             )
174              
175             =cut
176              
177             sub load {
178 17     17 1 23726 my ( $class, $filename ) = @_;
179             {
180 17         42 local @definitions;
  17         52  
181              
182             # Debian Jessie with security patches requires an absolute path
183 17         5979 do File::Spec->rel2abs($filename);
184 17 50       74 die "Step file [$filename] failed to load: $@" if $@;
185 17         127 return @definitions;
186             }
187              
188             }
189              
190             =head1 AUTHOR
191              
192             Peter Sergeant C
193              
194             =head1 LICENSE
195              
196             Copyright 2019-2023, Erik Huelsmann
197             Copyright 2011-2019, Peter Sergeant; Licensed under the same terms as Perl
198              
199             =cut
200              
201             1;