File Coverage

blib/lib/Test2/Util/Facets2Legacy.pm
Criterion Covered Total %
statement 77 77 100.0
branch 51 56 91.0
condition 19 32 59.3
subroutine 16 16 100.0
pod 10 10 100.0
total 173 191 90.5


line stmt bran cond sub pod time code
1             package Test2::Util::Facets2Legacy;
2 246     246   1694 use strict;
  246         574  
  246         7050  
3 246     246   1237 use warnings;
  246         522  
  246         10269  
4              
5             our $VERSION = '1.302181';
6              
7 246     246   1635 use Carp qw/croak confess/;
  246         649  
  246         13143  
8 246     246   1676 use Scalar::Util qw/blessed/;
  246         622  
  246         13159  
9              
10 246     246   1956 use base 'Exporter';
  246         643  
  246         282300  
11             our @EXPORT_OK = qw{
12             causes_fail
13             diagnostics
14             global
15             increments_count
16             no_display
17             sets_plan
18             subtest_id
19             summary
20             terminate
21             uuid
22             };
23             our %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
24              
25             our $CYCLE_DETECT = 0;
26             sub _get_facet_data {
27 61     61   130 my $in = shift;
28              
29 61 100 66     542 if (blessed($in) && $in->isa('Test2::Event')) {
30 26 100       282 confess "Cycle between Facets2Legacy and $in\->facet_data() (Did you forget to override the facet_data() method?)"
31             if $CYCLE_DETECT;
32              
33 25         94 local $CYCLE_DETECT = 1;
34 25         151 return $in->facet_data;
35             }
36              
37 35 100       99 return $in if ref($in) eq 'HASH';
38              
39 1         209 croak "'$in' Does not appear to be either a Test::Event or an EventFacet hashref";
40             }
41              
42             sub causes_fail {
43 9     9 1 34 my $facet_data = _get_facet_data(shift @_);
44              
45 7 100 66     21 return 1 if $facet_data->{errors} && grep { $_->{fail} } @{$facet_data->{errors}};
  1         9  
  1         3  
46              
47 6 100       13 if (my $control = $facet_data->{control}) {
48 3 100       11 return 1 if $control->{halt};
49 2 100       8 return 1 if $control->{terminate};
50             }
51              
52 4 100 66     13 return 0 if $facet_data->{amnesty} && @{$facet_data->{amnesty}};
  1         7  
53 3 100 66     13 return 1 if $facet_data->{assert} && !$facet_data->{assert}->{pass};
54 2         8 return 0;
55             }
56              
57             sub diagnostics {
58 4     4 1 15 my $facet_data = _get_facet_data(shift @_);
59 4 100 66     14 return 1 if $facet_data->{errors} && @{$facet_data->{errors}};
  1         8  
60 3 100 66     14 return 0 unless $facet_data->{info} && @{$facet_data->{info}};
  2         8  
61 2 100       4 return (grep { $_->{debug} } @{$facet_data->{info}}) ? 1 : 0;
  2         12  
  2         5  
62             }
63              
64             sub global {
65 15     15 1 90 my $facet_data = _get_facet_data(shift @_);
66 15 100       78 return 0 unless $facet_data->{control};
67 14         102 return $facet_data->{control}->{global};
68             }
69              
70             sub increments_count {
71 2     2 1 10 my $facet_data = _get_facet_data(shift @_);
72 2 100       11 return $facet_data->{assert} ? 1 : 0;
73             }
74              
75             sub no_display {
76 3     3 1 13 my $facet_data = _get_facet_data(shift @_);
77 3 100       12 return 0 unless $facet_data->{about};
78 2         8 return $facet_data->{about}->{no_display};
79             }
80              
81             sub sets_plan {
82 6     6 1 22 my $facet_data = _get_facet_data(shift @_);
83 6 100       20 my $plan = $facet_data->{plan} or return;
84 5   100     23 my @out = ($plan->{count} || 0);
85              
86 5 100       17 if ($plan->{skip}) {
    100          
87 2         4 push @out => 'SKIP';
88 2 100       7 push @out => $plan->{details} if defined $plan->{details};
89             }
90             elsif ($plan->{none}) {
91 1         2 push @out => 'NO PLAN'
92             }
93              
94 5         30 return @out;
95             }
96              
97             sub subtest_id {
98 2     2 1 11 my $facet_data = _get_facet_data(shift @_);
99 2 100       10 return undef unless $facet_data->{parent};
100 1         5 return $facet_data->{parent}->{hid};
101             }
102              
103             sub summary {
104 2     2 1 11 my $facet_data = _get_facet_data(shift @_);
105 2 100 66     15 return '' unless $facet_data->{about} && $facet_data->{about}->{details};
106 1         4 return $facet_data->{about}->{details};
107             }
108              
109             sub terminate {
110 9     9 1 42 my $facet_data = _get_facet_data(shift @_);
111 9 100       90 return undef unless $facet_data->{control};
112 3         11 return $facet_data->{control}->{terminate};
113             }
114              
115             sub uuid {
116 14     14 1 21 my $in = shift;
117              
118 14 100       29 if ($CYCLE_DETECT) {
119 8 50 33     50 if (blessed($in) && $in->isa('Test2::Event')) {
120 8         25 my $meth = $in->can('uuid');
121 8 50       49 $meth = $in->can('SUPER::uuid') if $meth == \&uuid;
122 8 50 33     23 my $uuid = $in->$meth if $meth && $meth != \&uuid;
123 8 50       17 return $uuid if $uuid;
124             }
125              
126 8         25 return undef;
127             }
128              
129 6         22 my $facet_data = _get_facet_data($in);
130 6 50 33     74 return $facet_data->{about}->{uuid} if $facet_data->{about} && $facet_data->{about}->{uuid};
131              
132 6         29 return undef;
133             }
134              
135             1;
136              
137             =pod
138              
139             =encoding UTF-8
140              
141             =head1 NAME
142              
143             Test2::Util::Facets2Legacy - Convert facet data to the legacy event API.
144              
145             =head1 DESCRIPTION
146              
147             This module exports several subroutines from the older event API (see
148             L<Test2::Event>). These subroutines can be used as methods on any object that
149             provides a custom C<facet_data()> method. These subroutines can also be used as
150             functions that take a facet data hashref as arguments.
151              
152             =head1 SYNOPSIS
153              
154             =head2 AS METHODS
155              
156             package My::Event;
157              
158             use Test2::Util::Facets2Legacy ':ALL';
159              
160             sub facet_data { return { ... } }
161              
162             Then to use it:
163              
164             my $e = My::Event->new(...);
165              
166             my $causes_fail = $e->causes_fail;
167             my $summary = $e->summary;
168             ....
169              
170             =head2 AS FUNCTIONS
171              
172             use Test2::Util::Facets2Legacy ':ALL';
173              
174             my $f = {
175             assert => { ... },
176             info => [{...}, ...],
177             control => {...},
178             ...
179             };
180              
181             my $causes_fail = causes_fail($f);
182             my $summary = summary($f);
183              
184             =head1 NOTE ON CYCLES
185              
186             When used as methods, all these subroutines call C<< $e->facet_data() >>. The
187             default C<facet_data()> method in L<Test2::Event> relies on the legacy methods
188             this module emulates in order to work. As a result of this it is very easy to
189             create infinite recursion bugs.
190              
191             These methods have cycle detection and will throw an exception early if a cycle
192             is detected. C<uuid()> is currently the only subroutine in this library that
193             has a fallback behavior when cycles are detected.
194              
195             =head1 EXPORTS
196              
197             Nothing is exported by default. You must specify which methods to import, or
198             use the ':ALL' tag.
199              
200             =over 4
201              
202             =item $bool = $e->causes_fail()
203              
204             =item $bool = causes_fail($f)
205              
206             Check if the event or facets result in a failing state.
207              
208             =item $bool = $e->diagnostics()
209              
210             =item $bool = diagnostics($f)
211              
212             Check if the event or facets contain any diagnostics information.
213              
214             =item $bool = $e->global()
215              
216             =item $bool = global($f)
217              
218             Check if the event or facets need to be globally processed.
219              
220             =item $bool = $e->increments_count()
221              
222             =item $bool = increments_count($f)
223              
224             Check if the event or facets make an assertion.
225              
226             =item $bool = $e->no_display()
227              
228             =item $bool = no_display($f)
229              
230             Check if the event or facets should be rendered or hidden.
231              
232             =item ($max, $directive, $reason) = $e->sets_plan()
233              
234             =item ($max, $directive, $reason) = sets_plan($f)
235              
236             Check if the event or facets set a plan, and return the plan details.
237              
238             =item $id = $e->subtest_id()
239              
240             =item $id = subtest_id($f)
241              
242             Get the subtest id, if any.
243              
244             =item $string = $e->summary()
245              
246             =item $string = summary($f)
247              
248             Get the summary of the event or facets hash, if any.
249              
250             =item $undef_or_int = $e->terminate()
251              
252             =item $undef_or_int = terminate($f)
253              
254             Check if the event or facets should result in process termination, if so the
255             exit code is returned (which could be 0). undef is returned if no termination
256             is requested.
257              
258             =item $uuid = $e->uuid()
259              
260             =item $uuid = uuid($f)
261              
262             Get the UUID of the facets or event.
263              
264             B<Note:> This will fall back to C<< $e->SUPER::uuid() >> if a cycle is
265             detected and an event is used as the argument.
266              
267             =back
268              
269             =head1 SOURCE
270              
271             The source code repository for Test2 can be found at
272             F<http://github.com/Test-More/test-more/>.
273              
274             =head1 MAINTAINERS
275              
276             =over 4
277              
278             =item Chad Granum E<lt>exodist@cpan.orgE<gt>
279              
280             =back
281              
282             =head1 AUTHORS
283              
284             =over 4
285              
286             =item Chad Granum E<lt>exodist@cpan.orgE<gt>
287              
288             =back
289              
290             =head1 COPYRIGHT
291              
292             Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
293              
294             This program is free software; you can redistribute it and/or
295             modify it under the same terms as Perl itself.
296              
297             See F<http://dev.perl.org/licenses/>
298              
299             =cut