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 TestConfig.pm
Date Thu, 13 Dec 2001 19:01:43 GMT
stas        01/12/13 11:01:43

  Modified:    perl-framework/Apache-Test/lib/Apache TestConfig.pm
  Log:
  - add write_perlscript() - creates executable perl-script
  
  Revision  Changes    Path
  1.97      +38 -0     httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
  
  Index: TestConfig.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
  retrieving revision 1.96
  retrieving revision 1.97
  diff -u -r1.96 -r1.97
  --- TestConfig.pm	2001/12/13 17:13:03	1.96
  +++ TestConfig.pm	2001/12/13 19:01:43	1.97
  @@ -645,6 +645,37 @@
       close $fh;
   }
   
  +# gen + write excutable perl script file
  +sub write_perlscript {
  +    my($self, $file, $content) = @_;
  +
  +    # create the parent dir if it doesn't exist yet
  +    my $dir = dirname $file;
  +    $self->makepath($dir);
  +
  +    my $name = abs2rel $file, $self->{vars}->{t_dir};
  +    $self->trace("generating $name");
  +
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$file" or die "open $file: $!";
  +
  +    # shebang
  +    print $fh "#!$Config{perlpath}\n";
  +
  +    if (my $msg = $self->genwarning($file)) {
  +        print $fh $msg, "\n";
  +    }
  +
  +    if ($content) {
  +        print $fh $content;
  +    }
  +
  +    $self->{clean}->{files}->{$file} = 1;
  +
  +    close $fh;
  +    chmod 0555, $file;
  +}
  +
   sub cpfile {
       my($self, $from, $to) = @_;
       File::Copy::copy($from, $to);
  @@ -1295,6 +1326,13 @@
   
   The file C<$file> and any created parent directories (if found empty)
   will be automatically removed on cleanup.
  +
  +=item write_perlscript()
  +
  +  $cfg->write_perlscript($filename, @lines);
  +
  +Similar to writefile() but creates an executable Perl script with
  +correctly set shebang line.
   
   =item gendir()
   
  
  
  

Mime
View raw message