| #AUTHOR: Peter Tillemans <pti@MAIL.NET4ALL.BE> |
| |
| 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 (<BAK>) { |
| 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; |
| } |