httpd-test-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestUtil.pm
Date Thu, 13 Dec 2001 19:00:40 GMT
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.
  
  
  

Mime
View raw message