File Coverage

blib/lib/TAP/Harness/Env.pm
Criterion Covered Total %
statement 33 64 51.5
branch 6 30 20.0
condition 5 20 25.0
subroutine 6 8 75.0
pod 1 1 100.0
total 51 123 41.4


line stmt bran cond sub pod time code
1             package TAP::Harness::Env;
2              
3 6     6   25 use strict;
  6         7  
  6         217  
4 6     6   22 use warnings;
  6         9  
  6         217  
5              
6 6     6   22 use constant IS_VMS => ( $^O eq 'VMS' );
  6         7  
  6         441  
7 6     6   1083 use TAP::Object;
  6         8  
  6         225  
8 6     6   1558 use Text::ParseWords qw/shellwords/;
  6         3919  
  6         4212  
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 0     0   0 my @inc = grep { !ref } @INC; #28567
  0         0  
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 0         0 @inc = grep { !/perl_root/i } @inc;
  0         0  
20              
21 0         0 my @default_inc = _default_inc();
22              
23 0         0 my @new_inc;
24             my %seen;
25 0         0 for my $dir (@inc) {
26 0 0       0 next if $seen{$dir}++;
27              
28 0 0 0     0 if ( $dir eq ( $default_inc[0] || '' ) ) {
29 0         0 shift @default_inc;
30             }
31             else {
32 0         0 push @new_inc, $dir;
33             }
34              
35 0   0     0 shift @default_inc while @default_inc and $seen{ $default_inc[0] };
36             }
37 0         0 return @new_inc;
38             }
39              
40             # Cache this to avoid repeatedly shelling out to Perl.
41             my @inc;
42              
43             sub _default_inc {
44 0 0   0   0 return @inc if @inc;
45              
46 0         0 local $ENV{PERL5LIB};
47 0         0 local $ENV{PERLLIB};
48              
49 0   0     0 my $perl = $ENV{HARNESS_PERL} || $^X;
50              
51             # Avoid using -l for the benefit of Perl 6
52 0         0 chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` );
53 0         0 return @inc;
54             }
55              
56             sub create {
57 2     2 1 4 my $package = shift;
58 2 50       2 my %input = %{ shift || {} };
  2         13  
59              
60 2 50       2 my @libs = @{ delete $input{libs} || [] };
  2         15  
61 2 50       2 my @raw_switches = @{ delete $input{switches} || [] };
  2         13  
62             my @opt
63 2   50     17 = ( @raw_switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} || '' ) );
64 2         286 my @switches;
65 2         8 while ( my $opt = shift @opt ) {
66 4 50       10 if ( $opt =~ /^ -I (.*) $ /x ) {
67 0 0       0 push @libs, length($1) ? $1 : shift @opt;
68             }
69             else {
70 4         11 push @switches, $opt;
71             }
72             }
73              
74             # Do things the old way on VMS...
75 2         3 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 2 0       7 : 0;
    50          
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 2   50     38 ignore_exit => $ENV{HARNESS_IGNORE_EXIT} || 0,
      50        
      50        
92             );
93              
94 2   50     14 my $class = delete $input{harness_class} || $ENV{HARNESS_SUBCLASS} || 'TAP::Harness';
95 2 50       8 if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
96 0         0 for my $opt ( split /:/, $env_opt ) {
97 0 0       0 if ( $opt =~ /^j(\d*)$/ ) {
    0          
    0          
    0          
98 0   0     0 $args{jobs} = $1 || 9;
99             }
100             elsif ( $opt eq 'c' ) {
101 0         0 $args{color} = 1;
102             }
103             elsif ( $opt =~ m/^f(.*)$/ ) {
104 0         0 my $fmt = $1;
105 0         0 $fmt =~ s/-/::/g;
106 0         0 $args{formatter_class} = $fmt;
107             }
108             elsif ( $opt =~ m/^a(.*)$/ ) {
109 0         0 my $archive = $1;
110 0         0 $class = 'TAP::Harness::Archive';
111 0         0 $args{archive} = $archive;
112             }
113             else {
114 0         0 die "Unknown HARNESS_OPTIONS item: $opt\n";
115             }
116             }
117             }
118 2         19 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 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 (which defaults to C), and any argument the harness class accepts.
146              
147             =back
148              
149             =head1 ENVIRONMENTAL VARIABLES
150              
151             =over 4
152              
153             =item C
154              
155             Setting this adds perl command line switches to each test file run.
156              
157             For example, C will turn on taint mode.
158             C will run C for
159             each test.
160              
161             =item C
162              
163             If true, C will output the verbose results of running
164             its tests.
165              
166             =item C
167              
168             Specifies a TAP::Harness subclass to be used in place of TAP::Harness.
169              
170             =item C
171              
172             Provide additional options to the harness. Currently supported options are:
173              
174             =over
175              
176             =item C<< j >>
177              
178             Run (default 9) parallel jobs.
179              
180             =item C<< c >>
181              
182             Try to color output. See L.
183              
184             =item C<< a >>
185              
186             Will use L as the harness class, and save the TAP to
187             C
188              
189             =item C<< fPackage-With-Dashes >>
190              
191             Set the formatter_class of the harness being run. Since the C
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
201              
202             Setting this to true will make the harness display the number of
203             milliseconds each test took. You can also use F's C<--timer>
204             switch.
205              
206             =item C
207              
208             Attempt to produce color output.
209              
210             =item C
211              
212             If set to a true value instruct C to ignore exit and wait
213             status from test scripts.
214              
215             =back