randyk 2003/07/12 16:17:33
Modified: t TEST.win32
Log:
In finding Apache.exe, don't look on removeable drives, and verify
that an Apache.exe found is version 1.3.
Revision Changes Path
1.6 +66 -17 modperl/t/TEST.win32
Index: TEST.win32
===================================================================
RCS file: /home/cvs/modperl/t/TEST.win32,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- TEST.win32 12 Jul 2003 23:11:56 -0000 1.5
+++ TEST.win32 12 Jul 2003 23:17:33 -0000 1.6
@@ -7,35 +7,25 @@
use Win32;
use Config;
use File::Basename 'dirname';
+require File::Spec;
+use ExtUtils::MakeMaker;
#
# Config part
#
-$apache = "apache";
-SEARCH: {
- for my $drive ('c'..'g') {
- for my $p ("program files\\apache", "apache") {
- last SEARCH if -e ($fullapache = "$drive:\\$p\\apache.exe");
- }
- }
-}
-
-unless (-e $fullapache) {
- require ExtUtils::MakeMaker;
- ExtUtils::MakeMaker->import('prompt');
- $fullapache = prompt("Where is your apache.exe located ?", $fullapache);
-}
-die "Can't find apache.exe!" unless -e $fullapache;
+my $apache = 'apache';
+my $fullapache = find_apache();
my $ap_path = dirname $fullapache;
$ENV{PATH} = join ";", $ap_path, $ENV{PATH};
-$fullperl = $Config{perlpath};
+my $fullperl = $Config{perlpath};
print "Running tests with:\n";
print " perl=$fullperl\n apache=$fullapache\n";
-$port = 8529;
+
+my $port = 8529;
sub ErrorReport {
print Win32::FormatMessage( Win32::GetLastError() );
@@ -131,3 +121,62 @@
sleep 2;
find(\&cleanup, '/tmp/');
sub cleanup {/^(mod_perl|CGItemp)/ && unlink($_)}
+
+sub find_apache {
+ my $apache;
+ my $exe = 'Apache.exe';
+ SEARCH: {
+ my $candidate;
+ for (File::Spec->path) {
+ $candidate = File::Spec->catfile($_, $exe);
+ if (-e $candidate and check_win32_apache($candidate)) {
+ $apache = $candidate;
+ last SEARCH;
+ }
+ }
+ my @drives = drives();
+ last SEARCH unless (@drives > 0);
+ for my $drive (@drives) {
+ for ('Apache', 'Program Files/Apache',
+ 'Program Files/Apache Group/Apache') {
+ $candidate = File::Spec->catfile($drive, $_, $exe);
+ if (-e $candidate and check_win32_apache($candidate)) {
+ $apache = $candidate;
+ last SEARCH;
+ }
+ }
+ }
+ }
+ unless (-e $apache) {
+ $apache = prompt("Please supply the full path to Apache.exe:",
+ $apache);
+ if (-d $apache) {
+ $apache = File::Spec->catfile($apache, $exe);
+ }
+ }
+ die "Can't find $exe!"
+ unless (-e $apache and check_win32_apache($apache));
+
+ $apache = Win32::GetShortPathName($apache);
+ $apache =~ s!\\!/!g;
+ return $apache;
+}
+
+sub check_win32_apache {
+ my $apache = shift;
+ my $vers = qx{"$apache" -v};
+ return ($vers =~ m!Apache/1.3!) ? 1 : 0;
+}
+
+sub drives {
+ my @drives = ();
+ eval{require Win32API::File;};
+ return map {"$_:\\"} ('C' .. 'Z') if $@;
+ my @r = Win32API::File::getLogicalDrives();
+ return unless @r > 0;
+ for (@r) {
+ my $t = Win32API::File::GetDriveType($_);
+ push @drives, $_ if ($t == 3 or $t == 4);
+ }
+ return @drives > 0 ? @drives : undef;
+}
