File Coverage

blib/lib/PAR/SetupProgname.pm
Criterion Covered Total %
statement 18 31 58.0
branch 6 18 33.3
condition 3 9 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 32 64 50.0


line stmt bran cond sub pod time code
1             package PAR::SetupProgname;
2             $PAR::SetupProgname::VERSION = '1.002';
3              
4 4     4   85 use 5.006;
  4         14  
5 4     4   17 use strict;
  4         8  
  4         75  
6 4     4   17 use warnings;
  4         5  
  4         137  
7 4     4   21 use Config;
  4         6  
  4         1371  
8              
9             =head1 NAME
10              
11             PAR::SetupProgname - Setup $ENV{PAR_PROGNAME}
12              
13             =head1 SYNOPSIS
14              
15             PAR guts, beware. Check L
16              
17             =head1 DESCRIPTION
18              
19             Routines to setup the C environment variable.
20             Read the C manual.
21              
22             The C subroutine sets up the C
23             environment variable
24              
25             =cut
26              
27             # for PAR internal use only!
28             our $Progname = $ENV{PAR_PROGNAME} || $0;
29              
30             # same code lives in PAR::Packer's par.pl!
31             sub set_progname {
32 7     7 0 37 require File::Spec;
33              
34 7 100 66     40 if (defined $ENV{PAR_PROGNAME} and $ENV{PAR_PROGNAME} =~ /(.+)/) {
35 3         7 $Progname = $1;
36             }
37 7 50       28 $Progname = $0 if not defined $Progname;
38              
39 7 50 33     82 if (( () = File::Spec->splitdir($Progname) ) > 1 or !$ENV{PAR_PROGNAME}) {
40 7 50       289 if (open my $fh, $Progname) {
41 7 50       149 return if -s $fh;
42             }
43 0 0         if (-s "$Progname$Config{_exe}") {
44 0           $Progname .= $Config{_exe};
45 0           return;
46             }
47             }
48              
49 0           foreach my $dir (split /\Q$Config{path_sep}\E/, $ENV{PATH}) {
50 0 0 0       next if exists $ENV{PAR_TEMP} and $dir eq $ENV{PAR_TEMP};
51 0           my $name = File::Spec->catfile($dir, "$Progname$Config{_exe}");
52 0 0         if (-s $name) { $Progname = $name; last }
  0            
  0            
53 0           $name = File::Spec->catfile($dir, "$Progname");
54 0 0         if (-s $name) { $Progname = $name; last }
  0            
  0            
55             }
56             }
57              
58              
59             1;
60              
61             __END__