Author: stas Date: Wed Jan 5 21:35:16 2005 New Revision: 124345 URL: http://svn.apache.org/viewcvs?view=rev&rev=124345 Log: Make PerlSetEnv, PerlPassEnv and %ENV in PerlRequre, PerlModule, PerlConfigRequire and PerlPostConfigRequire affect each, so a change in one of these immediately seen in the others. + tests
Added: perl/modperl/trunk/t/htdocs/modperl/ perl/modperl/trunk/t/htdocs/modperl/setupenv2/ perl/modperl/trunk/t/htdocs/modperl/setupenv2/config_require.pl perl/modperl/trunk/t/htdocs/modperl/setupenv2/module.pm (contents, props changed) perl/modperl/trunk/t/htdocs/modperl/setupenv2/post_config_require.pl perl/modperl/trunk/t/htdocs/modperl/setupenv2/require.pl perl/modperl/trunk/t/modperl/setupenv2.t (contents, props changed) perl/modperl/trunk/t/response/TestModperl/setupenv2.pm (contents, props changed) Modified: perl/modperl/trunk/Changes perl/modperl/trunk/src/modules/perl/modperl_cmd.c perl/modperl/trunk/src/modules/perl/modperl_config.c perl/modperl/trunk/src/modules/perl/modperl_env.c perl/modperl/trunk/src/modules/perl/modperl_env.h perl/modperl/trunk/src/modules/perl/modperl_types.h Modified: perl/modperl/trunk/Changes Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=124345&p1=perl/modperl/trunk/Changes&r1=124344&p2=perl/modperl/trunk/Changes&r2=124345 ============================================================================== --- perl/modperl/trunk/Changes (original) +++ perl/modperl/trunk/Changes Wed Jan 5 21:35:16 2005 @@ -12,6 +12,13 @@ =item 1.999_21-dev +Make PerlSetEnv, PerlPassEnv and %ENV in PerlRequre, PerlModule, +PerlConfigRequire and PerlPostConfigRequire affect each, so a change +in one of these immediately seen in the others. [Pratik <pratiknaik +gmail.com>, Stas] + + + =item 1.999_20 - January 5, 2005 the autogenerated modules (and some implemented in xs/ modules) are Modified: perl/modperl/trunk/src/modules/perl/modperl_cmd.c Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_cmd.c?view=diff&rev=124345&p1=perl/modperl/trunk/src/modules/perl/modperl_cmd.c&r1=124344&p2=perl/modperl/trunk/src/modules/perl/modperl_cmd.c&r2=124345 ============================================================================== --- perl/modperl/trunk/src/modules/perl/modperl_cmd.c (original) +++ perl/modperl/trunk/src/modules/perl/modperl_cmd.c Wed Jan 5 21:35:16 2005 @@ -133,30 +133,26 @@ return NULL; } +/* this test shows whether the perl for the current s is running + * (either base or vhost) */ static int modperl_vhost_is_running(server_rec *s) { #ifdef USE_ITHREADS - MP_dSCFG(s); - int is_vhost = (s != modperl_global_get_server_rec()); - - if (is_vhost && scfg->mip) { - return TRUE; - } - else { - return FALSE; + if (s->is_virtual){ + MP_dSCFG(s); + return scfg->mip ? TRUE : FALSE; } -#else - return modperl_is_running(); #endif + + return modperl_is_running(); + } MP_CMD_SRV_DECLARE(switches) { server_rec *s = parms->server; MP_dSCFG(s); - if (s->is_virtual - ? modperl_vhost_is_running(s) - : modperl_is_running() ) { + if (modperl_vhost_is_running(s)) { return modperl_cmd_too_late(parms); } MP_TRACE_d(MP_FUNC, "arg = %s\n", arg); @@ -167,6 +163,7 @@ MP_CMD_SRV_DECLARE(modules) { MP_dSCFG(parms->server); + modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; MP_PERL_CONTEXT_DECLARE; MP_CHECK_SERVER_OR_HTACCESS_CONTEXT; @@ -186,6 +183,10 @@ if (!modperl_require_module(aTHX_ arg, FALSE)) { error = SvPVX(ERRSV); } + else { + modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg); + modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg); + } MP_PERL_CONTEXT_RESTORE; return error; @@ -200,6 +201,7 @@ MP_CMD_SRV_DECLARE(requires) { MP_dSCFG(parms->server); + modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; MP_PERL_CONTEXT_DECLARE; MP_CHECK_SERVER_OR_HTACCESS_CONTEXT; @@ -219,6 +221,10 @@ if (!modperl_require_file(aTHX_ arg, FALSE)) { error = SvPVX(ERRSV); } + else { + modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg); + modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg); + } MP_PERL_CONTEXT_RESTORE; return error; @@ -244,15 +250,19 @@ MP_CMD_SRV_DECLARE(post_config_requires) { apr_pool_t *p = parms->temp_pool; + modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; apr_finfo_t finfo; MP_dSCFG(parms->server); if (APR_SUCCESS == apr_stat(&finfo, arg, APR_FINFO_TYPE, p)) { if (finfo.filetype != APR_NOFILE) { MP_TRACE_d(MP_FUNC, "push PerlPostConfigRequire for %s\n", arg); - - *(const char **) - apr_array_push(scfg->PerlPostConfigRequire) = arg; + modperl_require_file_t *require = apr_pcalloc(p, sizeof(*require)); + require->file = arg; + require->dcfg = dcfg; + + *(modperl_require_file_t **) + apr_array_push(scfg->PerlPostConfigRequire) = require; } } else { @@ -331,6 +341,13 @@ if (!parms->path) { /* will be propagated to environ */ apr_table_setn(scfg->SetEnv, arg1, arg2); + /* sync SetEnv => %ENV only for the top-level values */ + if (modperl_vhost_is_running(parms->server)) { + MP_PERL_CONTEXT_DECLARE; + MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); + modperl_env_hv_store(aTHX_ arg1, arg2); + MP_PERL_CONTEXT_RESTORE; + } } apr_table_setn(dcfg->SetEnv, arg1, arg2); @@ -353,6 +370,12 @@ if (val) { apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val)); + if (modperl_vhost_is_running(parms->server)) { + MP_PERL_CONTEXT_DECLARE; + MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); + modperl_env_hv_store(aTHX_ arg, val); + MP_PERL_CONTEXT_RESTORE; + } MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val); } else { @@ -368,7 +391,7 @@ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; int is_per_dir = parms->path ? 1 : 0; modperl_options_t *opts = is_per_dir ? dcfg->flags : scfg->flags; - apr_pool_t *p = parms->pool; + apr_pool_t *p = parms->temp_pool; const char *error; MP_TRACE_d(MP_FUNC, "arg = %s\n", arg); @@ -473,16 +496,15 @@ MP_CMD_SRV_DECLARE(perldo) { - apr_pool_t *p = parms->temp_pool; + apr_pool_t *p = parms->pool; server_rec *s = parms->server; + modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; apr_table_t *options; modperl_handler_t *handler = NULL; const char *pkg_name = NULL; ap_directive_t *directive = parms->directive; -#ifdef USE_ITHREADS MP_dSCFG(s); MP_PERL_CONTEXT_DECLARE; -#endif if (!(arg && *arg)) { return NULL; @@ -541,6 +563,8 @@ save_scalar(gv); /* local $0 */ sv_setpv_mg(GvSV(gv), directive->filename); eval_pv(arg, FALSE); + modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg); + modperl_env_sync_dir_env_hash2table(aTHX_ p, dcfg); FREETMPS;LEAVE; } Modified: perl/modperl/trunk/src/modules/perl/modperl_config.c Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_config.c?view=diff&rev=124345&p1=perl/modperl/trunk/src/modules/perl/modperl_config.c&r1=124344&p2=perl/modperl/trunk/src/modules/perl/modperl_config.c&r2=124345 ============================================================================== --- perl/modperl/trunk/src/modules/perl/modperl_config.c (original) +++ perl/modperl/trunk/src/modules/perl/modperl_config.c Wed Jan 5 21:35:16 2005 @@ -21,6 +21,8 @@ dcfg->location = dir; + MP_TRACE_d(MP_FUNC, "dir %s\n", dir); + #ifdef USE_ITHREADS /* defaults to per-server scope */ dcfg->interp_scope = MP_INTERP_SCOPE_UNDEF; @@ -107,8 +109,9 @@ *add = (modperl_config_dir_t *)addv, *mrg = modperl_config_dir_new(p); - MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n", - (unsigned long)basev, (unsigned long)addv); + MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx\n", + (unsigned long)basev, (unsigned long)addv, + (unsigned long)mrg); #ifdef USE_ITHREADS merge_item(interp_scope); @@ -155,7 +158,8 @@ scfg->PerlModule = apr_array_make(p, 2, sizeof(char *)); scfg->PerlRequire = apr_array_make(p, 2, sizeof(char *)); - scfg->PerlPostConfigRequire = apr_array_make(p, 1, sizeof(char *)); + scfg->PerlPostConfigRequire = + apr_array_make(p, 1, sizeof(modperl_require_file_t *)); scfg->argv = apr_array_make(p, 2, sizeof(char *)); @@ -280,8 +284,9 @@ *add = (modperl_config_srv_t *)addv, *mrg = modperl_config_srv_new(p); - MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n", - (unsigned long)basev, (unsigned long)addv); + MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx\n", + (unsigned long)basev, (unsigned long)addv, + (unsigned long)mrg); merge_item(modules); merge_item(PerlModule); @@ -443,26 +448,28 @@ modperl_config_srv_t *scfg, apr_pool_t *p) { - char **requires; + modperl_require_file_t **requires; int i; MP_PERL_CONTEXT_DECLARE; - requires = (char **)scfg->PerlPostConfigRequire->elts; + requires = (modperl_require_file_t **)scfg->PerlPostConfigRequire->elts; for (i = 0; i < scfg->PerlPostConfigRequire->nelts; i++){ int retval; MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); - retval = modperl_require_file(aTHX_ requires[i], TRUE); + retval = modperl_require_file(aTHX_ requires[i]->file, TRUE); + modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg); + modperl_env_sync_dir_env_hash2table(aTHX_ p, requires[i]->dcfg); MP_PERL_CONTEXT_RESTORE; if (retval) { MP_TRACE_d(MP_FUNC, "loaded Perl file: %s for server %s\n", - requires[i], modperl_server_desc(s, p)); + requires[i]->file, modperl_server_desc(s, p)); } else { ap_log_error(APLOG_MARK, APLOG_ERR, 0, s, "Can't load Perl file: %s for server %s, exiting...", - requires[i], modperl_server_desc(s, p)); + requires[i]->file, modperl_server_desc(s, p)); return FALSE; } Modified: perl/modperl/trunk/src/modules/perl/modperl_env.c Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_env.c?view=diff&rev=124345&p1=perl/modperl/trunk/src/modules/perl/modperl_env.c&r1=124344&p2=perl/modperl/trunk/src/modules/perl/modperl_env.c&r2=124345 ============================================================================== --- perl/modperl/trunk/src/modules/perl/modperl_env.c (original) +++ perl/modperl/trunk/src/modules/perl/modperl_env.c Wed Jan 5 21:35:16 2005 @@ -28,23 +28,27 @@ #endif } -static MP_INLINE -void modperl_env_hv_store(pTHX_ HV *hv, apr_table_entry_t *elt) -{ - I32 klen = strlen(elt->key); - SV **svp = hv_fetch(hv, elt->key, klen, FALSE); - - if (svp) { - sv_setpv(*svp, elt->val); - } - else { - SV *sv = newSVpv(elt->val, 0); - hv_store(hv, elt->key, klen, sv, FALSE); - modperl_envelem_tie(sv, elt->key, klen); - svp = &sv; - } +#define MP_ENV_HV_STORE(hv, key, val) STMT_START { \ + I32 klen = strlen(key); \ + SV **svp = hv_fetch(hv, key, klen, FALSE); \ + \ + if (svp) { \ + sv_setpv(*svp, val); \ + } \ + else { \ + SV *sv = newSVpv(val, 0); \ + hv_store(hv, key, klen, sv, FALSE); \ + modperl_envelem_tie(sv, key, klen); \ + svp = &sv; \ + } \ + MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", key, val); \ + \ + SvTAINTED_on(*svp); \ + } STMT_END - SvTAINTED_on(*svp); +void modperl_env_hv_store(pTHX_ const char *key, const char *val) +{ + MP_ENV_HV_STORE(ENVHV, key, val); } static MP_INLINE @@ -98,6 +102,9 @@ modperl_env_tie(mg_flags); } +#define MP_ENV_HV_STORE_TABLE_ENTRY(hv, elt) \ + MP_ENV_HV_STORE(hv, elt.key, elt.val); + static void modperl_env_table_populate(pTHX_ apr_table_t *table) { HV *hv = ENVHV; @@ -115,9 +122,7 @@ if (!elts[i].key || !elts[i].val) { continue; } - modperl_env_hv_store(aTHX_ hv, &elts[i]); - - MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", elts[i].key, elts[i].val); + MP_ENV_HV_STORE_TABLE_ENTRY(hv, elts[i]); } modperl_env_tie(mg_flags); @@ -141,11 +146,58 @@ continue; } modperl_env_hv_delete(aTHX_ hv, elts[i].key); - MP_TRACE_e(MP_FUNC, "delete $ENV{%s};", elts[i].key); - } + } modperl_env_tie(mg_flags); +} + +/* see the comment in modperl_env_sync_env_hash2table */ +static void modperl_env_sync_table(pTHX_ apr_table_t *table) +{ + int i; + const apr_array_header_t *array; + apr_table_entry_t *elts; + HV *hv = ENVHV; + SV **svp; + + array = apr_table_elts(table); + elts = (apr_table_entry_t *)array->elts; + + for (i = 0; i < array->nelts; i++) { + if (!elts[i].key) { + continue; + } + svp = hv_fetch(hv, elts[i].key, strlen(elts[i].key), FALSE); + if (svp) { + apr_table_set(table, elts[i].key, SvPV_nolen(*svp)); + MP_TRACE_e(MP_FUNC, "(Set|Pass)Env '%s' '%s'", elts[i].key, + SvPV_nolen(*svp)); + } + } + TAINT_NOT; /* SvPV_* causes the taint issue */ +} + +/* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV at + * config time (if perl is running), by copying %ENV values to the + * PerlSetEnv and PerlPassEnv tables (only for keys which are already + * in those tables) + */ +void modperl_env_sync_srv_env_hash2table(pTHX_ apr_pool_t *p, + modperl_config_srv_t *scfg) +{ + MP_TRACE_d(MP_FUNC, "******* scfg==0x%lx, scfg->SetEnv==0x%lx\n", + (unsigned long)scfg, (unsigned long)scfg->SetEnv); + modperl_env_sync_table(aTHX_ scfg->SetEnv); + modperl_env_sync_table(aTHX_ scfg->PassEnv); +} + +void modperl_env_sync_dir_env_hash2table(pTHX_ apr_pool_t *p, + modperl_config_dir_t *dcfg) +{ + MP_TRACE_d(MP_FUNC, "******* dcfg==0x%lx, dcfg->SetEnv==0x%lx\n", + (unsigned long)dcfg, (unsigned long)dcfg->SetEnv); + modperl_env_sync_table(aTHX_ dcfg->SetEnv); } /* list of environment variables to pass by default */ Modified: perl/modperl/trunk/src/modules/perl/modperl_env.h Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_env.h?view=diff&rev=124345&p1=perl/modperl/trunk/src/modules/perl/modperl_env.h&r1=124344&p2=perl/modperl/trunk/src/modules/perl/modperl_env.h&r2=124345 ============================================================================== --- perl/modperl/trunk/src/modules/perl/modperl_env.h (original) +++ perl/modperl/trunk/src/modules/perl/modperl_env.h Wed Jan 5 21:35:16 2005 @@ -33,6 +33,14 @@ void modperl_env_clear(pTHX); +void modperl_env_hv_store(pTHX_ const char *key, const char *val); + +void modperl_env_sync_srv_env_hash2table(pTHX_ apr_pool_t *p, + modperl_config_srv_t *scfg); + +void modperl_env_sync_dir_env_hash2table(pTHX_ apr_pool_t *p, + modperl_config_dir_t *dcfg); + void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s); void modperl_env_configure_request_srv(pTHX_ request_rec *r); Modified: perl/modperl/trunk/src/modules/perl/modperl_types.h Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_types.h?view=diff&rev=124345&p1=perl/modperl/trunk/src/modules/perl/modperl_types.h&r1=124344&p2=perl/modperl/trunk/src/modules/perl/modperl_types.h&r2=124345 ============================================================================== --- perl/modperl/trunk/src/modules/perl/modperl_types.h (original) +++ perl/modperl/trunk/src/modules/perl/modperl_types.h Wed Jan 5 21:35:16 2005 @@ -165,6 +165,11 @@ #endif } modperl_config_dir_t; +typedef struct { + const char *file; + modperl_config_dir_t *dcfg; +} modperl_require_file_t; + typedef struct modperl_mgv_t modperl_mgv_t; struct modperl_mgv_t { Added: perl/modperl/trunk/t/htdocs/modperl/setupenv2/config_require.pl Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/htdocs/modperl/setupenv2/config_require.pl?view=auto&rev=124345 ============================================================================== --- (empty file) +++ perl/modperl/trunk/t/htdocs/modperl/setupenv2/config_require.pl Wed Jan 5 21:35:16 2005 @@ -0,0 +1,5 @@ +TestModperl::setupenv2::register_mixed(); +TestModperl::setupenv2::register_perl(); +$ENV{EnvChangeMixedTest} = "config_require"; +$ENV{EnvChangePerlTest} = "config_require"; +1; Added: perl/modperl/trunk/t/htdocs/modperl/setupenv2/module.pm Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/htdocs/modperl/setupenv2/module.pm?view=auto&rev=124345 ============================================================================== --- (empty file) +++ perl/modperl/trunk/t/htdocs/modperl/setupenv2/module.pm Wed Jan 5 21:35:16 2005 @@ -0,0 +1,6 @@ +package htdocs::modperl::setupenv2::module; +TestModperl::setupenv2::register_mixed(); +TestModperl::setupenv2::register_perl(); +$ENV{EnvChangeMixedTest} = "perlmodule"; +$ENV{EnvChangePerlTest} = "perlmodule"; +1; Added: perl/modperl/trunk/t/htdocs/modperl/setupenv2/post_config_require.pl Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/htdocs/modperl/setupenv2/post_config_require.pl?view=auto&rev=124345 ============================================================================== --- (empty file) +++ perl/modperl/trunk/t/htdocs/modperl/setupenv2/post_config_require.pl Wed Jan 5 21:35:16 2005 @@ -0,0 +1,5 @@ +TestModperl::setupenv2::register_mixed(); +TestModperl::setupenv2::register_perl(); +$ENV{EnvChangeMixedTest} = "post_config_require"; +$ENV{EnvChangePerlTest} = "post_config_require"; +1; Added: perl/modperl/trunk/t/htdocs/modperl/setupenv2/require.pl Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/htdocs/modperl/setupenv2/require.pl?view=auto&rev=124345 ============================================================================== --- (empty file) +++ perl/modperl/trunk/t/htdocs/modperl/setupenv2/require.pl Wed Jan 5 21:35:16 2005 @@ -0,0 +1,5 @@ +TestModperl::setupenv2::register_mixed(); +TestModperl::setupenv2::register_perl(); +$ENV{EnvChangeMixedTest} = "require"; +$ENV{EnvChangePerlTest} = "require"; +1; Added: perl/modperl/trunk/t/modperl/setupenv2.t Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/modperl/setupenv2.t?view=auto&rev=124345 ============================================================================== --- (empty file) +++ perl/modperl/trunk/t/modperl/setupenv2.t Wed Jan 5 21:35:16 2005 @@ -0,0 +1,35 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestUtil; +use Apache::TestRequest; + +my $location = "/TestModperl__setupenv2"; + +my %expected = ( + mixed => [qw(loadmodule conf1 <perl> conf2 require conf3 + config_require conf4 perlmodule conf5 conf5 + conf6 conf7 conf8 post_config_require)], + perl => [qw(loadmodule <perl> require config_require + perlmodule post_config_require)], +); + +plan tests => 2 + scalar(@{ $expected{mixed} }) + scalar(@{ $expected{perl} }); + +while (my($k, $v) = each %expected) { + my @expected = @$v; + my $elements = scalar @expected; + my $received = GET_BODY "$location?$k"; + t_debug "$k: $received"; + my @received = split / /, $received; + + ok t_cmp $received[$_], $expected[$_] for 0..$#expected; + + ok t_cmp scalar(@received), scalar(@expected), "elements"; + if (@received > @expected) { + t_debug "unexpected elements: " . + join " ", @received[$elements..$#received]; + } +} + Added: perl/modperl/trunk/t/response/TestModperl/setupenv2.pm Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestModperl/setupenv2.pm?view=auto&rev=124345 ============================================================================== --- (empty file) +++ perl/modperl/trunk/t/response/TestModperl/setupenv2.pm Wed Jan 5 21:35:16 2005 @@ -0,0 +1,134 @@ +package TestModperl::setupenv2; + +# Test the mixing of PerlSetEnv in httpd.conf and %ENV of the same +# key in PerlRequire, PerlConfigRequire, PerlPostConfigRequire and +# <Perl> sections + +use strict; +use warnings FATAL => 'all'; + +use Apache::Const -compile => qw(OK OR_ALL NO_ARGS); + +use Apache::CmdParms (); +use Apache::Module (); +use Apache::RequestIO (); +use Apache::RequestRec (); + +my @directives = ( + { + name => 'MyEnvRegister', + func => __PACKAGE__ . '::MyEnvRegister', + req_override => Apache::OR_ALL, + args_how => Apache::NO_ARGS, + errmsg => 'cannot fail :)', + }, +); + +Apache::Module::add(__PACKAGE__, [EMAIL PROTECTED]); + +# testing PerlLoadModule +$ENV{EnvChangeMixedTest} = 'loadmodule'; +$ENV{EnvChangePerlTest} = 'loadmodule'; + +sub MyEnvRegister { + register_mixed(); +} + +sub register_mixed { + push @TestModperl::setupenv2::EnvChangeMixedTest, + $ENV{EnvChangeMixedTest} || 'notset'; +} + +sub register_perl { + push @TestModperl::setupenv2::EnvChangePerlTest, + $ENV{EnvChangePerlTest} || 'notset'; +} + +sub get_config { + my($self, $s) = (shift, shift); + Apache::Module::get_config($self, $s, @_); +} + +sub handler { + my($r) = @_; + + my $args = $r->args || ''; + + $r->content_type('text/plain'); + + if ($args eq 'mixed') { + my @vals = (@TestModperl::setupenv2::EnvChangeMixedTest, + $ENV{EnvChangeMixedTest}); # what's the latest env value + $r->print(join " ", @vals); + } + elsif ($args eq 'perl') { + my @vals = (@TestModperl::setupenv2::EnvChangePerlTest, + $ENV{EnvChangePerlTest}); # what's the latest env value + $r->print(join " ", @vals); + } + else { + die "no such case"; + } + + return Apache::OK; +} + +1; +__END__ + +# APACHE_TEST_CONFIG_ORDER 950 + +<NoAutoConfig> +PerlLoadModule TestModperl::setupenv2 +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf1" + +<Perl> +TestModperl::setupenv2::register_mixed(); +TestModperl::setupenv2::register_perl(); +$ENV{EnvChangeMixedTest} = "<perl>"; +$ENV{EnvChangePerlTest} = "<perl>"; +</Perl> +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf2" + +PerlRequire "@documentroot@/modperl/setupenv2/require.pl" +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf3" + +PerlConfigRequire "@documentroot@/modperl/setupenv2/config_require.pl" +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf4" + +PerlModule htdocs::modperl::setupenv2::module +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf5" +MyEnvRegister + +PerlPostConfigRequire "@documentroot@/modperl/setupenv2/post_config_require.pl" +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf6" +MyEnvRegister + +PerlSetEnv EnvChangeMixedTest "conf7" +MyEnvRegister + +<Location /TestModperl__setupenv2> + SetHandler modperl + PerlResponseHandler TestModperl::setupenv2 +</Location> + +PerlSetEnv EnvChangeMixedTest "conf8" + +# Since PerlPostConfigRequire runs in the post-config phase it will +# see 'conf8'. And when it sets that value to 'post_config_require' at +# request time $ENV{EnvChangeMixedTest} will see the value set by +# PerlPostConfigRequire. + +</NoAutoConfig>
