1package Test2::Util::Facets2Legacy;
2use strict;
3use warnings;
4
5our $VERSION = '1.302190';
6
7use Carp qw/croak confess/;
8use Scalar::Util qw/blessed/;
9
10use base 'Exporter';
11our @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};
23our %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
24
25our $CYCLE_DETECT = 0;
26sub _get_facet_data {
27    my $in = shift;
28
29    if (blessed($in) && $in->isa('Test2::Event')) {
30        confess "Cycle between Facets2Legacy and $in\->facet_data() (Did you forget to override the facet_data() method?)"
31            if $CYCLE_DETECT;
32
33        local $CYCLE_DETECT = 1;
34        return $in->facet_data;
35    }
36
37    return $in if ref($in) eq 'HASH';
38
39    croak "'$in' Does not appear to be either a Test::Event or an EventFacet hashref";
40}
41
42sub causes_fail {
43    my $facet_data = _get_facet_data(shift @_);
44
45    return 1 if $facet_data->{errors} && grep { $_->{fail} } @{$facet_data->{errors}};
46
47    if (my $control = $facet_data->{control}) {
48        return 1 if $control->{halt};
49        return 1 if $control->{terminate};
50    }
51
52    return 0 if $facet_data->{amnesty} && @{$facet_data->{amnesty}};
53    return 1 if $facet_data->{assert} && !$facet_data->{assert}->{pass};
54    return 0;
55}
56
57sub diagnostics {
58    my $facet_data = _get_facet_data(shift @_);
59    return 1 if $facet_data->{errors} && @{$facet_data->{errors}};
60    return 0 unless $facet_data->{info} && @{$facet_data->{info}};
61    return (grep { $_->{debug} } @{$facet_data->{info}}) ? 1 : 0;
62}
63
64sub global {
65    my $facet_data = _get_facet_data(shift @_);
66    return 0 unless $facet_data->{control};
67    return $facet_data->{control}->{global};
68}
69
70sub increments_count {
71    my $facet_data = _get_facet_data(shift @_);
72    return $facet_data->{assert} ? 1 : 0;
73}
74
75sub no_display {
76    my $facet_data = _get_facet_data(shift @_);
77    return 0 unless $facet_data->{about};
78    return $facet_data->{about}->{no_display};
79}
80
81sub sets_plan {
82    my $facet_data = _get_facet_data(shift @_);
83    my $plan = $facet_data->{plan} or return;
84    my @out = ($plan->{count} || 0);
85
86    if ($plan->{skip}) {
87        push @out => 'SKIP';
88        push @out => $plan->{details} if defined $plan->{details};
89    }
90    elsif ($plan->{none}) {
91        push @out => 'NO PLAN'
92    }
93
94    return @out;
95}
96
97sub subtest_id {
98    my $facet_data = _get_facet_data(shift @_);
99    return undef unless $facet_data->{parent};
100    return $facet_data->{parent}->{hid};
101}
102
103sub summary {
104    my $facet_data = _get_facet_data(shift @_);
105    return '' unless $facet_data->{about} && $facet_data->{about}->{details};
106    return $facet_data->{about}->{details};
107}
108
109sub terminate {
110    my $facet_data = _get_facet_data(shift @_);
111    return undef unless $facet_data->{control};
112    return $facet_data->{control}->{terminate};
113}
114
115sub uuid {
116    my $in = shift;
117
118    if ($CYCLE_DETECT) {
119        if (blessed($in) && $in->isa('Test2::Event')) {
120            my $meth = $in->can('uuid');
121            $meth = $in->can('SUPER::uuid') if $meth == \&uuid;
122            my $uuid = $in->$meth if $meth && $meth != \&uuid;
123            return $uuid if $uuid;
124        }
125
126        return undef;
127    }
128
129    my $facet_data = _get_facet_data($in);
130    return $facet_data->{about}->{uuid} if $facet_data->{about} && $facet_data->{about}->{uuid};
131
132    return undef;
133}
134
1351;
136
137=pod
138
139=encoding UTF-8
140
141=head1 NAME
142
143Test2::Util::Facets2Legacy - Convert facet data to the legacy event API.
144
145=head1 DESCRIPTION
146
147This module exports several subroutines from the older event API (see
148L<Test2::Event>). These subroutines can be used as methods on any object that
149provides a custom C<facet_data()> method. These subroutines can also be used as
150functions 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
162Then 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
186When used as methods, all these subroutines call C<< $e->facet_data() >>. The
187default C<facet_data()> method in L<Test2::Event> relies on the legacy methods
188this module emulates in order to work. As a result of this it is very easy to
189create infinite recursion bugs.
190
191These methods have cycle detection and will throw an exception early if a cycle
192is detected. C<uuid()> is currently the only subroutine in this library that
193has a fallback behavior when cycles are detected.
194
195=head1 EXPORTS
196
197Nothing is exported by default. You must specify which methods to import, or
198use the ':ALL' tag.
199
200=over 4
201
202=item $bool = $e->causes_fail()
203
204=item $bool = causes_fail($f)
205
206Check if the event or facets result in a failing state.
207
208=item $bool = $e->diagnostics()
209
210=item $bool = diagnostics($f)
211
212Check if the event or facets contain any diagnostics information.
213
214=item $bool = $e->global()
215
216=item $bool = global($f)
217
218Check 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
224Check if the event or facets make an assertion.
225
226=item $bool = $e->no_display()
227
228=item $bool = no_display($f)
229
230Check 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
236Check 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
242Get the subtest id, if any.
243
244=item $string = $e->summary()
245
246=item $string = summary($f)
247
248Get 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
254Check if the event or facets should result in process termination, if so the
255exit code is returned (which could be 0). undef is returned if no termination
256is requested.
257
258=item $uuid = $e->uuid()
259
260=item $uuid = uuid($f)
261
262Get the UUID of the facets or event.
263
264B<Note:> This will fall back to C<< $e->SUPER::uuid() >> if a cycle is
265detected and an event is used as the argument.
266
267=back
268
269=head1 SOURCE
270
271The source code repository for Test2 can be found at
272F<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
292Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
293
294This program is free software; you can redistribute it and/or
295modify it under the same terms as Perl itself.
296
297See F<http://dev.perl.org/licenses/>
298
299=cut
300