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 12     12   186 use v5.14;
  12         56  
2 12     12   81 use warnings;
  12         33  
  12         528  
3              
4             package Test::BDD::Cucumber::StepFile 0.85;
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.85
13              
14             =cut
15              
16 12     12   82 use utf8;
  12         29  
  12         91  
17              
18 12     12   349 use Carp qw/croak/;
  12         27  
  12         621  
19 12     12   84 use File::Spec;
  12         40  
  12         417  
20 12     12   86 use Scalar::Util qw/reftype/;
  12         68  
  12         687  
21              
22 12     12   1335 use Test::BDD::Cucumber::I18n qw(languages langdef keyword_to_subname);
  12         29  
  12         8258  
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 79     79   449 my ($p, $f, $l) = caller(1);
83 79 100 66     436 if (ref $_[1] and reftype $_[1] eq 'HASH') {
84 1         4 $_[1]->{source} = $f;
85 1         2 $_[1]->{line} = $l;
86 1         9 return @_;
87             }
88             else {
89 78         471 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 29     29   14777 sub _Given { push( @definitions, [ Given => _ensure_meta(@_) ] ) }
95 24     24   149 sub _When { push( @definitions, [ When => _ensure_meta(@_) ] ) }
96 18     18   126 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 12 sub Transform { push( @definitions, [ Transform => _ensure_meta(@_) ] ) }
101 2     2 1 17 sub Before { push( @definitions, [ Before => _ensure_meta(qr//, @_) ] ) }
102 2     2 1 9 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 2772     2772   5385 my ( $keywords, $f ) = @_;
123              
124 2772         6852 my @keywords = split( '\|', $keywords );
125 2772         4666 for my $word (@keywords) {
126              
127             # asterisks won't be aliased to any sub
128 4716 50       8401 next if $word eq '*';
129              
130 4716         8649 my $subname = keyword_to_subname($word);
131 4716 100       9565 next unless length $subname;
132              
133             {
134 12     12   114 no strict 'refs';
  12         68  
  12         484  
  4680         6055  
135 12     12   118 no warnings 'redefine';
  12         27  
  12         515  
136 12     12   81 no warnings 'once';
  12         43  
  12         3406  
137              
138 4680         18070 *$subname = $f;
139 4680         12212 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 15000 sub S { _S() }
160 265     265 1 783 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 13     13 1 18347 my ( $class, $filename ) = @_;
179             {
180 13         34 local @definitions;
  13         36  
181              
182             # Debian Jessie with security patches requires an absolute path
183 13         5417 do File::Spec->rel2abs($filename);
184 13 50       76 die "Step file [$filename] failed to load: $@" if $@;
185 13         109 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;