dougm 02/05/20 15:25:35
Modified: perl-framework/Apache-Test/lib/Apache TestConfig.pm
Log:
Submitted by: Per Einar Ellefsen <[EMAIL PROTECTED]>
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";
+ }
}
}
}
