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   1748 use strict;
  246         612  
  246         7179  
3 246     246   1280 use warnings;
  246         539  
  246         10424  
4              
5             our $VERSION = '1.302180';
6              
7 246     246   1487 use Carp qw/croak confess/;
  246         574  
  246         13115  
8 246     246   1609 use Scalar::Util qw/blessed/;
  246         576  
  246         12360  
9              
10 246     246   1754 use base 'Exporter';
  246         596  
  246         283091  
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   128 my $in = shift;
28              
29 61 100 66     503 if (blessed($in) && $in->isa('Test2::Event')) {
30 26 100       269 confess "Cycle between Facets2Legacy and $in\->facet_data() (Did you forget to override the facet_data() method?)"
31             if $CYCLE_DETECT;
32              
33 25         63 local $CYCLE_DETECT = 1;
34 25         125 return $in->facet_data;
35             }
36              
37 35 100       102 return $in if ref($in) eq 'HASH';
38              
39 1         197 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 32 my $facet_data = _get_facet_data(shift @_);
44              
45 7 100 66     19 return 1 if $facet_data->{errors} && grep { $_->{fail} } @{$facet_data->{errors}};
  1         9  
  1         3  
46              
47 6 100       15 if (my $control = $facet_data->{control}) {
48 3 100       11 return 1 if $control->{halt};
49 2 100       7 return 1 if $control->{terminate};
50             }
51              
52 4 100 66     12 return 0 if $facet_data->{amnesty} && @{$facet_data->{amnesty}};
  1         6  
53 3 100 66     15 return 1 if $facet_data->{assert} && !$facet_data->{assert}->{pass};
54 2         7 return 0;
55             }
56              
57             sub diagnostics {
58 4     4 1 16 my $facet_data = _get_facet_data(shift @_);
59 4 100 66     13 return 1 if $facet_data->{errors} && @{$facet_data->{errors}};
  1         7  
60 3 100 66     13 return 0 unless $facet_data->{info} && @{$facet_data->{info}};
  2         9  
61 2 100       5 return (grep { $_->{debug} } @{$facet_data->{info}}) ? 1 : 0;
  2         12  
  2         4  
62             }
63              
64             sub global {
65 15     15 1 110 my $facet_data = _get_facet_data(shift @_);
66 15 100       70 return 0 unless $facet_data->{control};
67 14         95 return $facet_data->{control}->{global};
68             }
69              
70             sub increments_count {
71 2     2 1 11 my $facet_data = _get_facet_data(shift @_);
72 2 100       10 return $facet_data->{assert} ? 1 : 0;
73             }
74              
75             sub no_display {
76 3     3 1 12 my $facet_data = _get_facet_data(shift @_);
77 3 100       12 return 0 unless $facet_data->{about};
78 2         7 return $facet_data->{about}->{no_display};
79             }
80              
81             sub sets_plan {
82 6     6 1 21 my $facet_data = _get_facet_data(shift @_);
83 6 100       20 my $plan = $facet_data->{plan} or return;
84 5   100     20 my @out = ($plan->{count} || 0);
85              
86 5 100       16 if ($plan->{skip}) {
    100          
87 2         4 push @out => 'SKIP';
88 2 100       6 push @out => $plan->{details} if defined $plan->{details};
89             }
90             elsif ($plan->{none}) {
91 1         3 push @out => 'NO PLAN'
92             }
93              
94 5         28 return @out;
95             }
96              
97             sub subtest_id {
98 2     2 1 9 my $facet_data = _get_facet_data(shift @_);
99 2 100       8 return undef unless $facet_data->{parent};
100 1         6 return $facet_data->{parent}->{hid};
101             }
102              
103             sub summary {
104 2     2 1 10 my $facet_data = _get_facet_data(shift @_);
105 2 100 66     15 return '' unless $facet_data->{about} && $facet_data->{about}->{details};
106 1         5 return $facet_data->{about}->{details};
107             }
108              
109             sub terminate {
110 9     9 1 45 my $facet_data = _get_facet_data(shift @_);
111 9 100       77 return undef unless $facet_data->{control};
112 3         13 return $facet_data->{control}->{terminate};
113             }
114              
115             sub uuid {
116 14     14 1 22 my $in = shift;
117              
118 14 100       36 if ($CYCLE_DETECT) {
119 8 50 33     44 if (blessed($in) && $in->isa('Test2::Event')) {
120 8         31 my $meth = $in->can('uuid');
121 8 50       43 $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         41 return undef;
127             }
128              
129 6         16 my $facet_data = _get_facet_data($in);
130 6 50 33     82 return $facet_data->{about}->{uuid} if $facet_data->{about} && $facet_data->{about}->{uuid};
131              
132 6         30 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). These subroutines can be used as methods on any object that
149             provides a custom C 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 method in L 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 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 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.
273              
274             =head1 MAINTAINERS
275              
276             =over 4
277              
278             =item Chad Granum Eexodist@cpan.orgE
279              
280             =back
281              
282             =head1 AUTHORS
283              
284             =over 4
285              
286             =item Chad Granum Eexodist@cpan.orgE
287              
288             =back
289              
290             =head1 COPYRIGHT
291              
292             Copyright 2020 Chad Granum Eexodist@cpan.orgE.
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
298              
299             =cut