perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From ge...@apache.org
Subject cvs commit: modperl-2.0/xs/Apache/RequestRec Apache__RequestRec.h
Date Thu, 12 Feb 2004 23:06:24 GMT
geoff       2004/02/12 15:06:24

  Modified:    .        Changes
               lib/ModPerl Code.pm
               src/modules/perl mod_perl.c modperl_callback.c modperl_env.c
                        modperl_env.h
               t/hooks/TestHooks headerparser.pm
               t/modperl cookie.t
               t/response/TestDirective env.pm
               t/response/TestModperl cookie.pm
               xs/Apache/RequestRec Apache__RequestRec.h
  Added:       t/modperl setupenv.t
               t/response/TestModperl setupenv.pm
  Log:
  standard %ENV population with CGI variables and contents of the
  subprocess_env table (such as SetEnv and PassEnv) has been delayed
  until the last possible moment before content-generation runs.
  PerlSetEnv and PerlPassEnv are each an exception to this and are
  placed in both %ENV and the subprocess_env table immediately,
  regardless of the current [+-]SetupEnv setting.
  
  Revision  Changes    Path
  1.328     +8 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.327
  retrieving revision 1.328
  diff -u -r1.327 -r1.328
  --- Changes	12 Feb 2004 02:05:28 -0000	1.327
  +++ Changes	12 Feb 2004 23:06:23 -0000	1.328
  @@ -12,6 +12,14 @@
   
   =item 1.99_13-dev
   
  +standard %ENV population with CGI variables and contents of the
  +subprocess_env table (such as SetEnv and PassEnv) has been delayed
  +until the last possible moment before content-generation runs.
  +PerlSetEnv and PerlPassEnv are each an exception to this and are
  +placed in both %ENV and the subprocess_env table immediately,
  +regardless of the current [+-]SetupEnv setting.
  +[Geoffrey Young]
  +
   fix PerlAddVar configuration merging [Geoffrey Young]
   
   Anonymous subs are now supported in push_handlers, set_handlers,
  
  
  
  1.116     +1 -1      modperl-2.0/lib/ModPerl/Code.pm
  
  Index: Code.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
  retrieving revision 1.115
  retrieving revision 1.116
  diff -u -r1.115 -r1.116
  --- Code.pm	9 Feb 2004 18:18:15 -0000	1.115
  +++ Code.pm	12 Feb 2004 23:06:23 -0000	1.116
  @@ -123,7 +123,7 @@
               @hook_flags, 'UNSET'],
       Dir => [qw(NONE PARSE_HEADERS SETUP_ENV MERGE_HANDLERS GLOBAL_REQUEST UNSET)],
       Req => [qw(NONE SET_GLOBAL_REQUEST PARSE_HEADERS SETUP_ENV 
  -               CLEANUP_REGISTERED)],
  +               CLEANUP_REGISTERED PERL_SET_ENV_DIR PERL_SET_ENV_SRV)],
       Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
       Handler => [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC FAKE)],
   );
  
  
  
  1.207     +30 -1     modperl-2.0/src/modules/perl/mod_perl.c
  
  Index: mod_perl.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
  retrieving revision 1.206
  retrieving revision 1.207
  diff -u -r1.206 -r1.207
  --- mod_perl.c	10 Jan 2004 05:01:04 -0000	1.206
  +++ mod_perl.c	12 Feb 2004 23:06:23 -0000	1.207
  @@ -837,11 +837,40 @@
   
   int modperl_response_handler(request_rec *r)
   {
  +    MP_dDCFG;
  +    apr_status_t retval;
  +
  +#ifdef USE_ITHREADS
  +    pTHX;
  +    modperl_interp_t *interp;
  +#endif
  +
       if (!strEQ(r->handler, "modperl")) {
           return DECLINED;
       }
   
  -    return modperl_response_handler_run(r, TRUE);
  +    /* default is -SetupEnv, add if PerlOption +SetupEnv */
  +    if (MpDirSETUP_ENV(dcfg)) {
  +#ifdef USE_ITHREADS
  +        interp = modperl_interp_select(r, r->connection, r->server);
  +        aTHX = interp->perl;
  +#endif
  +
  +        modperl_env_request_populate(aTHX_ r);
  +    }
  +
  +    retval = modperl_response_handler_run(r, TRUE);
  +
  +    if (MpDirSETUP_ENV(dcfg)) {
  +#ifdef USE_ITHREADS
  +        if (MpInterpPUTBACK(interp)) {
  +            /* PerlInterpScope handler */
  +            modperl_interp_unselect(interp);
  +        }
  +#endif
  +    }
  +
  +    return retval;
   }
   
   int modperl_response_handler_cgi(request_rec *r)
  
  
  
  1.69      +14 -4     modperl-2.0/src/modules/perl/modperl_callback.c
  
  Index: modperl_callback.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
  retrieving revision 1.68
  retrieving revision 1.69
  diff -u -r1.68 -r1.69
  --- modperl_callback.c	9 Feb 2004 19:32:42 -0000	1.68
  +++ modperl_callback.c	12 Feb 2004 23:06:24 -0000	1.69
  @@ -198,15 +198,25 @@
       modperl_config_req_cleanup_register(r, rcfg);
   
       switch (type) {
  -      case MP_HANDLER_TYPE_PER_DIR:
         case MP_HANDLER_TYPE_PER_SRV:
           modperl_handler_make_args(aTHX_ &av_args,
                                     "Apache::RequestRec", r, NULL);
   
  -        /* only happens once per-request */
  -        if (MpDirSETUP_ENV(dcfg)) {
  -            modperl_env_request_populate(aTHX_ r);
  +        /* per-server PerlSetEnv and PerlPassEnv - only once per-request */
  +        if (! MpReqPERL_SET_ENV_SRV(rcfg)) {
  +            modperl_env_configure_request_srv(aTHX_ r);
  +        }
  +
  +        break;
  +      case MP_HANDLER_TYPE_PER_DIR:
  +        modperl_handler_make_args(aTHX_ &av_args,
  +                                  "Apache::RequestRec", r, NULL);
  +
  +        /* per-directory PerlSetEnv - only once per-request */
  +        if (! MpReqPERL_SET_ENV_DIR(rcfg)) {
  +            modperl_env_configure_request_dir(aTHX_ r);
           }
  +
           break;
         case MP_HANDLER_TYPE_PRE_CONNECTION:
         case MP_HANDLER_TYPE_CONNECTION:
  
  
  
  1.30      +98 -16    modperl-2.0/src/modules/perl/modperl_env.c
  
  Index: modperl_env.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.c,v
  retrieving revision 1.29
  retrieving revision 1.30
  diff -u -r1.29 -r1.30
  --- modperl_env.c	22 Sep 2003 23:29:52 -0000	1.29
  +++ modperl_env.c	12 Feb 2004 23:06:24 -0000	1.30
  @@ -143,10 +143,13 @@
   
   void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
   {
  -    /* XXX: propagate scfg->SetEnv to environ */
       MP_dSCFG(s);
       int i = 0;
   
  +    /* make per-server PerlSetEnv and PerlPassEnv entries visible
  +     * to %ENV at config time
  +     */
  +
       for (i=0; MP_env_pass_defaults[i]; i++) {
           const char *key = MP_env_pass_defaults[i];
           char *val;
  @@ -180,18 +183,79 @@
                                             r->subprocess_env, \
                                             tab)
   
  -void modperl_env_configure_request(request_rec *r)
  +void modperl_env_configure_request_dir(pTHX_ request_rec *r)
   {
  +    MP_dRCFG;
       MP_dDCFG;
  -    MP_dSCFG(r->server);
  +
  +    /* populate %ENV and r->subprocess_env with per-directory 
  +     * PerlSetEnv entries.
  +     *
  +     * note that per-server PerlSetEnv entries, as well as
  +     * PerlPassEnv entries (which are only per-server), are added
  +     * to %ENV and r->subprocess_env via modperl_env_configure_request_srv
  +     */
   
       if (!apr_is_empty_table(dcfg->SetEnv)) {
  -        overlay_subprocess_env(r, dcfg->SetEnv);
  +        apr_table_t *setenv_copy;
  +
  +        /* add per-directory PerlSetEnv entries to %ENV
  +         * collisions with per-server PerlSetEnv entries are 
  +         * resolved via the nature of a Perl hash
  +         */
  +        MP_TRACE_e(MP_FUNC, "\n\t[%s/0x%lx/%s]"
  +                   "\n\t@ENV{keys dcfg->SetEnv} = values dcfg->SetEnv;",
  +                   modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
  +                   modperl_server_desc(r->server, r->pool));
  +        modperl_env_table_populate(aTHX_ dcfg->SetEnv);
  +
  +        /* make sure the entries are in the subprocess_env table as well.
  +         * we need to use apr_table_overlap (not apr_table_overlay) because
  +         * r->subprocess_env might have per-server PerlSetEnv entries in it
  +         * and using apr_table_overlay would generate duplicate entries.
  +         * in order to use apr_table_overlap, though, we need to copy the
  +         * the dcfg table so that pool requirements are satisfied */
  +        
  +        setenv_copy = apr_table_copy(r->pool, dcfg->SetEnv);
  +        apr_table_overlap(r->subprocess_env, setenv_copy, APR_OVERLAP_TABLES_SET);
  +    }
  +
  +    MpReqPERL_SET_ENV_DIR_On(rcfg);
  +}
  +
  +void modperl_env_configure_request_srv(pTHX_ request_rec *r)
  +{
  +    MP_dRCFG;
  +    MP_dSCFG(r->server);
  +
  +    /* populate %ENV and r->subprocess_env with per-server PerlSetEnv 
  +     * and PerlPassEnv entries.  
  +     *
  +     * although both are setup in %ENV in modperl_request_configure_server
  +     * %ENV will be reset via modperl_env_request_unpopulate.
  +     */
  +
  +    if (!apr_is_empty_table(scfg->SetEnv)) {
  +        MP_TRACE_e(MP_FUNC, "\n\t[%s/0x%lx/%s]"
  +                   "\n\t@ENV{keys scfg->SetEnv} = values scfg->SetEnv;",
  +                   modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
  +                   modperl_server_desc(r->server, r->pool));
  +        modperl_env_table_populate(aTHX_ scfg->SetEnv);
  +
  +        overlay_subprocess_env(r, scfg->SetEnv);
       }
   
       if (!apr_is_empty_table(scfg->PassEnv)) {
  +        MP_TRACE_e(MP_FUNC, "\n\t[%s/0x%lx/%s]"
  +                   "\n\t@ENV{keys scfg->PassEnv} = values scfg->PassEnv;",
  +                   modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
  +                   modperl_server_desc(r->server, r->pool));
  +        modperl_env_table_populate(aTHX_ scfg->PassEnv);
  +
           overlay_subprocess_env(r, scfg->PassEnv);
       }
  +
  +    MpReqPERL_SET_ENV_SRV_On(rcfg);
   }
   
   void modperl_env_default_populate(pTHX)
  @@ -217,27 +281,45 @@
   void modperl_env_request_populate(pTHX_ request_rec *r)
   {
       MP_dRCFG;
  -
  -    if (MpReqSETUP_ENV(rcfg)) {
  -        return;
  -    }
  -            
  -    /* XXX: might want to always do this regardless of PerlOptions -SetupEnv */
  -    modperl_env_configure_request(r);
  -
  -    ap_add_common_vars(r);
  -    ap_add_cgi_vars(r);
  + 
  +    /* this is called under the following conditions
  +     *   - if PerlOptions +SetupEnv
  +     *   - if $r->subprocess_env() is called in a void context with no args
  +     *
  +     * normally, %ENV is only populated once per request (if at all) -
  +     * just prior to content generation if +SetupEnv.
  +     *
  +     * however, in the $r->subprocess_env() case it will be called 
  +     * more than once - once for each void call, and once again just
  +     * prior to content generation.  while costly, the multiple
  +     * passes are required, otherwise void calls would prohibit later
  +     * phases from populating %ENV with new subprocess_env table entries
  +     */
   
       MP_TRACE_e(MP_FUNC, "\n\t[%s/0x%lx/%s%s]"
                  "\n\t@ENV{keys r->subprocess_env} = values r->subprocess_env;",
                  modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
                  modperl_server_desc(r->server, r->pool), r->uri);
  -    modperl_env_table_populate(aTHX_ r->subprocess_env);
  +
  +    /* we can eliminate some of the cost by only doing CGI variables once
  +     * per-request no matter how many times $r->subprocess_env() is called
  +     */
  +    if (! MpReqSETUP_ENV(rcfg)) {
  +
  +        ap_add_common_vars(r);
  +        ap_add_cgi_vars(r);
   
   #ifdef MP_COMPAT_1X
  -    modperl_env_default_populate(aTHX); /* reset GATEWAY_INTERFACE */
  +        modperl_env_default_populate(aTHX); /* reset GATEWAY_INTERFACE */
   #endif
  +    }
  +
  +    modperl_env_table_populate(aTHX_ r->subprocess_env);
   
  +    /* don't set up CGI variables again this request.
  +     * this also triggers modperl_env_request_unpopulate, which
  +     * resets %ENV between requests - see modperl_config_request_cleanup 
  +     */
       MpReqSETUP_ENV_On(rcfg);
   }
   
  
  
  
  1.16      +3 -1      modperl-2.0/src/modules/perl/modperl_env.h
  
  Index: modperl_env.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.h,v
  retrieving revision 1.15
  retrieving revision 1.16
  diff -u -r1.15 -r1.16
  --- modperl_env.h	22 Sep 2003 23:29:52 -0000	1.15
  +++ modperl_env.h	12 Feb 2004 23:06:24 -0000	1.16
  @@ -20,7 +20,9 @@
   
   void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s);
   
  -void modperl_env_configure_request(request_rec *r);
  +void modperl_env_configure_request_srv(pTHX_ request_rec *r);
  +
  +void modperl_env_configure_request_dir(pTHX_ request_rec *r);
   
   void modperl_env_default_populate(pTHX);
   
  
  
  
  1.3       +2 -2      modperl-2.0/t/hooks/TestHooks/headerparser.pm
  
  Index: headerparser.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/hooks/TestHooks/headerparser.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- headerparser.pm	11 Apr 2002 11:08:43 -0000	1.2
  +++ headerparser.pm	12 Feb 2004 23:06:24 -0000	1.3
  @@ -13,7 +13,7 @@
   sub handler {
       my $r = shift;
   
  -    $r->notes->set(url => $ENV{REQUEST_URI});
  +    $r->notes->set(headerparser => 'set');
   
       Apache::OK;
   }
  @@ -23,7 +23,7 @@
   
       plan $r, tests => 1;
   
  -    ok $r->notes->get('url') eq $r->uri;
  +    ok $r->notes->get('headerparser') eq 'set';
   
       Apache::OK;
   }
  
  
  
  1.3       +7 -6      modperl-2.0/t/modperl/cookie.t
  
  Index: cookie.t
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/modperl/cookie.t,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- cookie.t	22 Nov 2003 07:38:48 -0000	1.2
  +++ cookie.t	12 Feb 2004 23:06:24 -0000	1.3
  @@ -4,12 +4,13 @@
   # The Cookie HTTP header can be accessed via $r->headers_in and in certain
   # situations via $ENV{HTTP_COOKIE}.
   #
  -# in this test we should be able get the cookie via %ENV,
  -# since 'SetHandler perl-script' sets up mod_cgi env var. Moreover
  -# adding 'PerlOptions +SetupEnv' adds them at the very first stage used
  -# by mod_perl handlers, 'access' in this test. the last sub-test makes
  -# sure, that mod_cgi env vars don't persist and are properly re-set at
  -# the end of each request
  +# 'SetHandler perl-script', combined with 'PerlOptions -SetupEnv', or
  +# 'SetHandler modperl' do not populate %ENV with CGI variables.  So in
  +# this test we call $r->subprocess_env, which adds them on demand, and
  +# we are able to get the cookie via %ENV.
  +#
  +# the last sub-test makes sure that mod_cgi env vars don't persist 
  +# and are properly re-set at the end of each request.
   #
   # since the test is run against the same interpreter we also test that
   # the cookie value doesn't persist if it makes it to %ENV.
  
  
  
  1.1                  modperl-2.0/t/modperl/setupenv.t
  
  Index: setupenv.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestRequest qw(GET_BODY_ASSERT);
  use Apache::Test;
  use Apache::TestUtil;
  
  my $module   = "TestModperl::setupenv";
  Apache::TestRequest::module($module);
  
  my $config   = Apache::Test::config();
  my $hostport = Apache::TestRequest::hostport($config);
  my $path     = Apache::TestRequest::module2path($module);
  
  my $base = "http://$hostport/$path";
  
  t_debug("connecting to $base");
  
  my @locations = ("${base}_mpdefault",
                   "${base}_mpsetup",
                   "${base}_mpdefault",  # make sure %ENV is cleared
                   "${base}_mpvoid",
                   "${base}_mpsetupvoid",
                   "${base}_psdefault",
                   "${base}_psnosetup",
                   "${base}_psvoid",
                   "${base}_psnosetupvoid");
  
  # plan the tests from a handler so we can run
  # tests from within handlers across multiple requests
  #
  # this requires keepalives and a per-connection interpreter
  # to make certain we can plan in one request and test in another
  
  Apache::TestRequest::user_agent(keep_alive => 1);
  print GET_BODY_ASSERT join '?', $base, scalar @locations;
  
  # this tests for when %ENV is populated with CGI variables
  # as well as the contents of the subprocess_env table
  #
  # see setupenv.pm for a full description of the tests
  
  foreach my $location (@locations) {
  
      t_debug("trying $location");
  
      print GET_BODY_ASSERT $location;
  }
  
  
  
  1.3       +54 -12    modperl-2.0/t/response/TestDirective/env.pm
  
  Index: env.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/env.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- env.pm	11 Apr 2002 11:08:44 -0000	1.2
  +++ env.pm	12 Feb 2004 23:06:24 -0000	1.3
  @@ -14,21 +14,43 @@
   sub handler {
       my $r = shift;
   
  -    plan $r, tests => 4;
  +    plan $r, tests => 8;
   
  -    ok t_cmp('env_dir1', env_get('srv1'),
  -             'per-dir override per-srv');
  +    # %ENV
  +    ok t_cmp('env_dir1', 
  +             env_get('srv1'),
  +             '%ENV per-dir override per-srv');
  +
  +    ok t_cmp('env_srv2', 
  +             env_get('srv2'),
  +             '%ENV per-srv');
  +
  +    ok t_cmp('env_dir2', 
  +             env_get('dir2'),
  +             '%ENV per-dir');
   
  -    ok t_cmp('env_srv2', env_get('srv2'),
  -             'per-srv');
  +    # setup by Apache::TestRun
  +    ok t_cmp('test.host.name',
  +             $ENV{APACHE_TEST_HOSTNAME},
  +             '%ENV PerlPassEnv');
   
  -    ok t_cmp('env_dir2', env_get('dir2'),
  -             'per-dir');
  +    # $r->subprocess_env
  +    ok t_cmp('env_dir1', 
  +             env_get('srv1', $r),
  +             '$r->subprocess_env per-dir override per-srv');
  +
  +    ok t_cmp('env_srv2', 
  +             env_get('srv2', $r),
  +             '$r->subprocess_env per-srv');
  +
  +    ok t_cmp('env_dir2', 
  +             env_get('dir2', $r),
  +             '$r->subprocess_env per-dir');
   
  -    #setup by Apache::TestRun
  +    # setup by Apache::TestRun
       ok t_cmp('test.host.name',
  -             $ENV{APACHE_TEST_HOSTNAME},
  -             'PassEnv');
  +             $r->subprocess_env->get('APACHE_TEST_HOSTNAME'),
  +             '$r->subprocess_env PerlPassEnv');
   
       Apache::OK;
   }
  @@ -36,23 +58,43 @@
   sub env_get {
       my($name, $r) = @_;
       my $key = 'TestDirective__env_' . $name;
  -    return $r ? $r->subprocess_env->get($key) : $ENV{$key};
  +
  +    my $value = $ENV{$key};
  +
  +    if ($r) {
  +        my @values = $r->subprocess_env->get($key);
  +
  +        if (@values > 1) {
  +            $value = "too many values for $key!";
  +        }
  +        else {
  +            $value = $values[0];
  +        }
  +    }
  +
  +    return $value;
   }
   
   1;
   __END__
  -PerlOptions +SetupEnv
  +# SetupEnv ought to have no effect on PerlSetEnv or PerlPassEnv
  +PerlOptions -SetupEnv
   
   <Base>
  +    # per-server entry overwritten by per-directory entry
       PerlSetEnv TestDirective__env_srv1 env_srv1
   
  +    # per-server entry not overwritten
       PerlSetEnv TestDirective__env_srv2 env_srv2
   
  +    # PerlPassEnv is only per-server
       PerlPassEnv APACHE_TEST_HOSTNAME
   </Base>
   
  +# per-directory entry overwrites per-server
   PerlSetEnv TestDirective__env_srv1 env_dir1
   
  +# PerlSetEnv resets the table for each directive
   PerlSetEnv TestDirective__env_dir2 ToBeLost
   PerlSetEnv TestDirective__env_dir2 env_dir2
   
  
  
  
  1.2       +4 -4      modperl-2.0/t/response/TestModperl/cookie.pm
  
  Index: cookie.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestModperl/cookie.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- cookie.pm	22 Sep 2003 23:34:45 -0000	1.1
  +++ cookie.pm	12 Feb 2004 23:06:24 -0000	1.2
  @@ -13,6 +13,9 @@
   sub access {
       my $r = shift;
   
  +    # setup CGI variables early
  +    $r->subprocess_env() if $r->args eq 'env';
  +
       my($key, $val) = cookie($r);
       my $cookie_is_expected =
           ($r->args eq 'header' or $r->args eq 'env') ? 1 : 0;
  @@ -48,7 +51,4 @@
   PerlInitHandler     Apache::TestHandler::same_interp_fixup
   PerlAccessHandler   TestModperl::cookie::access
   PerlResponseHandler TestModperl::cookie
  -# PerlOptions +SetupEnv is needed here, because we want the mod_cgi
  -# env to be set at the access phase. without it, perl-script sets it
  -# only for the response phase
  -PerlOptions +SetupEnv
  +PerlOptions -SetupEnv
  
  
  
  1.1                  modperl-2.0/t/response/TestModperl/setupenv.pm
  
  Index: setupenv.pm
  ===================================================================
  package TestModperl::setupenv;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use APR::Table ();
  
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::Const -compile => qw(OK DECLINED);
  
  sub handler {
  
      my $r = shift;
  
      # how many different URIs will be hit?
      my $requests = $r->args;
  
      # $requests locations with 7 tests each
      plan $r, tests => $requests * 7;
  
      return Apache::OK;
  }
  
  sub env {
  
      my $r = shift;
  
      Apache::Test::init_test_pm($r);  # tie STDOUT
  
      (my $value) = $r->uri =~ /TestModperl__setupenv_(\w+)/;
  
      ok t_cmp(Apache::Test::vars('remote_addr'),
               $ENV{REMOTE_ADDR},
               'found REMOTE_ADDR in %ENV');
  
      ok t_cmp('server',
               $ENV{SRV_SUBPROCESS},
               'found subprocess_env table entry SRV_SUBPROCESS in %ENV');
  
      ok t_cmp($value,
               $ENV{DIR_SUBPROCESS},
               'found subprocess_env table entry DIR_SUBPROCESS in %ENV');
  
      ok t_cmp($value,
               $ENV{DIR_SETENV},
               'found per-directory SetEnv entry in %ENV');
  
      ok t_cmp('server',
               $ENV{SRV_SETENV},
               'found per-server SetEnv entry in %ENV');
  
      # PerlSetEnv always set
      ok t_cmp($value,
               $ENV{DIR_PERLSETENV},
               'found per-directory PerlSetEnv entry in %ENV');
  
      ok t_cmp('server',
               $ENV{SRV_PERLSETENV},
               'found per-server PerlSetEnv entry in %ENV');
  
      return Apache::OK;
  }
  
  sub noenv {
  
      my $r = shift;
  
      Apache::Test::init_test_pm($r);  # tie STDOUT
  
      (my $value) = $r->uri =~ /TestModperl__setupenv_(\w+)/;
  
      ok t_cmp(undef,
               $ENV{REMOTE_ADDR},
               'REMOTE_ADDR not found in %ENV');
  
      ok t_cmp(undef,
               $ENV{SRV_SUBPROCESS},
               'subprocess_env table entry SRV_SUBPROCESS not found in %ENV');
  
      ok t_cmp(undef,
               $ENV{DIR_SUBPROCESS},
               'subprocess_env table entry DIR_SUBPROCESS not found in %ENV');
  
      ok t_cmp(undef,
               $ENV{DIR_SETENV},
               'per-directory SetEnv entry not found in %ENV');
  
      ok t_cmp(undef,
               $ENV{SRV_SETENV},
               'per-server SetEnv entry not found in %ENV');
  
      # PerlSetEnv always set
      ok t_cmp($value,
               $ENV{DIR_PERLSETENV},
               'found per-directory PerlSetEnv entry in %ENV');
  
      ok t_cmp('server',
               $ENV{SRV_PERLSETENV},
               'found per-server PerlSetEnv entry in %ENV');
  
      return Apache::OK;
  }
  
  sub someenv {
  
      my $r = shift;
  
      Apache::Test::init_test_pm($r);  # tie STDOUT
  
      (my $value) = $r->uri =~ /TestModperl__setupenv_(\w+)/;
  
      ok t_cmp(Apache::Test::vars('remote_addr'),
               $ENV{REMOTE_ADDR},
               'found REMOTE_ADDR in %ENV');
  
      # set before void call
      ok t_cmp('server',
               $ENV{SRV_SUBPROCESS},
               'found subprocess_env table entry one in %ENV');
  
      ok t_cmp(undef,
               $ENV{DIR_SUBPROCESS},
               'subprocess_env table entry DIR_SUBPROCESS not found in %ENV');
  
      ok t_cmp(undef,
               $ENV{DIR_SETENV},
               'per-directory SetEnv entry not found in %ENV');
  
      ok t_cmp(undef,
               $ENV{SRV_SETENV},
               'per-server SetEnv entry not found in %ENV');
  
      # PerlSetEnv always set
      ok t_cmp($value,
               $ENV{DIR_PERLSETENV},
               'found per-directory PerlSetEnv entry in %ENV');
  
      ok t_cmp('server',
               $ENV{SRV_PERLSETENV},
               'found per-server PerlSetEnv entry in %ENV');
  
      return Apache::OK;
  }
  
  sub subenv_void {
  
      shift->subprocess_env;
  
      return Apache::OK;
  }
  
  sub subenv_one {
  
      shift->subprocess_env->set(SRV_SUBPROCESS => 'server');
  
      return Apache::OK;
  }
  
  sub subenv_two {
  
      my $r = shift;
  
      (my $value) = $r->uri =~ /TestModperl__setupenv_(\w+)/;
  
      $r->subprocess_env->set(DIR_SUBPROCESS => $value);
  
      return Apache::OK;
  }
  
  1;
  __DATA__
  # create a separate virtual host so we can use
  # keepalives - a per-connection interpreter is
  # the only way to make sure that we can plan in
  # one request and test in subsequent tests
  <NoAutoConfig>
  <VirtualHost TestModperl::setupenv>
  
      KeepAlive On
  
      <IfDefine PERL_ITHREADS>
          PerlInterpScope connection
      </Ifdefine>
  
      PerlModule TestModperl::setupenv
  
      PerlPostReadRequestHandler TestModperl::setupenv::subenv_one
  
      # SetEnv is affected by +SetupEnv
      SetEnv SRV_SETENV server
  
      # PerlSetEnv is not affected by +SetupEnv or -SetupEnv
      # it is entirely separate and always set if configured
      PerlSetEnv SRV_PERLSETENV server
  
      # plan
      <Location /TestModperl__setupenv>
          SetHandler modperl
          PerlResponseHandler TestModperl::setupenv
      </Location>
  
      # default modperl handler
      # %ENV should not contain standard CGI variables
      # or entries from the subprocess_env table
      <Location /TestModperl__setupenv_mpdefault>
          SetHandler modperl
          PerlResponseHandler TestModperl::setupenv::noenv
  
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV mpdefault
          PerlSetEnv DIR_PERLSETENV mpdefault
      </Location>
  
      # modperl handler + SetupEnv
      # %ENV should contain CGI variables as well as
      # anything put into the subprocess_env table
      <Location /TestModperl__setupenv_mpsetup>
          SetHandler modperl
          PerlResponseHandler TestModperl::setupenv::env
  
          PerlOptions +SetupEnv
  
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV mpsetup
          PerlSetEnv DIR_PERLSETENV mpsetup
      </Location>
  
      # $r->subprocess_env in a void context with no args
      # should do the same as +SetupEnv wrt CGI variables
      # and entries already in the subprocess_env table
      # but subprocess_env entries that appear later will
      # not show up in %ENV
      <Location /TestModperl__setupenv_mpvoid>
          SetHandler modperl
          PerlResponseHandler TestModperl::setupenv::someenv
  
          PerlHeaderParserHandler TestModperl::setupenv::subenv_void
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV mpvoid
          PerlSetEnv DIR_PERLSETENV mpvoid
      </Location>
  
      # +SetupEnv should always populate %ENV fully prior
      # to running the content handler (regardless of when
      # $r->subprocess_env() was called) to ensure that
      # %ENV is an accurate representation of the
      # subprocess_env table
      <Location /TestModperl__setupenv_mpsetupvoid>
          SetHandler modperl
          PerlResponseHandler TestModperl::setupenv::env
  
          PerlOptions +SetupEnv
      
          PerlHeaderParserHandler TestModperl::setupenv::subenv_void
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV mpsetupvoid
          PerlSetEnv DIR_PERLSETENV mpsetupvoid
      </Location>
  
      # default perl-script handler is equivalent to +SetupEnv
      # CGI variables and subprocess_env entries will be in %ENV
      <Location /TestModperl__setupenv_psdefault>
          SetHandler perl-script
          PerlResponseHandler TestModperl::setupenv::env
  
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV psdefault
          PerlSetEnv DIR_PERLSETENV psdefault
      </Location>
  
      # -SetupEnv should not put CGI variables or subprocess_env
      # entries in %ENV
      <Location /TestModperl__setupenv_psnosetup>
          SetHandler perl-script
          PerlResponseHandler TestModperl::setupenv::noenv
  
          PerlOptions -SetupEnv
  
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV psnosetup
          PerlSetEnv DIR_PERLSETENV psnosetup
      </Location>
  
      # +SetupEnv should always populate %ENV fully prior
      # to running the content handler (regardless of when
      # $r->subprocess_env() was called) to ensure that
      # %ENV is an accurate representation of the
      # subprocess_env table
      <Location /TestModperl__setupenv_psvoid>
          SetHandler perl-script
          PerlResponseHandler TestModperl::setupenv::env
  
          PerlHeaderParserHandler TestModperl::setupenv::subenv_void
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV psvoid
          PerlSetEnv DIR_PERLSETENV psvoid
      </Location>
  
      # equivalent to modperl handler with $r->subprocess_env() - 
      # CGI variables are there, but not subprocess_env entries
      # that are populated after the void call
      <Location /TestModperl__setupenv_psnosetupvoid>
          SetHandler perl-script
          PerlResponseHandler TestModperl::setupenv::someenv
  
          PerlOptions -SetupEnv
  
          PerlHeaderParserHandler TestModperl::setupenv::subenv_void
          PerlFixupHandler TestModperl::setupenv::subenv_two
  
          SetEnv DIR_SETENV psnosetupvoid
          PerlSetEnv DIR_PERLSETENV psnosetupvoid
      </Location>
  </VirtualHost>
  </NoAutoConfig>
  
  
  
  1.12      +1 -4      modperl-2.0/xs/Apache/RequestRec/Apache__RequestRec.h
  
  Index: Apache__RequestRec.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestRec/Apache__RequestRec.h,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -r1.11 -r1.12
  --- Apache__RequestRec.h	9 Feb 2004 23:17:12 -0000	1.11
  +++ Apache__RequestRec.h	12 Feb 2004 23:06:24 -0000	1.12
  @@ -47,12 +47,9 @@
                                              char *key, SV *val)
   {
       /* if called in a void context with no arguments, just
  -     * populate %ENV and stop.  resetting SetupEnv off makes
  -     * calling in a void context more than once meaningful.
  +     * populate %ENV and stop.
        */
       if (key == NULL && GIMME_V == G_VOID) {
  -        MP_dRCFG;
  -        MpReqSETUP_ENV_Off(rcfg); 
           modperl_env_request_populate(aTHX_ r);
           return &PL_sv_undef;
       }
  
  
  

Mime
View raw message