File Coverage

blib/lib/Test/Stream/Plugin/SkipWithout.pm
Criterion Covered Total %
statement 58 60 96.6
branch 13 16 81.2
condition 1 2 50.0
subroutine 13 13 100.0
pod 0 5 0.0
total 85 96 88.5


line stmt bran cond sub pod time code
1             package Test::Stream::Plugin::SkipWithout;
2 3     3   15 use strict;
  3         7  
  3         80  
3 3     3   14 use warnings;
  3         6  
  3         89  
4              
5 3     3   17 use Test::Stream::Context qw/context/;
  3         7  
  3         24  
6 3     3   16 use Test::Stream::Util qw/pkg_to_file/;
  3         6  
  3         19  
7 3     3   17 use Scalar::Util qw/reftype/;
  3         5  
  3         142  
8              
9 3     3   17 use Test::Stream::Plugin;
  3         5  
  3         23  
10              
11             sub load_ts_plugin {
12 9     9 0 16 my $class = shift;
13 9         406 my $caller = shift;
14 9         25 for my $arg (@_) {
15 9 100       43 if (ref $arg) {
    100          
16 4         14 check_versions($caller, $arg);
17             }
18             elsif ($arg =~ m/^v?\d/) {
19 2         6 check_perl_version($caller, $arg);
20             }
21             else {
22 3         9 check_installed($caller, $arg);
23             }
24             }
25             }
26              
27             sub skip {
28 5     5 0 12 my ($msg) = @_;
29 5         18 my $ctx = context();
30 5         25 $ctx->plan(0, SKIP => $msg);
31             }
32              
33             sub check_installed {
34 8     8 0 14 my ($caller, $mod) = @_;
35 8         29 my $file = pkg_to_file($mod);
36 8 100       13 return if eval { require $file; 1 };
  8         425  
  6         29  
37 2         7 my $error = $@;
38 2 50       45 return skip("Module '$mod' is not installed")
39             if $error =~ m/Can't locate \Q$file\E in \@INC/;
40              
41             # Some other error, rethrow it.
42 0         0 die $error;
43             }
44              
45             sub check_perl_version {
46 2     2 0 4 my ($caller, $ver) = @_;
47 2 100   1   236 return if eval "no warnings 'portable'; require $ver; 1";
  1     1   5  
  1         2  
  1         46  
  1         5  
  1         2  
  1         33  
48 1         5 my $error = $@;
49 1 50       6 if ($error =~ m/^(Perl \S* required)/i) {
50 1         4 return skip($1);
51             }
52              
53             # Other Error
54 0         0 die $error;
55             }
56              
57             sub check_versions {
58 4     4 0 7 my ($caller, $ref) = @_;
59 4   50     20 my $type = reftype($ref) || "";
60 4 50       13 die "'$ref' is not a valid import argument to " . __PACKAGE__ . " at $caller->[1] line $caller->[2].\n"
61             unless $type eq 'HASH';
62              
63             # Sort so that the order is always the same in output
64 4         17 for my $mod (sort keys %$ref) {
65 5         10 my $ver = $ref->{$mod};
66 5         13 check_installed($caller, $mod);
67 4 100       6 next if eval { $mod->VERSION($ver); 1 };
  4         83  
  2         16  
68 2         11 chomp(my $error = $@);
69 2         11 $error =~ s/ at .*$//;
70 2         6 skip($error);
71             }
72             }
73              
74             1;
75              
76             __END__