Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@perl.apache.org
Date: 30 May 2003 02:09:57 -0000
Message-ID: <20030530020957.24322.qmail@icarus.apache.org>
From: stas@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0/t/hooks/TestHooks cleanup2.pm

stas        2003/05/29 19:09:57

  Added:       t/hooks  cleanup2.t
               t/hooks/TestHooks cleanup2.pm
  Log:
  another cleanup test, which performs a creation and cleanup of a temp file
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/hooks/cleanup2.t
  
  Index: cleanup2.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  use File::Spec::Functions qw(catfile catdir);
  
  my $vars = Apache::Test::config->{vars};
  my $dir  = catdir $vars->{documentroot}, "hooks";
  my $file = catfile $dir, "cleanup2";
  
  plan tests => 2;
  
  {
      # cleanup, just to make sure we start with virgin state
      if (-e $file) {
          unlink $file or die "Couldn't remove $file";
      }
      # this registers and performs cleanups, but we test whether the
      # cleanup was run only in the next sub-test
      my $location = "/TestHooks__cleanup2";
      my $expected = 'cleanup2 is ok';
      my $received = GET_BODY $location;
      ok t_cmp($expected, $received, "register req cleanup");
  }
  
  {
      # this sub-tests checks that the cleanup stage was run successfully
      # which is supposed to remove the file that was created
      #
      # since Apache destroys the request rec after the logging has been
      # finished, we have to give it some time  to get there
      # and remove in the file. (wait 0.25 .. 5 sec)
      my $t = 0;
      select undef, undef, undef, 0.25
          while -e $file && -s _ == 10 || $t++ == 20;
  
      if (-e $file) {
          t_debug("$file wasn't removed by the cleanup phase");
          ok 0;
          unlink $file; # cleanup
      }
      else {
          ok 1;
      }
  }
  
  
  
  
  
  
  1.1                  modperl-2.0/t/hooks/TestHooks/cleanup2.pm
  
  Index: cleanup2.pm
  ===================================================================
  package TestHooks::cleanup2;
  
  # test the cleanup handler removing a temp file
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestTrace;
  
  use File::Spec::Functions qw(catdir);
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::RequestUtil ();
  
  use Apache::Const -compile => qw(OK DECLINED);
  use APR::Const    -compile => 'SUCCESS';
  
  my $file = catdir Apache::Test::config->{vars}->{documentroot}, 
      "hooks", "cleanup2";
  
  sub handler {
      my $r = shift;
  
      $r->content_type('text/plain');
  
      t_write_file($file, "cleanup2 is ok");
  
      my $status = $r->sendfile($file);
      die "sendfile has failed" unless $status == APR::SUCCESS;
  
      $r->push_handlers(PerlCleanupHandler => \&cleanup);
  
      return Apache::OK;
  }
  
  sub cleanup {
      my $r = shift;
  
      debug_sub "called";
      die "Can't find file: $file" unless -e $file;
      unlink $file or die "failed to unlink $file";
  
      return Apache::OK;
  }
  
  1;
  __DATA__
  <NoAutoConfig>
    <Location /TestHooks__cleanup2>
        SetHandler modperl
        PerlResponseHandler TestHooks::cleanup2
    </Location>
  </NoAutoConfig>