File Coverage

inc/Test/Requires.pm
Criterion Covered Total %
statement 43 56 76.7
branch 8 22 36.3
condition 6 14 42.8
subroutine 10 10 100.0
pod 0 1 0.0
total 67 103 65.0


line stmt bran cond sub pod time code
1             #line 1
2 103     103   5062922 package Test::Requires;
  103         975  
  103         3243  
3 103     103   4486 use strict;
  99         23166  
  99         4050  
4             use warnings;
5 93     93   658 our $VERSION = '0.06';
  93         215  
  93         18143  
6 93     93   560093 use base 'Test::Builder::Module';
  93         372  
7             use 5.006000;
8              
9 103     103   1957 sub import {
10 103         260 my $class = shift;
11             my $caller = caller(0);
12              
13             # export methods
14 93     93   651 {
  93         224  
  93         55259  
  103         175  
15 103         227 no strict 'refs';
  103         659  
16             *{"$caller\::test_requires"} = \&test_requires;
17             }
18              
19 103 100 66     1493 # test arguments
      66        
20 59         121 if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') {
  77         979  
21 59         168 while (my ($mod, $ver) = each %{$_[0]}) {
22             test_requires($mod, $ver, $caller);
23             }
24 44         112 } else {
25 44         126 for my $mod (@_) {
26             test_requires($mod, undef, $caller);
27             }
28             }
29             }
30              
31 103     103 0 249 sub test_requires {
32 103 50       308 my ( $mod, $ver, $caller ) = @_;
33 103 50       341 return if $mod eq __PACKAGE__;
34 0         0 if (@_ != 3) {
35             $caller = caller(0);
36 103   100     372 }
37             $ver ||= '';
38 93     93   597  
  93     93   181  
  93         3567  
  93         30629  
  38         189821  
  26         635  
  103         6407  
39 103 100       19396 eval qq{package $caller; no warnings; use $mod $ver}; ## no critic.
40             if (my $e = $@) {
41 59     59   436 my $skip_all = sub {
42             my $builder = __PACKAGE__->builder;
43 59 50       834  
    0          
44 59         10104 if (not defined $builder->has_plan) {
45             $builder->skip_all(@_);
46 0         0 } elsif ($builder->has_plan eq 'no_plan') {
47 0 0 0     0 $builder->skip(@_);
48 0         0 if ( $builder->can('parent') && $builder->parent ) {
49             die bless {} => 'Test::Builder::Exception';
50 0         0 }
51             exit 0;
52 0         0 } else {
53 0         0 for (1..$builder->has_plan) {
54             $builder->skip(@_);
55 0 0 0     0 }
56 0         0 if ( $builder->can('parent') && $builder->parent ) {
57             die bless {} => 'Test::Builder::Exception';
58 0         0 }
59             exit 0;
60 59         316 }
61 59 50       376 };
    0          
    0          
62 59         280 if ( $e =~ /^Can't locate/ ) {
63             $skip_all->("requires $mod");
64             }
65 0           elsif ( $e =~ /^Perl (\S+) required/ ) {
66             $skip_all->("requires Perl $1");
67             }
68 0           elsif ( $e =~ /^\Q$mod\E version (\S+) required/ ) {
69             $skip_all->("requires $mod $1");
70             }
71 0           else {
72             $skip_all->("$e");
73             }
74             }
75             }
76              
77             1;
78             __END__