perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/src/modules/perl modperl_config.c
Date Mon, 03 Feb 2003 06:40:33 GMT
stas        2003/02/02 22:40:33

  Modified:    .        Changes
               src/modules/perl modperl_config.c
  Added:       t/hooks  cleanup.t
               t/hooks/TestHooks cleanup.pm
  Log:
  PerlCleanupHandler implementation + tests
  
  Revision  Changes    Path
  1.119     +8 -1      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.118
  retrieving revision 1.119
  diff -u -r1.118 -r1.119
  --- Changes	31 Jan 2003 03:15:24 -0000	1.118
  +++ Changes	3 Feb 2003 06:40:33 -0000	1.119
  @@ -10,8 +10,15 @@
   
   =item 1.99_09-dev
   
  +add PerlCleanupHandler implementation + test [Stas]
  +
  +Apache::Test now can run 'make test' under 'root', without permission
  +problems (e.g. when files need to be written), it'll chown all the
  +files under t/ to the user chosen to run the server with, before
  +running the tests and will restore the permissions at the end. [Stas]
  +
   die when Apache->request returns nothing ('PerlOptions -GlobalRequest'
  -or 'SetHandler modperl' [Stas]
  +or 'SetHandler modperl') [Stas]
   
   New Apache::Directive methods: as_hash(), lookup() + tests + docs
   [Philippe M. Chiasson <gozer@cpan.org>]
  
  
  
  1.1                  modperl-2.0/t/hooks/cleanup.t
  
  Index: cleanup.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, "cleanup";
  
  plan tests => 2;
  
  {
      # this registers and performs cleanups, but we test whether the
      # cleanup was run only in the next sub-test
      my $location = "/TestHooks::cleanup";
      my $expected = '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
  
      # since Apache destroys the request rec after the logging has been
      # finished, we have to give it some time  to get there
      # and fill in the file. (wait 0.25 .. 5 sec)
      my $t = 0;
      select undef, undef, undef, 0.25
          until -e $file && -s _ == 10 || $t++ == 20;
  
      unless (-e $file) {
          t_debug("can't find $file");
          ok 0;
      }
      else {
          open my $fh, $file or die "Can't open $file: $!";
          my $received = <$fh> || '';
          close $fh;
          my $expected = "cleanup ok";
          ok t_cmp($expected, $received, "verify req cleanup execution");
  
          # XXX: while Apache::TestUtil fails to cleanup by itself
          unlink $file;
      }
  
  }
  
  
  
  
  
  
  1.1                  modperl-2.0/t/hooks/TestHooks/cleanup.pm
  
  Index: cleanup.pm
  ===================================================================
  package TestHooks::cleanup;
  
  # test various ways to push handlers
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  
  use File::Spec::Functions qw(catfile catdir);
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::RequestUtil ();
  
  use Apache::Const -compile => qw(OK DECLINED);
  
  sub get_file {
      catdir Apache::Test::config->{vars}->{documentroot}, "hooks", "cleanup";
  }
  
  sub handler {
      my $r = shift;
  
      $r->content_type('text/plain');
      $r->print('ok');
  
      $r->push_handlers(PerlCleanupHandler => \&cleanup2);
  
      return Apache::OK;
  }
  
  sub cleanup1 {
      my $r = shift;
  
      #warn "cleanup CALLED\n";
      t_write_file(get_file(), "cleanup");
  
      return Apache::OK;
  }
  
  sub cleanup2 {
      my $r = shift;
  
      #warn "cleanup2 CALLED\n";
      t_append_file(get_file(), " ok");
  
      return Apache::OK;
  }
  
  1;
  __DATA__
  <NoAutoConfig>
    <Location /TestHooks::cleanup>
        SetHandler modperl
        PerlCleanupHandler  TestHooks::cleanup::cleanup1
        PerlResponseHandler TestHooks::cleanup
    </Location>
  </NoAutoConfig>
  
  
  
  
  1.62      +4 -1      modperl-2.0/src/modules/perl/modperl_config.c
  
  Index: modperl_config.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
  retrieving revision 1.61
  retrieving revision 1.62
  diff -u -r1.61 -r1.62
  --- modperl_config.c	1 Jan 2003 03:45:54 -0000	1.61
  +++ modperl_config.c	3 Feb 2003 06:40:33 -0000	1.62
  @@ -278,6 +278,7 @@
   
   apr_status_t modperl_config_request_cleanup(pTHX_ request_rec *r)
   {
  +    apr_status_t retval;
       MP_dRCFG;
   
       if (rcfg->pnotes) {
  @@ -285,7 +286,9 @@
           rcfg->pnotes = Nullhv;
       }
   
  -    return APR_SUCCESS;
  +    retval = modperl_callback_per_dir(MP_CLEANUP_HANDLER, r);
  +    
  +    return retval;
   }
   
   apr_status_t modperl_config_req_cleanup(void *data)
  
  
  

Mime
View raw message