File Coverage

blib/lib/Test/BDD/Cucumber/Model/TagSpec.pm
Criterion Covered Total %
statement 32 33 96.9
branch 13 16 81.2
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 55 59 93.2


line stmt bran cond sub pod time code
1 19     19   776 use v5.14;
  19         73  
2 19     19   147 use warnings;
  19         121  
  19         954  
3              
4             package Test::BDD::Cucumber::Model::TagSpec 0.86;
5              
6             =head1 NAME
7              
8             Test::BDD::Cucumber::Model::TagSpec - Encapsulates tag selectors
9              
10             =head1 VERSION
11              
12             version 0.86
13              
14             =head1 STATUS
15              
16             DEPRECATED - This module's functionality has been superseeded by
17             L. A module published by the Cucumber
18             project, with cross-implementation tests to achieve overall consistency.
19              
20             =head1 DESCRIPTION
21              
22             Try and deal with the crazy-sauce tagging mechanism in a sane
23             way.
24              
25             =cut
26              
27 19     19   185 use Moo;
  19         48  
  19         123  
28 19     19   7074 use List::Util qw( all any );
  19         72  
  19         1738  
29 19     19   139 use Types::Standard qw( ArrayRef );
  19         56  
  19         157  
30              
31             =head1 OVERVIEW
32              
33             Cucumber tags are all sortsa crazy. This appears to be a direct result of trying
34             to shoe-horn the syntax in to something you can use on the command line. Because
35             'Cucumber' is the name of a gem, application, language, methodology etc etc etc
36             look of disapproval.
37              
38             Here is some further reading on how it's meant to work:
39             L. This is obviously a little
40             insane.
41              
42             Here's how they work here, on a code level: You pass in a list of lists that
43             look like Lisp expressions, with a function: C, C, or C. You can
44             nest these to infinite complexity, but the parser is pretty inefficient, so
45             don't do that. The C function accepts only one argument.
46              
47             I:
48              
49             @important AND @billing: C<<[and => 'important', 'billing']>>
50              
51             (@billing OR @WIP) AND @important: C<<[ and => [ or => 'billing', 'wip' ], 'important' ]>>
52              
53             Skipping both @todo and @wip tags: C<<[ and => [ not => 'todo' ], [ not => 'wip' ] ]>>
54              
55             =head1 ATTRIBUTES
56              
57             =head2 tags
58              
59             An arrayref representing a structure like the above.
60              
61             TagSet->new({
62             tags => [ and => 'green', 'blue', [ or => 'red', 'yellow' ], [ not => 'white' ] ]
63             })
64              
65             =cut
66              
67             has 'tags' => ( is => 'rw', isa => ArrayRef, default => sub { [] } );
68              
69             =head1 METHODS
70              
71             =head2 filter
72              
73             Filter a list of Scenarios by the value of C
74              
75             my @matched = $tagset->filter( @scenarios );
76              
77             If C is empty, no filtering is done.
78              
79             =cut
80              
81             sub filter {
82 13     13 1 6600 my ( $self, @scenarios ) = @_;
83 13 50       25 return @scenarios unless @{ $self->tags };
  13         279  
84              
85             return grep {
86 13         127 my @tags = @{ $_->tags };
  60         130  
  60         1026  
87 60         432 my $scenario = { map { $_ => 1 } @tags };
  143         365  
88              
89 60         1027 _matches( $scenario, $self->tags );
90             } @scenarios;
91             }
92              
93             sub _matches {
94 112     112   446 my ( $scenario, $tagspec ) = @_;
95 112         237 my ( $mode, @tags ) = @$tagspec;
96              
97 112 100       262 if ( $mode eq 'and' ) {
    100          
    50          
98             return all {
99 81 100   81   373 ref $_ ? _matches( $scenario, $_ ) : $scenario->{$_}
100 59         245 } @tags;
101             }
102             elsif ( $mode eq 'or' ) {
103             return any {
104 46 100   46   219 ref $_ ? _matches( $scenario, $_ ) : $scenario->{$_}
105 27         97 } @tags;
106             }
107             elsif ( $mode eq 'not' ) {
108 26 50       77 die "'not' expects exactly one tag argument; found @tags"
109             unless @tags == 1;
110              
111             return
112             not (ref $tags[0]
113             ? _matches( $scenario, $tags[0] )
114 26 100       143 : $scenario->{$tags[0]}
115             );
116             }
117             else {
118 0           die "Unexpected tagspec operator '$mode'";
119             }
120             }
121              
122             1;