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.36_01';
  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.36
 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