File Coverage

blib/lib/Test/BDD/Cucumber/Parser.pm
Criterion Covered Total %
statement 228 236 96.6
branch 74 90 82.2
condition 35 51 68.6
subroutine 33 33 100.0
pod 2 2 100.0
total 372 412 90.2


line stmt bran cond sub pod time code
1 17     17   1348782 use v5.14;
  17         209  
2 17     17   102 use warnings;
  17         41  
  17         902  
3              
4             package Test::BDD::Cucumber::Parser 0.85;
5              
6             =head1 NAME
7              
8             Test::BDD::Cucumber::Parser - Parse Feature files
9              
10             =head1 VERSION
11              
12             version 0.85
13              
14             =head1 DESCRIPTION
15              
16             Parse Feature files in to a set of data classes
17              
18             =head1 SYNOPSIS
19              
20             # Returns a Test::BDD::Cucumber::Model::Feature object
21             my $feature = Test::BDD::Cucumber::Parser->parse_file(
22             't/data/features/basic_parse.feature' );
23              
24             =head1 METHODS
25              
26             =head2 parse_string
27              
28             =head2 parse_file
29              
30             Both methods accept a single string as their argument, and return a
31             L object on success.
32              
33             =cut
34              
35              
36 17     17   7324 use Test::BDD::Cucumber::Model::Dataset;
  17         71  
  17         689  
37 17     17   7759 use Test::BDD::Cucumber::Model::Document;
  17         208  
  17         648  
38 17     17   7977 use Test::BDD::Cucumber::Model::Feature;
  17         56  
  17         627  
39 17     17   7874 use Test::BDD::Cucumber::Model::Scenario;
  17         61  
  17         613  
40 17     17   7850 use Test::BDD::Cucumber::Model::Step;
  17         65  
  17         684  
41 17     17   7840 use Test::BDD::Cucumber::Model::TagSpec;
  17         59  
  17         619  
42 17     17   4829 use Test::BDD::Cucumber::I18n qw(langdef);
  17         177  
  17         1331  
43 17     17   4871 use Test::BDD::Cucumber::Errors qw/parse_error_from_line/;
  17         66  
  17         50364  
44              
45             # https://github.com/cucumber/cucumber/wiki/Multiline-Step-Arguments
46             # https://github.com/cucumber/cucumber/wiki/Scenario-outlines
47              
48             sub parse_string {
49 32     32 1 172998 my ( $class, $string ) = @_;
50              
51 32         782 return $class->_construct(
52             Test::BDD::Cucumber::Model::Document->new(
53             {
54             content => $string
55             }
56             )
57             );
58             }
59              
60             sub parse_file {
61 16     16 1 1871 my ( $class, $string ) = @_;
62 16         32 my $content;
63             {
64 16         39 local $/;
  16         76  
65 16 50       493 open(my $in, '<', $string) or die $?;
66 16         1578 binmode $in, 'utf8';
67 16         818 $content = <$in>;
68 16 50       356 close $in or warn $?;
69             }
70 16         190 return $class->_construct(
71             Test::BDD::Cucumber::Model::Document->new(
72             {
73             content => $content,
74             filename => '' . $string
75             })
76             );
77             }
78              
79             sub _construct {
80 48     48   923 my ( $class, $document ) = @_;
81              
82 48         904 my $feature =
83             Test::BDD::Cucumber::Model::Feature->new( { document => $document } );
84 48         1529 my @lines = $class->_remove_next_blanks( @{ $document->lines } );
  48         851  
85              
86 48         241 my $language = $class->_extract_language( \@lines );
87 48         1385 $feature->language( $language );
88              
89 48 50       2543 my $langdef = langdef( $feature->language )
90             or die "Declared language '$language' not available";
91              
92 48         195 my $self = bless {
93             langdef => $langdef,
94             _construct_matchers( $langdef )
95             }, $class;
96              
97 48         328 $self->_extract_scenarios(
98             $self->_extract_conditions_of_satisfaction(
99             $self->_extract_feature_name( $feature, @lines )
100             )
101             );
102              
103 47         831 return $feature;
104             }
105              
106             sub _construct_matchers {
107 48     48   136 my ($l) = @_;
108             my $step_line_kw_cont =
109 48         165 join('|', map { $l->{$_} } qw/given and when then but/);
  240         738  
110             my $step_line_kw_first =
111 48         149 join('|', map { $l->{$_} } qw/given when then/);
  144         373  
112             my $scenario_line_kw =
113 48         151 join('|', map { $l->{$_} } qw/background scenario scenarioOutline/);
  144         355  
114              
115             return (
116 48         4785 _step_line_first => qr/^($step_line_kw_first)(.+)/,
117             _step_line_cont => qr/^($step_line_kw_cont)(.+)/,
118             _feature_line => qr/^($l->{feature}): (.+)/,
119             _scenario_line => qr/^($scenario_line_kw): ?(.*)?/,
120             _examples_line => qr/^($l->{examples}): ?(.+)?$/,
121             _table_line => qr/^\s*\|/,
122             _tags_line => qr/\@([^\s]+)/,
123             );
124             }
125              
126             sub _is_step_line {
127 735     735   1533 my ($self, $continuation, $line) = @_;
128              
129 735 100       1509 if ($continuation) {
130 583         4620 return $line =~ $self->{_step_line_cont};
131             }
132             else {
133 152         1449 return $line =~ $self->{_step_line_first};
134             }
135             }
136              
137             sub _is_feature_line {
138 54     54   197 my ($self, $line) = @_;
139              
140 54         697 return $line =~ $self->{_feature_line};
141             }
142              
143             sub _is_scenario_line {
144 304     304   703 my ($self, $line) = @_;
145              
146 304         2648 return $line =~ $self->{_scenario_line};
147             }
148              
149             sub _is_table_line {
150 26     26   78 my ($self, $line) = @_;
151              
152 26         328 return $line =~ $self->{_table_line};
153             }
154              
155             sub _is_tags_line {
156 94     94   284 my ($self, $line) = @_;
157              
158 94         626 return $line =~ $self->{_tags_line};
159             }
160              
161             sub _is_examples_line {
162 191     191   453 my ($self, $line) = @_;
163              
164 191         1642 return $line =~ $self->{_examples_line};
165             }
166              
167             sub _extract_language {
168 48     48   141 my ( $self, $lines ) = @_;
169              
170             # return default language if we don't see the language directive on the first line
171 48 100 33     1092 return 'en'
      66        
172             unless ($lines and @$lines
173             and $lines->[0]->raw_content =~ m{^\s*#\s*language:\s+([^\s]+)});
174              
175             # remove the language directive if we saw it ...
176 4         62 shift @$lines;
177              
178             # ... and return the language it declared
179 4         14 return $1;
180             }
181              
182             sub _remove_next_blanks {
183 395     395   1672 my ( $self, @lines ) = @_;
184 395   100     1508 while ( $lines[0] && $lines[0]->is_blank ) {
185 94         353 shift(@lines);
186             }
187 395         2679 return @lines;
188             }
189              
190             sub _extract_feature_name {
191 48     48   273 my ( $self, $feature, @lines ) = @_;
192 48         135 my @feature_tags = ();
193              
194 48         207 while ( my $line = shift(@lines) ) {
195 60 100       230 next if $line->is_comment;
196 54 50       215 last if $line->is_blank;
197              
198 54 100       225 if ( my ($keyword, $name) =
    50          
199             $self->_is_feature_line( $line->content ) ) {
200 48         915 $feature->name($name);
201 48         2719 $feature->keyword_original($keyword);
202 48         2419 $feature->name_line($line);
203 48         2638 $feature->tags( \@feature_tags );
204              
205 48         1913 last;
206              
207             # Feature-level tags
208             } elsif ( $line->content =~ m/^\s*\@\w/ ) {
209 6         28 my @tags = $line->content =~ m/\@([^\s]+)/g;
210 6         50 push( @feature_tags, @tags );
211              
212             } else {
213             die parse_error_from_line(
214             'Malformed feature line (expecting: /^(?:'
215             . $self->{langdef}->{feature}
216 0         0 . '): (.+)/',
217             $line
218             );
219             }
220             }
221              
222 48         264 return $feature, $self->_remove_next_blanks(@lines);
223             }
224              
225             sub _extract_conditions_of_satisfaction {
226 48     48   236 my ( $self, $feature, @lines ) = @_;
227              
228 48         196 while ( my $line = shift(@lines) ) {
229 189 100 66     1207 next if $line->is_comment || $line->is_blank;
230              
231 139 100 100     446 if ( $self->_is_scenario_line( $line->content )
232             or $self->_is_tags_line( $line->content ) ) {
233 47         141 unshift( @lines, $line );
234 47         120 last;
235             } else {
236 92         219 push( @{ $feature->satisfaction }, $line );
  92         1569  
237             }
238             }
239              
240 48         205 return $feature, $self->_remove_next_blanks(@lines);
241             }
242              
243             sub _finish_scenario {
244 199     199   432 my ($self, $feature, $line) = @_;
245             # Catch Scenario outlines without examples
246 199 100       288 if ( @{ $feature->scenarios } ) {
  199         3457  
247 138         2849 my $last_scenario = $feature->scenarios->[-1];
248 138 100 100     2799 if ( $last_scenario->keyword_original =~ m/^($self->{langdef}->{scenarioOutline})/
249 2         94 && !@{ $last_scenario->datasets } )
250             {
251 1   33     33 die parse_error_from_line(
252             "Outline scenario expects 'Examples:' section",
253             $line || $last_scenario->line );
254             }
255             }
256             }
257              
258             sub _extract_scenarios {
259 48     48   247 my ( $self, $feature, @lines ) = @_;
260 48         109 my $scenarios = 0;
261 48         126 my $langdef = $self->{langdef};
262 48         97 my @tags;
263              
264 48         242 while ( my $line = shift(@lines) ) {
265 208 100 66     2306 next if $line->is_comment || $line->is_blank;
266              
267 190 100       610 if ( my ( $type, $name ) =
    100          
    50          
268             $self->_is_examples_line( $line->content ) ) {
269              
270             die q{'Examples:' line before scenario definition}
271 26 50       65 unless @{$feature->scenarios};
  26         450  
272              
273             my $dataset = Test::BDD::Cucumber::Model::Dataset->new(
274             ( $name ? ( name => $name ) : () ),
275             tags => ( @tags ?
276 26 50       673 [ @{ $feature->scenarios->[-1]->tags }, @tags ]
  0 50       0  
277             # Reuse the ref to the scenario tags to allow
278             # detecting 'no dataset tags' in ::Scenario
279             : $feature->scenarios->[-1]->tags ),
280             line => $line,
281             );
282 26         1936 @tags = ();
283 26         118 @lines = $self->_extract_examples_description( $dataset, @lines );
284 26         106 @lines = $self->_extract_table( 6, $dataset,
285             $self->_remove_next_blanks(@lines) );
286              
287 26 100       69 if (@{$feature->scenarios->[-1]->datasets}) {
  26         478  
288 1         59 my $prev_ds = $feature->scenarios->[-1]->datasets->[0];
289 1         34 my $prev_ds_cols = join '|', sort keys %{$prev_ds->data->[0]};
  1         21  
290 1         19 my $cur_ds_cols = join '|', sort keys %{$dataset->data->[0]};
  1         18  
291 1 50       25 die parse_error_from_line(
292             q{Columns of 'Examples:' not in line with }
293             . q{previous 'Examples:' }
294             . qq{('$prev_ds_cols' vs '$cur_ds_cols')}, $line )
295             if $prev_ds_cols ne $cur_ds_cols;
296             }
297 26         737 push @{$feature->scenarios->[-1]->datasets}, $dataset;
  26         407  
298              
299             }
300             elsif ( ( $type, $name ) =
301             $self->_is_scenario_line( $line->content ) ) {
302              
303 151         544 $self->_finish_scenario( $feature, $line );
304              
305             # Only one background section, and it must be the first
306 151 50 66     2802 if ( $scenarios++ && $type =~ m/^($langdef->{background})/ ) {
307 0         0 die parse_error_from_line(
308             "Background not allowed after scenarios", $line );
309             }
310              
311             # Create the scenario
312             my $scenario = Test::BDD::Cucumber::Model::Scenario->new(
313             {
314             ( $name ? ( name => $name ) : () ),
315             background => $type =~ m/^($langdef->{background})/ ? 1 : 0,
316             keyword =>
317             ($type =~ m/^($langdef->{background})/ ? 'Background'
318             : ($type =~ m/^($langdef->{scenarioOutline})/
319             ? 'Scenario Outline' : 'Scenario')),
320             keyword_original => $type,
321             line => $line,
322 151 100       2421 tags => [ @{ $feature->tags }, @tags ]
  151 100       2816  
    100          
    100          
323             }
324             );
325 151         8189 @tags = ();
326              
327             # Attempt to populate it
328 151         625 @lines = $self->_extract_scenario_description($scenario, @lines);
329 151         575 @lines = $self->_extract_steps( $feature, $scenario, @lines );
330              
331 151 100       1109 if ( $type =~ m/^($langdef->{background})/ ) {
332 13         314 $feature->background($scenario);
333             } else {
334 138         284 push( @{ $feature->scenarios }, $scenario );
  138         2403  
335             }
336              
337             # Scenario-level tags
338             } elsif ( $line->content =~ m/^\s*\@\w/ ) {
339 13         43 push @tags, ( $line->content =~ m/\@([^\s]+)/g );
340              
341             } else {
342 0         0 die parse_error_from_line( "Malformed scenario line", $line );
343             }
344             }
345              
346 48         852 $self->_finish_scenario( $feature );
347 47         867 return $feature, $self->_remove_next_blanks(@lines);
348             }
349              
350             sub _extract_steps {
351 151     151   491 my ( $self, $feature, $scenario, @lines ) = @_;
352              
353 151         302 my $langdef = $self->{langdef};
354 151         565 my @givens = split( /\|/, $langdef->{given} );
355 151         322 my $last_verb = $givens[-1];
356              
357              
358 151         279 my ( $verb, $text );
359 151   100     607 while ( @lines and
      100        
360             ($lines[0]->is_comment
361             or ($verb, $text) = $self->_is_step_line( 1, $lines[0]->content ) ) ) {
362 473         1153 my $line = shift @lines;
363 473 100       1172 next if $line->is_comment;
364              
365 471         1030 my $original_verb = $verb;
366 471 100       2245 $verb = 'Given' if $verb =~ m/^($langdef->{given})$/;
367 471 100       1777 $verb = 'When' if $verb =~ m/^($langdef->{when})$/;
368 471 100       1699 $verb = 'Then' if $verb =~ m/^($langdef->{then})$/;
369 471 100 100     2825 $verb = $last_verb
370             if $verb =~ m/^($langdef->{and})$/
371             or $verb =~ m/^($langdef->{but}$)/;
372 471         847 $last_verb = $verb;
373              
374             # Remove the ending space for languages that
375             # have it, for backward compatibility
376 471         1732 $original_verb =~ s/ $//;
377 471         9545 my $step = Test::BDD::Cucumber::Model::Step->new(
378             {
379             text => $text,
380             verb => $verb,
381             line => $line,
382             verb_original => $original_verb,
383             }
384             );
385              
386 471         49294 @lines =
387             $self->_extract_step_data( $feature, $scenario, $step, @lines );
388              
389 471         865 push( @{ $scenario->steps }, $step );
  471         8005  
390             }
391              
392 151         878 return $self->_remove_next_blanks(@lines);
393             }
394              
395              
396             sub _extract_examples_description {
397 26     26   101 my ( $self, $examples, @lines ) = @_;
398              
399 26         104 while ( my $line = shift @lines ) {
400 26 50       84 next if $line->is_comment;
401              
402 26         111 my $content = $line->content;
403 26 0 33     172 return ( $line, @lines )
      33        
      0        
404             if $self->_is_table_line( $content )
405             or $self->_is_examples_line( $content )
406             or $self->_is_tags_line( $content )
407             or $self->_is_scenario_line( $content );
408              
409 0         0 push @{$examples->description}, $line;
  0         0  
410             }
411              
412 0         0 return @lines;
413             }
414              
415             sub _extract_scenario_description {
416 151     151   532 my ( $self, $scenario, @lines ) = @_;
417              
418 151   100     795 while ( @lines
      66        
419             and ($lines[0]->is_comment
420             or (not $self->_is_step_line(0, $lines[0]->content)
421             and not $self->_is_examples_line($lines[0]->content)
422             and not $self->_is_tags_line($lines[0]->content)
423             and not $self->_is_scenario_line($lines[0]->content) ) )
424             ) {
425 9         23 push @{$scenario->description}, shift(@lines);
  9         161  
426             }
427              
428 151         841 return @lines;
429             }
430              
431             sub _extract_step_data {
432 471     471   1558 my ( $self, $feature, $scenario, $step, @lines ) = @_;
433 471 100       1158 return unless @lines;
434              
435 433 100       1238 if ( $lines[0]->content eq '"""' ) {
    100          
436 27         129 return $self->_extract_multiline_string( $feature, $scenario, $step,
437             @lines );
438             } elsif ( $lines[0]->content =~ m/^\s*\|/ ) {
439 11         49 return $self->_extract_table( 6, $step, @lines );
440             } else {
441 395         2428 return @lines;
442             }
443              
444             }
445              
446             sub _extract_multiline_string {
447 27     27   105 my ( $self, $feature, $scenario, $step, @lines ) = @_;
448              
449 27         62 my $data = '';
450 27         50 my $start = shift(@lines);
451 27         109 my $indent = $start->indent;
452              
453             # Check we still have the minimum indentation
454 27         113 while ( my $line = shift(@lines) ) {
455              
456 99 100       240 if ( $line->content eq '"""' ) {
457 27         194 $step->data($data);
458 27         118 return $self->_remove_next_blanks(@lines);
459             }
460              
461 72         221 my $content = $line->content_remove_indentation($indent);
462              
463             # Unescape it
464 72         236 $content =~ s/\\(.)/$1/g;
465 72         111 push( @{ $step->data_as_strings }, $content );
  72         1195  
466 72         584 $content .= "\n";
467 72         222 $data .= $content;
468             }
469              
470 0         0 return;
471             }
472              
473             sub _extract_table {
474 37     37   134 my ( $self, $indent, $target, @lines ) = @_;
475 37         64 my @columns;
476              
477 37         81 my $data = [];
478 37         548 $target->data($data);
479              
480 37         1084 while ( my $line = shift(@lines) ) {
481 163 50       426 next if $line->is_comment;
482 163 100       435 return ( $line, @lines ) if index( $line->content, '|' );
483              
484 135         381 my @rows = $self->_pipe_array( $line->content );
485 135 100       650 if ( $target->can('data_as_strings') ) {
486 40         106 my $t_content = $line->content;
487 40         97 $t_content =~ s/^\s+//;
488 40         66 push( @{ $target->data_as_strings }, $t_content );
  40         690  
489             }
490              
491 135 100       579 if (@columns) {
492 98 50       277 die parse_error_from_line( "Inconsistent number of rows in table",
493             $line )
494             unless @rows == @columns;
495 98 100       830 $target->columns( [@columns] ) if $target->can('columns');
496 98         1440 my $i = 0;
497 98         184 my %data_hash = map { $columns[ $i++ ] => $_ } @rows;
  246         741  
498 98         412 push( @$data, \%data_hash );
499             } else {
500 37         180 @columns = @rows;
501             }
502             }
503              
504 9         37 return;
505             }
506              
507             sub _pipe_array {
508 135     135   312 my ( $self, $string ) = @_;
509 135         825 my @atoms = split( /(?
510 135         278 shift(@atoms);
511             return map {
512 135         295 my $atom = $_;
  332         542  
513 332         924 $atom =~ s/^\s+//;
514 332         1108 $atom =~ s/\s+$//;
515 332         656 $atom =~ s/\\(.)/$1/g;
516 332         890 $atom
517             } @atoms;
518             }
519              
520             1;
521              
522             =head1 AUTHOR
523              
524             Peter Sergeant C
525              
526             =head1 LICENSE
527              
528             Copyright 2019-2023, Erik Huelsmann
529             Copyright 2011-2019, Peter Sergeant; Licensed under the same terms as Perl
530              
531             =cut