#AUTHOR: Peter Tillemans use strict; use Cwd; use File::Copy; use File::Find; use Win32::Process; use Win32; use Config; use File::Basename 'dirname'; require File::Spec; use ExtUtils::MakeMaker; # # Config part # my $apache = 'apache'; my $fullapache = find_apache(); my $ap_path = dirname $fullapache; $ENV{PATH} = join ";", $ap_path, $ENV{PATH}; my $fullperl = $Config{perlpath}; print "Running tests with:\n"; print " perl=$fullperl\n apache=$fullapache\n"; my $port = 8529; sub ErrorReport { print Win32::FormatMessage( Win32::GetLastError() ); } # # prepare config files # my $conf = 't/conf/httpd.conf'; my $win32_conf = $conf . '-win32'; my $bak = $conf . '.bak'; copy($win32_conf, $conf) or die "Copy of $win32_conf to $conf failed: $!"; # #source or binary distribution # for (qw(src/modules/win32/Release src/modules/win32/Debug win32/modules)) { my $dll = "$_/mod_perl.so"; next unless -e $dll; copy $dll, "t/modules/mod_perl.so"; last; } # # create some bogus files and a place to dump the logfiles # mkdir("/tmp","755") unless -d "/tmp"; for my $d (qw(logs conf)) { mkdir("t/$d","755") unless -d "t/$d"; } for my $f (qw(srm.conf access.conf mime.types)) { local *FH; open FH, ">t/conf/$f"; close FH; } # change the paths so everybody agrees on which files to use # this is to make sure apache knows which files to take : # apparently apache uner Win32 # change directories to the installation directory so "./t" # references do not work my $pwd = cwd(); unless (-e $bak) { copy($conf, $bak) or die "Copying $conf to $bak failed: $!"; } open(BAK, $bak) or die "Open of $bak for reading failed: $!"; open(CONF, ">$conf") or die "Open of $conf for writing failed: $!"; while () { s#\./t#$pwd/t#; print CONF $_; } close BAK; close CONF; # # start ourselves a server to pound on # my $HttpdObj; Win32::Process::Create($HttpdObj, $fullapache, "$apache -X -d $pwd/t -f $pwd/t/conf/httpd.conf", 0, NORMAL_PRIORITY_CLASS, ".") || die ErrorReport(); print << "END"; httpd listening on port $port will write error_log to: t/logs/mod_perl_error_log letting apache warm up... END sleep 2; print "done\n"; # # Ok, start pounding # system "$fullperl t/TEST @ARGV"; # # stop server again # $HttpdObj->Kill(0); # # remove traces # print "letting apache cool down...\n"; sleep 2; find(\&cleanup, '/tmp/'); sub cleanup {/^(mod_perl|CGItemp)/ && unlink($_)} unlink $bak; unlink "$pwd/t/logs/mod_perl_httpd.pid"; 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; }