| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # ABSTRACT: Read from a TAP archive and convert it for displaying | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | package Convert::TAP::Archive; | 
| 4 |  |  |  |  |  |  | { | 
| 5 |  |  |  |  |  |  | $Convert::TAP::Archive::VERSION = '0.005'; | 
| 6 |  |  |  |  |  |  | } | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 2 |  |  | 2 |  | 32462 | use strict; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 85 |  | 
| 9 | 2 |  |  | 2 |  | 13 | use warnings; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 70 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 2 |  |  | 2 |  | 3031 | use Capture::Tiny qw( capture_merged ); | 
|  | 2 |  |  |  |  | 104423 |  | 
|  | 2 |  |  |  |  | 225 |  | 
| 12 | 2 |  |  | 2 |  | 2099 | use TAP::Harness; | 
|  | 2 |  |  |  |  | 16153 |  | 
|  | 2 |  |  |  |  | 82 |  | 
| 13 | 2 |  |  | 2 |  | 2056 | use TAP::Harness::Archive; | 
|  | 2 |  |  |  |  | 448664 |  | 
|  | 2 |  |  |  |  | 759 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | require Exporter; | 
| 16 |  |  |  |  |  |  | our @ISA = qw(Exporter); | 
| 17 |  |  |  |  |  |  | our @EXPORT = qw(convert_from_taparchive); | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | # one and only subroutine of this module | 
| 20 |  |  |  |  |  |  | sub convert_from_taparchive { | 
| 21 |  |  |  |  |  |  |  | 
| 22 | 1 |  |  | 1 | 1 | 72 | my %args = @_; | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | # Input Arguments: archive, formatter, force_inline | 
| 25 |  |  |  |  |  |  | # Set default values: | 
| 26 | 1 | 50 |  |  |  | 5 | die 'no archive specified' | 
| 27 |  |  |  |  |  |  | unless (exists $args{archive}); | 
| 28 | 1 | 50 |  |  |  | 4 | $args{formatter} = 'TAP::Formatter::HTML' | 
| 29 |  |  |  |  |  |  | unless (exists $args{formatter}); | 
| 30 | 1 | 50 |  |  |  | 6 | $args{force_inline} = 0 | 
| 31 |  |  |  |  |  |  | unless (exists $args{force_inline}); | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | # This is the complicate but flexible version to: | 
| 34 |  |  |  |  |  |  | #   use TAP::Formatter::HTML; | 
| 35 |  |  |  |  |  |  | #   my $formatter = TAP::Formatter::HTML->new; | 
| 36 | 1 |  |  |  |  | 3 | my $formatter; | 
| 37 | 1 |  |  |  |  | 6 | (my $require_name = $args{formatter} . ".pm") =~ s{::}{/}g; | 
| 38 | 1 |  |  |  |  | 3 | eval { | 
| 39 | 1 |  |  |  |  | 993 | require $require_name; | 
| 40 | 1 |  |  |  |  | 63603 | $formatter = $args{formatter}->new(); | 
| 41 |  |  |  |  |  |  | }; | 
| 42 | 1 | 50 |  |  |  | 28158 | die "Problems with formatter $args{formatter}" | 
| 43 |  |  |  |  |  |  | . " at $require_name: $@" | 
| 44 |  |  |  |  |  |  | if $@; | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | # if set, include all CSS and JS in HTML file | 
| 47 | 1 | 50 |  |  |  | 6 | if ($args{force_inline}) { | 
| 48 | 0 |  |  |  |  | 0 | $formatter->force_inline_css(1); | 
| 49 | 0 |  |  |  |  | 0 | $formatter->force_inline_js (1); | 
| 50 |  |  |  |  |  |  | } | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | # Now we do a lot of magic to convert this stuff... | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 1 |  |  |  |  | 14 | my $harness = TAP::Harness->new({ formatter => $formatter }); | 
| 55 |  |  |  |  |  |  |  | 
| 56 | 1 |  |  |  |  | 181 | $formatter->really_quiet(1); | 
| 57 | 1 |  |  |  |  | 19 | $formatter->prepare; | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 1 |  |  |  |  | 23 | my $session; | 
| 60 |  |  |  |  |  |  | my $aggregator = TAP::Harness::Archive->aggregator_from_archive({ | 
| 61 |  |  |  |  |  |  | archive          => $args{archive}, | 
| 62 |  |  |  |  |  |  | parser_callbacks => { | 
| 63 |  |  |  |  |  |  | ALL => sub { | 
| 64 | 3 |  |  | 3 |  | 2283 | $session->result( $_[0] ); | 
| 65 |  |  |  |  |  |  | }, | 
| 66 |  |  |  |  |  |  | }, | 
| 67 |  |  |  |  |  |  | made_parser_callback => sub { | 
| 68 | 1 |  |  | 1 |  | 47176 | $session = $formatter->open_test( $_[1], $_[0] ); | 
| 69 |  |  |  |  |  |  | } | 
| 70 | 1 |  |  |  |  | 23 | }); | 
| 71 |  |  |  |  |  |  |  | 
| 72 | 1 |  |  |  |  | 2210 | $aggregator->start; | 
| 73 | 1 |  |  |  |  | 59 | $aggregator->stop; | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | # This code also prints to STDOUT but we will catch it! | 
| 76 | 1 |  |  | 1 |  | 71 | return capture_merged { $formatter->summary($aggregator) }; | 
|  | 1 |  |  |  |  | 1311 |  | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | 1; | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | __END__ |