stas 01/12/13 11:00:40
Modified: perl-framework/Apache-Test/lib/Apache TestUtil.pm
Log:
- create the non-existing directories in the path of files/dirs
- add write_perl_script() - create executable perl-script
Revision Changes Path
1.20 +56 -7
httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm
Index: TestUtil.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- TestUtil.pm 2001/12/10 05:29:55 1.19
+++ TestUtil.pm 2001/12/13 19:00:40 1.20
@@ -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 {
@@ -317,6 +353,9 @@
existing file with the content passed in I<@lines>. If only the
I<$filename> is passed, an empty file will be created.
+If parent directories of C<$filename> don't exist they will be
+automagically created.
+
The generated file will be automatically deleted at the end of the
program's execution.
@@ -324,7 +363,7 @@
=item write_shell_script()
-write_shell_script($filename, @lines);
+ write_shell_script($filename, @lines);
Similar to t_write_file() but creates a portable shell/batch
script. The created filename is constructed from C<$filename> and an
@@ -333,6 +372,13 @@
It returns the extension of the created file.
+=item write_perl_script()
+
+ write_perl_script($filename, @lines);
+
+Similar to t_write_file() but creates a executable Perl script with
+correctly set shebang line.
+
=item t_open_file()
my $fh = t_open_file($filename);
@@ -340,6 +386,9 @@
t_open_file() opens a file I<$filename> for writing and returns the
file handle to the opened file.
+If parent directories of C<$filename> don't exist they will be
+automagically created.
+
The generated file will be automatically deleted at the end of the
program's execution.
@@ -352,8 +401,8 @@
t_mkdir() creates a directory I<$dirname>. The operation will fail if
the parent directory doesn't exist.
-META: should we use File::Path::mkpath() to generate any dir even if
-the parent doesn't exist? or should we create t_mkpath() in addition?
+If parent directories of C<$dirname> don't exist they will be
+automagically created.
The generated directory will be automatically deleted at the end of
the program's execution.
