| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::Prove::Plugin::HTML; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =head1 NAME | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | App::Prove::Plugin::HTML - a prove plugin for HTML output | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | # command-line usage: | 
| 10 |  |  |  |  |  |  | prove -m -P HTML=outfile:out.html,css_uri:style.css,js_uri:foo.js,force_inline_css:0 | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | # NOTE: this is currently in alpha, this usage will likely change! | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | =cut | 
| 15 |  |  |  |  |  |  |  | 
| 16 | 1 |  |  | 1 |  | 5186 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 35 |  | 
| 17 | 1 |  |  | 1 |  | 8 | use warnings; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 25 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 | 1 |  |  | 1 |  | 521 | use TAP::Formatter::HTML; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 263 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | our $VERSION = '0.13'; | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | sub import { | 
| 24 | 1 |  |  | 1 |  | 23 | my ($class, @args) = @_; | 
| 25 |  |  |  |  |  |  | # deprecated, do nothing | 
| 26 | 1 |  |  |  |  | 3 | return $class; | 
| 27 |  |  |  |  |  |  | } | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | sub load { | 
| 30 | 1 |  |  | 1 | 0 | 17 | my ($class, $p) = @_; | 
| 31 | 1 |  |  |  |  | 2 | my @args = @{ $p->{args} }; | 
|  | 1 |  |  |  |  | 3 |  | 
| 32 | 1 |  |  |  |  | 2 | my $app  = $p->{app_prove}; | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | # parse the args | 
| 35 | 1 |  |  |  |  | 2 | my %TFH_args; | 
| 36 | 1 |  |  |  |  | 2 | foreach my $arg (@args) { | 
| 37 | 7 |  |  |  |  | 19 | my ($key, $val) = split(/:/, $arg, 2); | 
| 38 | 7 | 100 |  |  |  | 9 | if (grep {$key eq $_} qw(css_uri js_uri)) { | 
|  | 14 |  |  |  |  | 27 |  | 
| 39 | 4 |  |  |  |  | 4 | push @{ $TFH_args{$key . 's'}}, $val; | 
|  | 4 |  |  |  |  | 12 |  | 
| 40 |  |  |  |  |  |  | } else { | 
| 41 | 3 |  |  |  |  | 6 | $TFH_args{$key} = $val; | 
| 42 |  |  |  |  |  |  | } | 
| 43 |  |  |  |  |  |  | } | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | # set the formatter to use | 
| 46 | 1 |  |  |  |  | 6 | $app->formatter( 'TAP::Formatter::HTML' ); | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | # set ENV vars in order to pass args to TAP::Formatter::HTML | 
| 49 |  |  |  |  |  |  | # horrible, but it's currently the only way :-/ | 
| 50 | 1 |  |  |  |  | 15 | while (my ($key, $val) = each %TFH_args) { | 
| 51 | 5 | 100 |  |  |  | 14 | $val = join( ':', @$val ) if (ref($val) eq 'ARRAY'); | 
| 52 | 5 |  |  |  |  | 39 | $ENV{"TAP_FORMATTER_HTML_".uc($key)} = $val; | 
| 53 |  |  |  |  |  |  | } | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | # we're done | 
| 56 | 1 |  |  |  |  | 9 | return $class; | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | 1; | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | __END__ |