File: StepFile.pm

package info (click to toggle)
libtest-bdd-cucumber-perl 0.75-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 680 kB
  • sloc: perl: 7,905; makefile: 8; sh: 5
file content (200 lines) | stat: -rw-r--r-- 4,882 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
package Test::BDD::Cucumber::StepFile;
$Test::BDD::Cucumber::StepFile::VERSION = '0.75';
=head1 NAME

Test::BDD::Cucumber::StepFile - Functions for creating and loading Step Definitions

=head1 VERSION

version 0.75

=cut

use strict;
use warnings;
use utf8;

use Carp qw/croak/;
use File::Spec qw/rel2abs/;
use Scalar::Util qw/reftype/;

use Test::BDD::Cucumber::I18n qw(languages langdef keyword_to_subname);

require Exporter;
our @ISA    = qw(Exporter);
our @EXPORT = qw(Step Transform Before After C S);

our @definitions;

=head1 DESCRIPTION

Provides the Given/When/Then functions, and a method for loading Step Definition
files and returning the steps.

=head1 SYNOPSIS

Defining steps:

 #!perl

 use strict; use warnings; use Test::More;
 # or: use strict; use warnings; use Test2::V0;

 use Test::BDD::Cucumber::StepFile;

 Given     'something',          sub { print "YEAH!" }
 When      qr/smooooth (\d+)/,   sub { print "YEEEHAH $1" }
 Then      qr/something (else)/, sub { S->{'match'} = $1 }
 Step      qr/die now/,          sub { die "now" }
 Transform qr/^(\d+)$/,          sub { int $1 }
 Before                          sub { setup_db() }
 After                           sub { teardown() }

Loading steps, in a different file:

 use Test::BDD::Cucumber::StepFile;
 my @steps = Test::BDD::Cucumber::StepFile->load('filename_steps.pl');

=head1 EXPORTED FUNCTIONS

=head2 Given

=head2 When

=head2 Then

=head2 Step

=head2 Transform

=head2 Before

=head2 After

Accept a regular expression or string, and a coderef. Some cute tricks ensure
that when you call the C<load()> method on a file with these statements in,
these are returned to it...

=cut

sub _ensure_meta {
    my ($p, $f, $l) = caller(1);
    if (ref $_[1] and reftype $_[1] eq 'HASH') {
        $_[1]->{source} = $f;
        $_[1]->{line} = $l;
        return @_;
    }
    else {
        return ($_[0], { source => $f, line => $l }, $_[1]);
    }
}

# Mapped to Given, When, and Then as part of the i18n mapping below
sub _Given { push( @definitions, [ Given => _ensure_meta(@_) ] ) }
sub _When  { push( @definitions, [ When  => _ensure_meta(@_) ] ) }
sub _Then  { push( @definitions, [ Then  => _ensure_meta(@_) ] ) }

sub Step { push( @definitions, [ Step => _ensure_meta(@_) ] ) }

sub Transform { push( @definitions, [ Transform => _ensure_meta(@_) ] ) }
sub Before    { push( @definitions, [ Before    => _ensure_meta(qr//, @_) ] ) }
sub After     { push( @definitions, [ After     => _ensure_meta(qr//, @_) ] ) }

my @SUBS;

for my $language ( languages() ) {
    my $langdef = langdef($language);

    _alias_function( $langdef->{given}, \&_Given );
    _alias_function( $langdef->{when},  \&_When );
    _alias_function( $langdef->{then},  \&_Then );

    # Hm ... in cucumber, all step defining keywords are the same.
    # Here, the parser replaces 'and' and 'but' with the last verb. Tricky ...
    #    _alias_function( $langdef->{and}, \&And);
    #    _alias_function( $langdef->{but}, \&But);
}

push @EXPORT, @SUBS;

sub _alias_function {
    my ( $keywords, $f ) = @_;

    my @keywords = split( '\|', $keywords );
    for my $word (@keywords) {

        # asterisks won't be aliased to any sub
        next if $word eq '*';

        my $subname = keyword_to_subname($word);
        next unless length $subname;

        {
            no strict 'refs';
            no warnings 'redefine';
            no warnings 'once';

            *$subname = $f;
            push @SUBS, $subname;
        }
    }
}

=head2 C

=head2 S

Return the context and the Scenario stash, respectively, B<but only when called
inside a step definition>.

=cut

# We need an extra level of indirection when we want to support step functions
# loaded into their own packages (which we do, for cleanliness); the exporter
# binds the subs declared below to S and C symbols in the imported-into package
# That prevents us from binding a different function to these symbols at
# execution time.
# We *can* bind the _S and _C functions declared below.
sub S { _S() }
sub C { _C() }

sub _S { croak "You can only call `S` inside a step definition" }
sub _C { croak "You can only call `C` inside a step definition" }

=head2 load

Loads a file containing step definitions, and returns a list of the steps
defined in it, of the form:

 (
  [ 'Given', qr/abc/, sub { etc } ],
  [ 'Step',  'asdf',  sub { etc } ]
 )

=cut

sub load {
    my ( $class, $filename ) = @_;
    {
        local @definitions;

        # Debian Jessie with security patches requires an absolute path
        do File::Spec->rel2abs($filename);
        die "Step file [$filename] failed to load: $@" if $@;
        return @definitions;
    }

}

=head1 AUTHOR

Peter Sergeant C<pete@clueball.com>

=head1 LICENSE

  Copyright 2019-2020, Erik Huelsmann
  Copyright 2011-2019, Peter Sergeant; Licensed under the same terms as Perl

=cut

1;