httpd-test-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestConfig.pm
Date Mon, 20 May 2002 22:25:35 GMT
dougm       02/05/20 15:25:35

  Modified:    perl-framework/Apache-Test/lib/Apache TestConfig.pm
  Log:
  Submitted by:   Per Einar Ellefsen <per.einar@skynet.be>
  Reviewed by:	dougm
  which() improvements to support PATHEXT on win32 and ~ expansion elsewhere
  
  Revision  Changes    Path
  1.136     +32 -5     httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
  
  Index: TestConfig.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
  retrieving revision 1.135
  retrieving revision 1.136
  diff -u -r1.135 -r1.136
  --- TestConfig.pm	19 May 2002 20:07:28 -0000	1.135
  +++ TestConfig.pm	20 May 2002 22:25:34 -0000	1.136
  @@ -1239,13 +1239,40 @@
   
   #utils
   
  -#duplicating small bits of Apache::Build so we dont require it
  +#For Win32 systems, stores the extensions used for executable files
  +
  +my @path_ext = ();
  +
  +if (WIN32) {
  +    if ($ENV{PATHEXT}) {
  +        push @path_ext, split ';', $ENV{PATHEXT};
  +    }
  +    else {
  +        #Win9X: doesn't have PATHEXT
  +        push @path_ext, qw(com exe bat);
  +    }
  +}
  +
   sub which {
  -    foreach (map { catfile $_, $_[0] } File::Spec->path) {
  -        return $_ if -x;
  +    my $program = shift;
  +
  +    return undef unless $program;
  +
  +    my @results = ();
  +
  +    for my $base (map { catfile($_, $program) } File::Spec->path()) {
  +        if ($ENV{HOME} and not WIN32) {
  +            # only works on Unix, but that's normal:
  +            # on Win32 the shell doesn't have special treatment of '~'
  +            $base =~ s/~/$ENV{HOME}/o;
  +        }
  +
  +        return $base if -x $base;
  +
           if (WIN32) {
  -            my $exe = "$_.exe";
  -            return $exe if -x $exe;
  +            for my $ext (@path_ext) {
  +                return "$base.$ext" if -x "$base.$ext";
  +            }
           }
       }
   }
  
  
  

Mime
View raw message