cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestUtil.pm

[st...@apache.org]

stas        2003/02/02 22:27:39

  Modified:    perl-framework/Apache-Test/lib/Apache TestUtil.pm
  Log:
  add another convenience function: t_append_file
  
  Revision  Changes    Path
  1.28      +42 -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.27
  retrieving revision 1.28
  diff -u -r1.27 -r1.28
  --- TestUtil.pm	2 Dec 2002 17:10:25 -0000	1.27
  +++ TestUtil.pm	3 Feb 2003 06:27:39 -0000	1.28
  @@ -16,8 +16,9 @@
   
   $VERSION = '0.01';
   @ISA     = qw(Exporter);
  -@EXPORT = qw(t_cmp t_debug t_write_file t_open_file t_mkdir t_rmtree
  -             t_is_equal);
  +
  +@EXPORT = qw(t_cmp t_debug t_append_file t_write_file t_open_file
  +             t_mkdir t_rmtree t_is_equal);
   
   %CLEAN = ();
   
  @@ -43,7 +44,7 @@
       print map {"# $_\n"} map {split /\n/} grep {defined} expand(@_);
   }
   
  -sub t_write_file {
  +sub t_open_file {
       my $file = shift;
   
       die "must pass a filename" unless defined $file;
  @@ -54,12 +55,12 @@
       my $fh = Symbol::gensym();
       open $fh, ">$file" or die "can't open $file: $!";
       t_debug("writing file: $file");
  -    print $fh join '', @_ if @_;
  -    close $fh;
       $CLEAN{files}{$file}++;
  +
  +    return $fh;
   }
   
  -sub t_open_file {
  +sub t_write_file {
       my $file = shift;
   
       die "must pass a filename" unless defined $file;
  @@ -70,9 +71,26 @@
       my $fh = Symbol::gensym();
       open $fh, ">$file" or die "can't open $file: $!";
       t_debug("writing file: $file");
  +    print $fh join '', @_ if @_;
  +    close $fh;
       $CLEAN{files}{$file}++;
  +}
   
  -    return $fh;
  +sub t_append_file {
  +    my $file = shift;
  +
  +    die "must pass a filename" unless defined $file;
  +
  +    # create the parent dir if it doesn't exist yet
  +    makepath(dirname $file);
  +
  +    # add to the cleanup list only if we created it now
  +    $CLEAN{files}{$file}++ unless -e $file;
  +
  +    my $fh = Symbol::gensym();
  +    open $fh, ">>$file" or die "can't open $file: $!";
  +    print $fh join '', @_ if @_;
  +    close $fh;
   }
   
   sub write_shell_script {
  @@ -369,6 +387,23 @@
   
   The generated file will be automatically deleted at the end of the
   program's execution.
  +
  +This function is exported by default.
  +
  +=item t_append_file()
  +
  +  t_append_file($filename, @lines);
  +
  +t_append_file() is similar to t_write_file(), but it doesn't clobber
  +existing files and appends C<@lines> to the end of the file. If the
  +file doesn't exist it will create it.
  +
  +If parent directories of C<$filename> don't exist they will be
  +automagically created.
  +
  +The generated file will be registered to be automatically deleted at
  +the end of the program's execution, only if the file was created by
  +t_append_file().
   
   This function is exported by default.