[patch] ./t/modules/vhost_alias.t

[Stas Bekman]

This test was failing because mkdir() were failing and die'ing (the dirs
weren't cleaned-up for some reason, and the test didn't take this into
account. So I've changed mkdir() to use standard gendir that takes care of
everything.

I've added a few other clean ups on the way. hope you don't mind.

Index: ./t/modules/vhost_alias.t
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/t/modules/vhost_alias.t,v
retrieving revision 1.3
diff -u -r1.3 vhost_alias.t
--- ./t/modules/vhost_alias.t   2001/08/30 06:02:56     1.3
+++ ./t/modules/vhost_alias.t   2001/08/31 09:01:30
@@ -1,13 +1,14 @@
 use strict;
 use warnings FATAL => 'all';
+
 use Apache::Test;
 use Apache::TestRequest;
 use Apache::TestConfig ();
-
-my $url = '/index.html';

-my $cgi_name = "test-cgi.sh";
+my $url        = '/index.html';
+my $cgi_name   = "test-cgi.sh";
 my $cgi_string = "test cgi for";
+my $root       = "htdocs/modules/vhost_alias";

 my @vh = qw(www.vha-test.com big.server.name.from.heck.org ab.com w-t-f.net);

@@ -16,20 +17,16 @@
 Apache::TestRequest::scheme('http'); #ssl not listening on this vhost

 my $config = Apache::TestRequest::test_config();
-my $vars = Apache::TestRequest::vars();
+my $vars   = Apache::TestRequest::vars();
 local $vars->{port} = $config->port('mod_vhost_alias');

 ## test environment setup ##
-my $mode = oct('755');
-unless( -e  "htdocs/modules/vhost_alias" ) {
-    mkdir("htdocs/modules/vhost_alias", $mode)
-       or die "can't mkdir htdocs/modules/vhost_alias: $!";
-}
+$config->gendir($root);

 my @d = ();
 foreach (@vh) {
     my @part = split /\./, $_;
-    my $d = "htdocs/modules/vhost_alias/";
+    my $d = "$root/";

     ## create VirtualDocumentRoot htdocs/modules/vhost_alias/%2/%1.4/%-2/%2+
     ## %2 ##
@@ -38,46 +35,44 @@
     } else {
         $d .= "_";
     }
-    mkdir($d, $mode) or die "cant mkdir $d: $!";
-    $d .= "/";
+    $config->gendir($d);

+    $d .= "/";
     ## %1.4 ##
     if (length($part[0]) < 4) {
         $d .= "_";
     } else {
         $d .= substr($part[0], 3, 1);
     }
-    mkdir($d, $mode) or die "cant mkdir $d: $!";
-    $d .= "/";
+    $config->gendir($d);

+    $d .= "/";
     ## %-2 ##
     if ([EMAIL PROTECTED]) {
         $d .= [EMAIL PROTECTED];
     } else {
         $d .= "_";
     }
-    mkdir($d, $mode) or die "cant mkdir $d: $!";
-    $d .= "/";
+    $config->gendir($d);

+    $d .= "/";
     ## %2+ ##
     for (my $i = 1;$i < @part;$i++) {
         $d .= $part[$i];
         $d .= "." if $part[$i+1];
     }
-    mkdir($d, $mode) or die "cant mkdir $d: $!";
+    $config->gendir($d);

     ## save directory for later deletion ##
-    push (@d, $d);
+    push @d, $d;

     ## write index.html for the VirtualDocumentRoot ##
-    open (HTML, ">$d$url") or die "cant open $d$url: $!";
-    print HTML $_;
-    close (HTML);
+    write_file("$d$url",$_);

     ## create directories for VirtualScriptAlias tests ##
-    $d = "htdocs/modules/vhost_alias/$_";
-    mkdir($d, $mode) or die "cant create $d: $!";
-    push(@d, $d);
+    $d = "$root/$_";
+    $config->gendir($d);
+    push @d, $d;
     $d .= "/";

     ## write cgi ##
@@ -88,20 +83,19 @@
 echo $cgi_string $_
 SCRIPT

-    open (CGI, ">$d$cgi_name") or die "cant open $d$cgi_name: $!";
-    print CGI $cgi_content;
-    close (CGI);
+    write_file("$d$cgi_name",$cgi_content);
     chmod 0755, "$d$cgi_name";

 }

+
 ## run tests ##
 foreach (@vh) {
     ## test VirtalDocumentRoot ##
     my $expected = $_;
     my $actual = GET_BODY $url, Host => $_;
     print "[VirtalDocumentRoot test]\n";
-    print "expected: ->$expected<-\nactual: ->$actual<-\n";
+    print "expected: ->$expected<-\nactual  : ->$actual<-\n";
     ok $actual eq $expected;

     ## test VirtualScriptAlias ##
@@ -110,7 +104,7 @@
     $actual = GET_BODY $cgi_uri, Host => $_;
     chomp $actual;
     print "[VirtualScriptAlias test]\n";
-    print "expected: ->$expected<-\nactual: ->$actual<-\n";
+    print "expected: ->$expected<-\nactual  : ->$actual<-\n";
     ok $actual eq $expected;
 }

@@ -129,12 +123,21 @@
     }

     while (1) {
-        for (my $i = 0;$i <= @del;$i++) {
-            splice(@del, $i, 1) if rmdir $del[$i];
+        for (my $i = 0; $i < @del;$i++) {
+            splice(@del, $i, 1)
+                if defined $del[$i] and rmdir $del[$i];
         }

         last unless @del;

     }
+}
+rmdir $root;
+
+sub write_file{
+    my $file = shift;
+    open my $fh, ">$file" or die "can't open $file: $!";
+    print "writing $file\n";
+    print $fh join '', @_ if @_;
+    close $fh;
 }
-rmdir "htdocs/modules/vhost_alias";

_____________________________________________________________________
Stas Bekman              JAm_pH     --   Just Another mod_perl Hacker
http://stason.org/       mod_perl Guide  http://perl.apache.org/guide
mailto:[EMAIL PROTECTED]   http://localhost/      http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/