The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

EXODIST / Test-Stream-1.302027 / lib / Test / Stream / Plugin / SkipWithout.pm 

            

              
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

              
package Test::Stream::Plugin::SkipWithout;
use strict;
use warnings;
use Test::Stream::Context qw/context/;
use Test::Stream::Util qw/pkg_to_file/;
use Scalar::Util qw/reftype/;
use Test::Stream::Plugin qw/import/;
sub load_ts_plugin {
    my $class = shift;
    my $caller = shift;
    for my $arg (@_) {
        if (ref $arg) {
            check_versions($caller, $arg);
        }
        elsif ($arg =~ m/^v?\d/) {
            check_perl_version($caller, $arg);
        }
        else {
            check_installed($caller, $arg);
        }
    }
}
sub skip {
    my ($msg) = @_;
    my $ctx = context();
    $ctx->plan(0, SKIP => $msg);
}
sub check_installed {
    my ($caller, $mod) = @_;
    my $file = pkg_to_file($mod);
    return if eval { require $file; 1 };
    my $error = $@;
    return skip("Module '$mod' is not installed")
        if $error =~ m/Can't locate \Q$file\E in \@INC/;
    # Some other error, rethrow it.
    die $error;
}
sub check_perl_version {
    my ($caller, $ver) = @_;
    return if eval "no warnings 'portable'; require $ver; 1";
    my $error = $@;
    if ($error =~ m/^(Perl \S* required)/i) {
        return skip($1);
    }
    # Other Error
    die $error;
}
sub check_versions {
    my ($caller, $ref) = @_;
    my $type = reftype($ref) || "";
    die "'$ref' is not a valid import argument to " . __PACKAGE__ . " at $caller->[1] line $caller->[2].\n"
        unless $type eq 'HASH';
    # Sort so that the order is always the same in output
    for my $mod (sort keys %$ref) {
        my $ver = $ref->{$mod};
        check_installed($caller, $mod);
        next if eval { $mod->VERSION($ver); 1 };
        chomp(my $error = $@);
        $error =~ s/ at .*$//;
        skip($error);
    }
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test::Stream::Plugin::SkipWithout - Plugin to skip tests if certain package
requirements are not met.
=head1 DEPRECATED
B<This distribution is deprecated> in favor of L<Test2>, L<Test2::Suite>, and
L<Test2::Workflow>.
See L<Test::Stream::Manual::ToTest2> for a conversion guide.
=head1 DESCRIPTION
Sometimes you have tests that are nice to run, but depend on tools that may not
be available. Instead of adding the tool as a dep, or making the test always
skip, it is common to make the test run conditionally. This package helps make
that possible.
This module is modeled after L<Test::Requires>. This module even stole most of
the syntax. The difference is that this module is based on L<Test::Stream>
directly, and does not go through L<Test::Builder>. Another difference is that
the packages you check for are not imported into your namespace for you, this
is intentional.
=head1 SYNOPSIS
    use Test::Stream SkipWithout => [
        'v5.10',                 # minimum perl version
        'Necessary::Package',    # We need this, we do not care what version it is
        # A hashref can be used to specify modules + minimum versions
        {
            'Scalar::Util' => '1.3',    # We need at least this version of Scalar::Util
            'Some::Tool'   => '2.5',    # We need version 2.5 of Some::Tool
        },
    ];
    # The tools and features are not imported for us, so we import them here.
    # This gives us control over the import arguments as well.
    use v5.10;
    use Necessary::Package qw/foo bar/;
    use Scalar::Util qw/blessed reftype/;
    use Some::Tool qw/do_it/;
=head1 SOURCE
The source code repository for Test::Stream can be found at
F<http://github.com/Test-More/Test-Stream/>.
=head1 MAINTAINERS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 AUTHORS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 COPYRIGHT
Copyright 2015 Chad Granum E<lt>exodist7@gmail.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://dev.perl.org/licenses/>
=cut