1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
#line 1
package Test::Requires;
use strict;
use warnings;
our $VERSION = '0.06';
use base 'Test::Builder::Module';
use 5.006000;
sub import {
my $class = shift;
my $caller = caller(0);
# export methods
{
no strict 'refs';
*{"$caller\::test_requires"} = \&test_requires;
}
# test arguments
if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') {
while (my ($mod, $ver) = each %{$_[0]}) {
test_requires($mod, $ver, $caller);
}
} else {
for my $mod (@_) {
test_requires($mod, undef, $caller);
}
}
}
sub test_requires {
my ( $mod, $ver, $caller ) = @_;
return if $mod eq __PACKAGE__;
if (@_ != 3) {
$caller = caller(0);
}
$ver ||= '';
eval qq{package $caller; no warnings; use $mod $ver}; ## no critic.
if (my $e = $@) {
my $skip_all = sub {
my $builder = __PACKAGE__->builder;
if (not defined $builder->has_plan) {
$builder->skip_all(@_);
} elsif ($builder->has_plan eq 'no_plan') {
$builder->skip(@_);
if ( $builder->can('parent') && $builder->parent ) {
die bless {} => 'Test::Builder::Exception';
}
exit 0;
} else {
for (1..$builder->has_plan) {
$builder->skip(@_);
}
if ( $builder->can('parent') && $builder->parent ) {
die bless {} => 'Test::Builder::Exception';
}
exit 0;
}
};
if ( $e =~ /^Can't locate/ ) {
$skip_all->("requires $mod");
}
elsif ( $e =~ /^Perl (\S+) required/ ) {
$skip_all->("requires Perl $1");
}
elsif ( $e =~ /^\Q$mod\E version (\S+) required/ ) {
$skip_all->("requires $mod $1");
}
else {
$skip_all->("$e");
}
}
}
1;
__END__
#line 128
|
