[patch] Apache/TestUtil.pm

[Stas Bekman]

- create the non-existing directories in the path of the file or dir
- add write_perl_script() - create executable perl-script

Index: Apache-Test/lib/Apache/TestUtil.pm
===================================================================
RCS file: 
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.19
diff -u -r1.19 TestUtil.pm
--- Apache-Test/lib/Apache/TestUtil.pm  2001/12/10 05:29:55     1.19
+++ Apache-Test/lib/Apache/TestUtil.pm  2001/12/13 18:34:44
@@ -7,7 +7,11 @@
 use File::Path ();
 use Exporter ();
 use Carp ();
+use Config;
+use File::Basename qw(dirname);

+use Apache::TestConfig;
+
 use vars qw($VERSION @ISA @EXPORT %CLEAN);

 $VERSION = '0.01';
@@ -43,6 +47,10 @@
     my $file = shift;

     die "must pass a filename" unless defined $file;
+
+    # create the parent dir if it doesn't exist yet
+    makepath(dirname $file);
+
     my $fh = Symbol::gensym();
     open $fh, ">$file" or die "can't open $file: $!";
     t_debug("writing file: $file");
@@ -55,10 +63,15 @@
     my $file = shift;

     die "must pass a filename" unless defined $file;
+
+    # create the parent dir if it doesn't exist yet
+    makepath(dirname $file);
+
     my $fh = Symbol::gensym();
     open $fh, ">$file" or die "can't open $file: $!";
     t_debug("writing file: $file");
     $CLEAN{files}{$file}++;
+
     return $fh;
 }

@@ -83,13 +96,36 @@
     $ext;
 }

+sub write_perl_script {
+    my $file = shift;
+
+    my $shebang = "#!$Config{perlpath}\n";
+    my $warning = Apache::TestConfig->thaw->genwarning($file);
+    t_write_file($file, $shebang, $warning, @_);
+    chmod 0555, $file;
+}
+
+
 sub t_mkdir {
     my $dir = shift;
+    makepath($dir);
+}
+
+# returns a list of dirs successfully created
+sub makepath {
+    my($path) = @_;
+
+    return if !defined($path) || -e $path;
+    my $full_path = $path;
+
+    # remember which dirs were created and should be cleaned up
+    while (1) {
+        $CLEAN{dirs}{$path} = 1;
+        $path = dirname $path;
+        last if -e $path;
+    }

-    die "must pass a dirname" unless defined $dir;
-    t_debug("creating dir: $dir");
-    mkdir $dir, 0755 unless -d $dir;
-    $CLEAN{dirs}{$dir}++;
+    return File::Path::mkpath($full_path, 0, 0755);
 }

 sub t_rmtree {

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