Update Test-Harness to CPAN version 3.39
[perl.git] / cpan / Test-Harness / lib / TAP / Harness / Env.pm
1 package TAP::Harness::Env;
2
3 use strict;
4 use warnings;
5
6 use constant IS_VMS => ( $^O eq 'VMS' );
7 use TAP::Object;
8 use Text::ParseWords qw/shellwords/;
9
10 our $VERSION = '3.39';
11
12 # Get the parts of @INC which are changed from the stock list AND
13 # preserve reordering of stock directories.
14 sub _filtered_inc_vms {
15     my @inc = grep { !ref } @INC;    #28567
16
17     # VMS has a 255-byte limit on the length of %ENV entries, so
18     # toss the ones that involve perl_root, the install location
19     @inc = grep { !/perl_root/i } @inc;
20
21     my @default_inc = _default_inc();
22
23     my @new_inc;
24     my %seen;
25     for my $dir (@inc) {
26         next if $seen{$dir}++;
27
28         if ( $dir eq ( $default_inc[0] || '' ) ) {
29             shift @default_inc;
30         }
31         else {
32             push @new_inc, $dir;
33         }
34
35         shift @default_inc while @default_inc and $seen{ $default_inc[0] };
36     }
37     return @new_inc;
38 }
39
40 # Cache this to avoid repeatedly shelling out to Perl.
41 my @inc;
42
43 sub _default_inc {
44     return @inc if @inc;
45
46     local $ENV{PERL5LIB};
47     local $ENV{PERLLIB};
48
49     my $perl = $ENV{HARNESS_PERL} || $^X;
50
51     # Avoid using -l for the benefit of Perl 6
52     chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` );
53     return @inc;
54 }
55
56 sub create {
57         my $package = shift;
58     my %input = %{ shift || {} };
59
60     my @libs         = @{ delete $input{libs}     || [] };
61     my @raw_switches = @{ delete $input{switches} || [] };
62     my @opt
63       = ( @raw_switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} || '' ) );
64     my @switches;
65     while ( my $opt = shift @opt ) {
66         if ( $opt =~ /^ -I (.*) $ /x ) {
67             push @libs, length($1) ? $1 : shift @opt;
68         }
69         else {
70             push @switches, $opt;
71         }
72     }
73
74     # Do things the old way on VMS...
75     push @libs, _filtered_inc_vms() if IS_VMS;
76
77     # If $Verbose isn't numeric default to 1. This helps core.
78     my $verbose
79       = $ENV{HARNESS_VERBOSE}
80       ? $ENV{HARNESS_VERBOSE} !~ /\d/
81           ? 1
82           : $ENV{HARNESS_VERBOSE}
83       : 0;
84
85     my %args = (
86         lib         => \@libs,
87         timer       => $ENV{HARNESS_TIMER} || 0,
88         switches    => \@switches,
89         color       => $ENV{HARNESS_COLOR} || 0,
90         verbosity   => $verbose,
91         ignore_exit => $ENV{HARNESS_IGNORE_EXIT} || 0,
92     );
93
94     my $class = delete $input{harness_class} || $ENV{HARNESS_SUBCLASS} || 'TAP::Harness';
95     if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
96         for my $opt ( split /:/, $env_opt ) {
97             if ( $opt =~ /^j(\d*)$/ ) {
98                 $args{jobs} = $1 || 9;
99             }
100             elsif ( $opt eq 'c' ) {
101                 $args{color} = 1;
102             }
103             elsif ( $opt =~ m/^f(.*)$/ ) {
104                 my $fmt = $1;
105                 $fmt =~ s/-/::/g;
106                 $args{formatter_class} = $fmt;
107             }
108             elsif ( $opt =~ m/^a(.*)$/ ) {
109                 my $archive = $1;
110                 $class = 'TAP::Harness::Archive';
111                 $args{archive} = $archive;
112             }
113             else {
114                 die "Unknown HARNESS_OPTIONS item: $opt\n";
115             }
116         }
117     }
118     return TAP::Object->_construct($class, { %args, %input });
119 }
120
121 1;
122
123 =head1 NAME
124
125 TAP::Harness::Env - Parsing harness related environmental variables where appropriate
126
127 =head1 VERSION
128
129 Version 3.39
130
131 =head1 SYNOPSIS
132
133  my $harness = TAP::Harness::Env->create(\%extra_args)
134
135 =head1 DESCRIPTION
136
137 This module implements the environmental variables that L<Test::Harness> uses with TAP::Harness, and instantiates the appropriate class with the appropriate arguments.
138
139 =head1 METHODS
140
141 =over 4
142
143 =item * create( \%args )
144
145 This function reads the environment and generates an appropriate argument hash from it. If given any arguments in C<%extra_args>, these will override the environmental defaults. In accepts C<harness_class> (which defaults to C<TAP::Harness>), and any argument the harness class accepts.
146
147 =back
148
149 =head1 ENVIRONMENTAL VARIABLES
150
151 =over 4
152
153 =item C<HARNESS_PERL_SWITCHES>
154
155 Setting this adds perl command line switches to each test file run.
156
157 For example, C<HARNESS_PERL_SWITCHES=-T> will turn on taint mode.
158 C<HARNESS_PERL_SWITCHES=-MDevel::Cover> will run C<Devel::Cover> for
159 each test.
160
161 =item C<HARNESS_VERBOSE>
162
163 If true, C<TAP::Harness> will output the verbose results of running
164 its tests.
165
166 =item C<HARNESS_SUBCLASS>
167
168 Specifies a TAP::Harness subclass to be used in place of TAP::Harness.
169
170 =item C<HARNESS_OPTIONS>
171
172 Provide additional options to the harness. Currently supported options are:
173
174 =over
175
176 =item C<< j<n> >>
177
178 Run <n> (default 9) parallel jobs.
179
180 =item C<< c >>
181
182 Try to color output. See L<TAP::Formatter::Base/"new">.
183
184 =item C<< a<file.tgz> >>
185
186 Will use L<TAP::Harness::Archive> as the harness class, and save the TAP to
187 C<file.tgz>
188
189 =item C<< fPackage-With-Dashes >>
190
191 Set the formatter_class of the harness being run. Since the C<HARNESS_OPTIONS>
192 is seperated by C<:>, we use C<-> instead.
193
194 =back
195
196 Multiple options may be separated by colons:
197
198     HARNESS_OPTIONS=j9:c make test
199
200 =item C<HARNESS_TIMER>
201
202 Setting this to true will make the harness display the number of
203 milliseconds each test took.  You can also use F<prove>'s C<--timer>
204 switch.
205
206 =item C<HARNESS_COLOR>
207
208 Attempt to produce color output.
209
210 =item C<HARNESS_IGNORE_EXIT>
211
212 If set to a true value instruct C<TAP::Parser> to ignore exit and wait
213 status from test scripts.
214
215 =back