perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From ran...@apache.org
Subject cvs commit: modperl/t TEST.win32
Date Sat, 12 Jul 2003 23:17:33 GMT
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;
  +}
  
  
  

Mime
View raw message