File Coverage

blib/lib/TAP/DOM/Waivers.pm
Criterion Covered Total %
statement 51 53 96.2
branch 11 16 68.7
condition n/a
subroutine 12 12 100.0
pod 1 1 100.0
total 75 82 91.4


line stmt bran cond sub pod time code
1             package TAP::DOM::Waivers;
2             BEGIN {
3 3     3   264369 $TAP::DOM::Waivers::AUTHORITY = 'cpan:SCHWIGON';
4             }
5             # ABSTRACT: Patching TAP::DOM, usually for test waivers
6             $TAP::DOM::Waivers::VERSION = '0.002';
7 3     3   80 use 5.008;
  3         12  
8 3     3   15 use strict;
  3         5  
  3         64  
9 3     3   15 use warnings;
  3         6  
  3         114  
10              
11 3     3   11982 use Data::Dumper;
  3         11138  
  3         145  
12 3     3   2313 use Data::DPath 'dpathr';
  3         379310  
  3         22  
13 3     3   2461 use Clone "clone";
  3         8217  
  3         219  
14 3         30 use Sub::Exporter -setup => {
15             exports => [ 'waive' ],
16             groups => { all => [ 'waive' ] },
17 3     3   20 };
  3         6  
18              
19             sub waive {
20 5     5 1 67437 my ($dom, $waivers, $options) = @_;
21              
22 5         11 my $new_dom_ref;
23 5 100       26 if ($options->{no_clone}) {
24 1         3 $new_dom_ref = \$dom;
25             } else {
26 4         1744 $new_dom_ref = \ (clone($dom));
27             }
28 5         62 foreach my $waiver (@$waivers) {
29             # apply on matching dpath
30 5 100       10 if (my @paths = @{$waiver->{match_dpath} || []}) {
  5 100       50  
    50          
31 4         21 _patch_dom_dpath( $new_dom_ref, $waiver, $_ ) foreach @paths;
32             }
33 1 50       10 elsif (my @descriptions = @{$waiver->{match_description} || []}) {
34 1         4 my @paths = map { _description_to_dpath($_) } @descriptions;
  1         5  
35 1         4 _patch_dom_dpath( $new_dom_ref, $waiver, $_ ) foreach @paths;
36             }
37             }
38 5         19 return $$new_dom_ref;
39             }
40              
41             sub _description_to_dpath {
42 1     1   3 my ($description) = @_;
43              
44             # the '#' as delimiter is not expected in a description
45             # because it has TAP semantics, however, we escape to be sure
46 1         3 $description =~ s/\#/\\\#/g;
47              
48 1         5 return "//lines//description[value =~ qr#$description#]/..";
49             }
50              
51             sub _meta_patch {
52 2     2   5 my ($metapatch) = @_;
53              
54 2         4 my $patch;
55             my $explanation;
56 2 50       8 if ($explanation = $metapatch->{TODO}) {
    0          
57 2         10 $patch = {
58             is_ok => 1,
59             has_todo => 1,
60             is_actual_ok => 0,
61             directive => 'TODO',
62             explanation => $explanation,
63             };
64             } elsif ($explanation = $metapatch->{SKIP}) {
65 0         0 $patch = {
66             is_ok => 1,
67             has_skip => 1,
68             is_actual_ok => 0,
69             directive => 'SKIP',
70             explanation => $explanation,
71             };
72             }
73 2         6 return $patch;
74             }
75              
76             sub _patch_dom_dpath {
77 5     5   12 my ($dom_ref, $waiver, $path) = @_;
78              
79 5         7 my $patch;
80 5 100       17 if (exists $waiver->{metapatch}) {
81 2         9 $patch = _meta_patch($waiver->{metapatch});
82             } else {
83 3         8 $patch = $waiver->{patch};
84             }
85 5         13 my $comment = $waiver->{comment};
86 5         27 my @points = dpathr($path)->match($$dom_ref);
87 5         37326 foreach my $p (@points) {
88 0           $$p->{$_} = $patch->{$_} foreach keys %$patch;
89             }
90             }
91              
92             1;
93              
94             =pod
95              
96             =encoding UTF-8
97              
98             =head1 NAME
99              
100             TAP::DOM::Waivers - Patching TAP::DOM, usually for test waivers
101              
102             =head1 SYNOPSIS
103              
104             use TAP::DOM;
105             use TAP::DOM::Waivers 'waiver';
106            
107             # get TAP
108             my $dom = TAP::DOM->new( tap => "somefile.tap" );
109            
110             # ,--------------------------------------------------------------------.
111             # | Define exceptions and how to modify test results.
112             # |
113             # | (1) Most powerful but most complex way:
114             # | - use DPath matching and finegrained patching
115             # |
116              
117             $waivers = [
118             {
119             # a description of what the waiver is trying to achieve
120             comment => "Force all IPv6 stuff to true",
121            
122             # a DPath that matches the records to patch:
123             match_dpath => [ "//lines//description[value =~ 'IPv6']/.." ],
124              
125             # apply changes to the matched records,
126             # here a TODO with an explanation:
127             patch => {
128             is_ok => 1,
129             has_todo => 1,
130             is_actual_ok => 0,
131             explanation => 'waiver for context xyz',
132             directive => 'TODO',
133             },
134             },
135             ];
136            
137             # |
138             # | (2) Simpler approach:
139             # |
140             # | - instead of the "patch" key above you can use "metapatches"
141             # | for Common use-cases, like #TODO or #SKIP
142             # |
143              
144             $waivers = [
145             {
146             comment => "Force all IPv6 stuff to true",
147             match_dpath => [ "//lines//description[value =~ 'IPv6']/.." ],
148             metapatch => { TODO => 'waiver for context xyz' },
149             },
150             ];
151              
152             # |
153             # | (3) Even simpler:
154             # | - also provide the description as regex
155             # |
156              
157             $waivers = [
158             {
159             comment => "Force all IPv6 stuff to true",
160             match_description => [ "IPv6" ],
161             metapatch => { TODO => 'waiver for context xyz' },
162             },
163             ];
164             #
165             # |
166             # `--------------------------------------------------------------------'
167              
168             # the actual DOM patching
169             my $patched_tap_dom = waiver($dom, $waivers);
170            
171             # do something with patched DOM
172             use Data::Dumper;
173             print Dumper($patched_tap_dom);
174            
175             # the original DOM can also be patched directly without cloning
176             waiver($dom, $waivers, { no_clone => 1 });
177             print Dumper($dom);
178            
179             # convert back to TAP from patched DOM
180             print $patched_tap_dom->to_tap;
181             print $dom->to_tap;
182              
183             =head1 NAME
184              
185             TAP::DOM::Waivers - Exceptions (waivers) for TAP::DOM-like data
186              
187             =head1 ABOUT
188              
189             =head2 Achieve?
190              
191             Test I are exemptions to actual test results.
192              
193             This module lets you ignore known issues you don't want to care about,
194             usually by grouping them for a certain context.
195              
196             =head2 Example:
197              
198             A software project might not run with IPv6 enabled but you want to see
199             a big SUCCESS or NO SUCCESS in an IPv4-only context, without being
200             disturbed by irrelevant IPv6 tests, for now.
201              
202             Statically marking the problematic tests with C<#TODO> would require
203             to change that back and forth everytime. Dynamically marking those
204             tests depending on the runtime environment does not help when another
205             engineer actually works on fixing those IPV6 problems in the same
206             environment.
207              
208             The solution is to create a I which patches the IPv6 issues
209             away in the results B you actually ran the tests, for later
210             evaluation.
211              
212             =head2 Prove plugin
213              
214             See also L
215             for a way to utilze this module with B (not yet working?).
216              
217             =head1 Waiver specification
218              
219             =head2 How to match what to patch
220              
221             This module can patch TAP-DOMs (and similar data structures, see
222             below) by certain criteria. The primary and most powerful way is via
223             Data::DPath paths, as it allows to match fuzzily against continuously
224             changing TAP from evolving test suites.
225              
226             I use this with a big TAP database where I activate waivers as a layer
227             on top of TAP::DOM based evaluation. There the TAP-DOMs are just part
228             of a even bigger data structure, but the DPath matching still applies
229             there.
230              
231             =head3 B => [ @array_of_dpaths ]
232              
233             This provides a set of dpaths that are each tried to match. The DPaths
234             should point to a single entry in TAP-DOM - that's why the examples
235             above go down into an entry to match conditions (like the
236             description), and then go up one level to point to the whole entry.
237              
238             =head3 B => [ @array_of_regexes ]
239              
240             This is a high level frontend to I. The regexes are
241             internally embedded in dpaths which are then used to match. The
242             converted internal dpaths will match fuzzy for a typical TAP-DOM
243             structure, in particular:
244              
245             "//lines//description[value =~ qr/$description/]/..";
246              
247             Please note that this doesn't allow to specify complex conditions like
248             the combination of a description and a particular test success
249             (e.g. only the "not ok" tests with a particular description, see
250             examples in I).
251              
252             In combination with the also just canonically working I
253             (see below) it might create a slightly different TAP-DOM than you
254             expect, e.g. when you match and modify tests as '#TODO' that did not
255             even fail, but the metapatch marks them as 'not ok #TODO'. So the
256             original actual success is lost.
257              
258             It might be still "quite ok" and worth the less complexity but
259             consider using I for better control.
260              
261             =head2 Patch specs
262              
263             =head3 B => { %patch_spec }
264              
265             A hash entry key B contains single keys that overwrite
266             respective fields of a TAP-DOM entry.
267              
268             This allows finegrained control but it's somewhat difficult if you are
269             not familiar with the details of how a TAP situation looks like in a
270             TAP-DOM.
271              
272             Therefore you can describe more abstract use-cases with
273             I.
274              
275             =head3 B => { %patch_spec }
276              
277             A key B declares a common use-case. Inside a metapatch the
278             key describes the use case (like 'TODO'), and the value is the most
279             significant thingie (eg. the explanation).
280              
281             Currently these metapatches are supported:
282              
283             =over 4
284              
285             =item * B => I
286              
287             =item * B => I
288              
289             =back
290              
291             When such a metapatch is found it is converted internally into an
292             equivalent detailed patch, as described above.
293              
294             =head2 Comments
295              
296             The key B is not strictly needed. It will help once there is
297             some logging.
298              
299             =head1 Back from DOM to TAP
300              
301             Usually you regenerate a semantically comparable TAP document from the
302             DOM via L.
303              
304             =head1 API
305              
306             =head2 waive ($dom, $waivers, $options)
307              
308             This applies a set of waivers to a TAP-DOM.
309              
310             The C is usually a real L but don't have
311             to. It is explicitely allowed to provide similar data structures,
312             e.g., bigger structures that only contain TAP-DOMs in sub
313             structures. It's your responsibility to provide something meaningful.
314              
315             If you match with C you have control whether to use the
316             surrounding data structures to match or not.
317              
318             If a waiver does not match, nothing happens.
319              
320             =head1 AUTHOR
321              
322             Steffen Schwigon, C<< >>
323              
324             =head1 BUGS
325              
326             Please report any bugs or feature requests to C
327             rt.cpan.org>, or through the web interface at
328             L. I
329             will be notified, and then you'll automatically be notified of
330             progress on your bug as I make changes.
331              
332             =head1 SUPPORT
333              
334             You can find documentation for this module with the perldoc command.
335              
336             perldoc TAP::DOM::Waivers
337              
338             You can also look for information at:
339              
340             =over 4
341              
342             =item * RT: CPAN's request tracker
343              
344             L
345              
346             =item * AnnoCPAN: Annotated CPAN documentation
347              
348             L
349              
350             =item * CPAN Ratings
351              
352             L
353              
354             =item * Search CPAN
355              
356             L
357              
358             =back
359              
360             =head1 LICENSE AND COPYRIGHT
361              
362             Copyright 2011 Steffen Schwigon.
363              
364             This program is free software; you can redistribute it and/or modify
365             it under the terms of either: the GNU General Public License as
366             published by the Free Software Foundation; or the Artistic License.
367              
368             See http://dev.perl.org/licenses/ for more information.
369              
370             =head1 AUTHOR
371              
372             Steffen Schwigon
373              
374             =head1 COPYRIGHT AND LICENSE
375              
376             This software is copyright (c) 2015 by Steffen Schwigon.
377              
378             This is free software; you can redistribute it and/or modify it under
379             the same terms as the Perl 5 programming language system itself.
380              
381             =cut
382              
383             __END__