cvs commit: modperl-2.0/pod modperl_dev.pod
stas01/09/28 13:23:04 Modified:pod modperl_dev.pod Log: document numeric equivalents of PerlTrace options Revision ChangesPath 1.41 +10 -10modperl-2.0/pod/modperl_dev.pod Index: modperl_dev.pod === RCS file: /home/cvs/modperl-2.0/pod/modperl_dev.pod,v retrieving revision 1.40 retrieving revision 1.41 diff -u -r1.40 -r1.41 --- modperl_dev.pod 2001/09/18 16:05:16 1.40 +++ modperl_dev.pod 2001/09/28 20:23:04 1.41 @@ -497,17 +497,17 @@ which sets maximum logging and debugging levels; -a combination of one or more option letters from the following list: +a combination of one or more option letters (or option numerical +equivalents) from the following list: - d directive processing - f filters - g Perl runtime interaction - h handlers - i interpreter pool management - m memory allocations - s perl sections - -or a numeric value. + d ( 1) directive processing + f ( 2) filters + g ( 4) Perl runtime interaction + h ( 8) handlers + i ( 16) interpreter pool management + m ( 32) memory allocations + s ( 64) perl sections + t (128) benchmark-ish timings When Clevel is not specified, the tracing level will be set to the value of the MOD_PERL_TRACE environment variable.
cvs commit: modperl-2.0/xs/maps apr_functions.map
stas01/09/28 10:20:32
Modified:t/response/TestAPR table.pm
xs/APR/Table APR__Table.h
xs/maps apr_functions.map
Log:
- the list context APR::Table::get implementation + tests
Revision ChangesPath
1.4 +18 -7 modperl-2.0/t/response/TestAPR/table.pm
Index: table.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/table.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- table.pm 2001/09/25 19:44:03 1.3
+++ table.pm 2001/09/28 17:20:32 1.4
@@ -14,7 +14,7 @@
sub handler {
my $r = shift;
-plan $r, tests = 16;
+plan $r, tests = 17;
my $table = APR::Table::make($r-pool, $TABLE_SIZE);
@@ -22,8 +22,18 @@
ok $table-set('foo','bar') || 1;
+# scalar context
ok $table-get('foo') eq 'bar';
+# add + list context
+$table-add(foo = 'tar');
+$table-add(foo = 'kar');
+my @array = $table-get('foo');
+ok @array == 3
+ $array[0] eq 'bar'
+ $array[1] eq 'tar'
+ $array[2] eq 'kar';
+
ok $table-unset('foo') || 1;
ok not defined $table-get('foo');
@@ -62,13 +72,14 @@
#Tied interface
{
my $table = APR::Table::make($r-pool, $TABLE_SIZE);
-
+
ok (UNIVERSAL::isa($table, 'HASH'));
-
+
ok (UNIVERSAL::isa($table, 'HASH')) tied(%$table);
-
+
ok $table-{'foo'} = 'bar';
+# scalar context
ok $table-{'foo'} eq 'bar';
ok delete $table-{'foo'} || 1;
@@ -76,16 +87,16 @@
ok not exists $table-{'foo'};
for (1..$TABLE_SIZE) {
-$table-{chr($_+97)} = $_ ;
+$table-{chr($_+97)} = $_;
}
$filter_count = 0;
foreach my $key (sort keys %$table) {
-my_filter($key,$table-{$key});
+my_filter($key, $table-{$key});
}
ok $filter_count == $TABLE_SIZE;
}
-
+
Apache::OK;
}
1.5 +39 -0 modperl-2.0/xs/APR/Table/APR__Table.h
Index: APR__Table.h
===
RCS file: /home/cvs/modperl-2.0/xs/APR/Table/APR__Table.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- APR__Table.h 2001/09/25 19:44:03 1.4
+++ APR__Table.h 2001/09/28 17:20:32 1.5
@@ -126,3 +126,42 @@
return mpxs_APR__Table_NEXTKEY(tsv, Nullsv);
}
+
+static XS(MPXS_apr_table_get)
+{
+dXSARGS;
+
+if (items != 2) {
+Perl_croak(aTHX_ Usage: $table-get($key));
+}
+
+mpxs_PPCODE({
+APR__Table t = modperl_hash_tied_object(aTHX_ APR::Table, ST(0));
+const char *key = (const char *)SvPV_nolen(ST(1));
+
+if (!t) {
+XSRETURN_UNDEF;
+}
+
+if(GIMME_V == G_SCALAR) {
+const char *val = apr_table_get(t, key);
+
+if (val) {
+XPUSHs(sv_2mortal(newSVpv((char*)val, 0)));
+}
+}
+else {
+apr_array_header_t *arr = apr_table_elts(t);
+apr_table_entry_t *elts = (apr_table_entry_t *)arr-elts;
+int i;
+
+for (i = 0; i arr-nelts; i++) {
+if (!elts[i].key || strcasecmp(elts[i].key, key)) {
+continue;
+}
+XPUSHs(sv_2mortal(newSVpv(elts[i].val,0)));
+}
+}
+});
+
+}
1.23 +1 -1 modperl-2.0/xs/maps/apr_functions.map
Index: apr_functions.map
===
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- apr_functions.map 2001/09/25 19:44:03 1.22
+++ apr_functions.map 2001/09/28 17:20:32 1.23
@@ -184,7 +184,7 @@
apr_table_add
-apr_table_addn
apr_table_do | mpxs_ | ...
- apr_table_get
+ apr_table_get | MPXS_ | ...
apr_table_merge
-apr_table_mergen
apr_table_set
cvs commit: modperl-2.0/t/response/TestApache cgihandler.pm
dougm 01/09/28 10:27:46
Modified:src/modules/perl mod_perl.c modperl_env.c
t/response/TestApache cgihandler.pm
Log:
current implementation of tie %ENV to $r-subprocess_env
is not threadsafe, so back it out for now
Revision ChangesPath
1.81 +8 -0 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.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- mod_perl.c2001/09/28 17:15:07 1.80
+++ mod_perl.c2001/09/28 17:27:45 1.81
@@ -527,13 +527,21 @@
h_stdout = modperl_io_tie_stdout(aTHX_ r);
h_stdin = modperl_io_tie_stdin(aTHX_ r);
+#if 0
+/* current implementation of tie %ENV to $r-subprocess_env
+ * is not threadsafe
+ */
modperl_env_request_tie(aTHX_ r);
+#endif
+
retval = modperl_response_handler_run(r, FALSE);
modperl_io_handle_untie(aTHX_ h_stdout);
modperl_io_handle_untie(aTHX_ h_stdin);
+#if 0
modperl_env_request_untie(aTHX_ r);
+#endif
modperl_perl_global_restore(aTHX_ rcfg-perl_globals);
1.11 +6 -0 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.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- modperl_env.c 2001/09/28 17:15:08 1.10
+++ modperl_env.c 2001/09/28 17:27:45 1.11
@@ -133,6 +133,12 @@
}
#endif
+/*
+ * XXX: PL_vtbl_* are global (not per-interpreter)
+ * so this method of tie-ing is not thread-safe
+ * overridding svt_get is only useful with 5.7.2+ and requires
+ * a smarter lookup than the current modperl_env_request_get
+ */
void modperl_env_request_tie(pTHX_ request_rec *r)
{
EnvMgObj = (char *)r;
1.6 +4 -1 modperl-2.0/t/response/TestApache/cgihandler.pm
Index: cgihandler.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/cgihandler.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- cgihandler.pm 2001/08/01 17:03:19 1.5
+++ cgihandler.pm 2001/09/28 17:27:46 1.6
@@ -24,7 +24,10 @@
else {
print 1..3\n;
print ok 1\n, ok , $ENV{FOO}\n;
-my $foo = $r-subprocess_env-get('FOO');
+#XXX: current implementation of tie %ENV to $r-subprocess_env
+# is not threadsafe
+#my $foo = $r-subprocess_env-get('FOO');
+my $foo = $ENV{FOO};
$foo++;
print ok $foo\n;
}
cvs commit: modperl-2.0/src/modules/perl mod_perl.c
dougm 01/09/28 12:01:50
Modified:src/modules/perl mod_perl.c
Log:
PL_destruct_level should always be 2
Revision ChangesPath
1.83 +6 -6 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.82
retrieving revision 1.83
diff -u -r1.82 -r1.83
--- mod_perl.c2001/09/28 18:34:30 1.82
+++ mod_perl.c2001/09/28 19:01:50 1.83
@@ -58,6 +58,7 @@
PerlInterpreter *modperl_startup(server_rec *s, apr_pool_t *p)
{
+dTHXa(NULL);
MP_dSCFG(s);
PerlInterpreter *perl;
int status;
@@ -81,13 +82,12 @@
exit(1);
}
+aTHX = perl;
+
perl_construct(perl);
-#ifdef MP_DEBUG
-{
-dTHXa(perl);
-PL_perl_destruct_level = 2;
-}
-#endif
+
+PL_perl_destruct_level = 2;
+
status = perl_parse(perl, modperl_xs_init, argc, argv, NULL);
if (status) {
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h modperl_util.h
dougm 01/09/28 12:24:44
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
modperl_util.h
Log:
add save/restore of %ENV to Perl global management
Revision ChangesPath
1.2 +52 -0 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_perl_global.c 2001/09/27 19:03:19 1.1
+++ modperl_perl_global.c 2001/09/28 19:24:44 1.2
@@ -2,12 +2,56 @@
static void modperl_perl_global_init(pTHX_ modperl_perl_globals_t *globals)
{
+globals-env.gv= PL_envgv;
globals-inc.gv= PL_incgv;
globals-defout.gv = PL_defoutgv;
globals-rs.sv = PL_rs;
}
static void
+modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
+{
+U32 mg_flags;
+HV *hv = GvHV(gvhv-gv);
+
+/*
+ * there should only be a small number of entries in %ENV
+ * at this point: modperl_env.c:modperl_env_const_vars[],
+ * PerlPassEnv and top-level PerlSetEnv
+ * XXX: still; could have have something faster than newHVhv()
+ * especially if we add another GVHV to the globals table that
+ * might have more entries
+ */
+
+/* makes newHVhv() faster in bleedperl */
+MP_magical_untie(hv, mg_flags);
+
+gvhv-tmphv = newHVhv(hv);
+TAINT_NOT;
+
+/* reapply magic flags */
+MP_magical_tie(hv, mg_flags);
+MP_magical_tie(gvhv-tmphv, mg_flags);
+
+gvhv-orighv = hv;
+GvHV(gvhv-gv) = gvhv-tmphv;
+}
+
+static void
+modperl_perl_global_gvhv_restore(pTHX_ modperl_perl_global_gvhv_t *gvhv)
+{
+U32 mg_flags;
+
+GvHV(gvhv-gv) = gvhv-orighv;
+
+/* loose magic for hv_clear()
+ * e.g. for %ENV don't want to clear environ array
+ */
+MP_magical_untie(gvhv-tmphv, mg_flags);
+SvREFCNT_dec(gvhv-tmphv);
+}
+
+static void
modperl_perl_global_gvav_save(pTHX_ modperl_perl_global_gvav_t *gvav)
{
AV *av = GvAV(gvav-gv);
@@ -59,6 +103,7 @@
}
typedef enum {
+MP_GLOBAL_GVHV,
MP_GLOBAL_GVAV,
MP_GLOBAL_GVIO,
MP_GLOBAL_SVPV,
@@ -74,6 +119,7 @@
STRUCT_OFFSET(modperl_perl_globals_t, m)
static modperl_perl_global_entry_t modperl_perl_global_entries[] = {
+{ENV,MP_GLOBAL_OFFSET(env),MP_GLOBAL_GVHV}, /* %ENV */
{INC,MP_GLOBAL_OFFSET(inc),MP_GLOBAL_GVAV}, /* @INC */
{STDOUT, MP_GLOBAL_OFFSET(defout), MP_GLOBAL_GVIO}, /* $| */
{/, MP_GLOBAL_OFFSET(rs), MP_GLOBAL_SVPV}, /* $/ */
@@ -102,6 +148,9 @@
MP_dGLOBAL_PTR(globals, i);
switch (modperl_perl_global_entries[i].type) {
+ case MP_GLOBAL_GVHV:
+MP_PERL_GLOBAL_SAVE(gvhv, ptr);
+break;
case MP_GLOBAL_GVAV:
MP_PERL_GLOBAL_SAVE(gvav, ptr);
break;
@@ -123,6 +172,9 @@
MP_dGLOBAL_PTR(globals, i);
switch (modperl_perl_global_entries[i].type) {
+ case MP_GLOBAL_GVHV:
+MP_PERL_GLOBAL_RESTORE(gvhv, ptr);
+break;
case MP_GLOBAL_GVAV:
MP_PERL_GLOBAL_RESTORE(gvav, ptr);
break;
1.2 +7 -0 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_perl_global.h 2001/09/27 19:03:19 1.1
+++ modperl_perl_global.h 2001/09/28 19:24:44 1.2
@@ -9,6 +9,12 @@
typedef struct {
GV *gv;
+HV *tmphv;
+HV *orighv;
+} modperl_perl_global_gvhv_t;
+
+typedef struct {
+GV *gv;
char flags;
} modperl_perl_global_gvio_t;
@@ -19,6 +25,7 @@
} modperl_perl_global_svpv_t;
typedef struct {
+modperl_perl_global_gvhv_t env;
modperl_perl_global_gvav_t inc;
modperl_perl_global_gvio_t defout;
modperl_perl_global_svpv_t rs;
1.18 +7 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- modperl_util.h2001/09/25 19:44:02 1.17
+++ modperl_util.h2001/09/28 19:24:44 1.18
@@ -21,6 +21,13 @@
#define SvObjIV(o) SvIV((SV*)SvRV(o))
#define MgObjIV(m) SvIV((SV*)SvRV(m-mg_obj))
+#define
cvs commit: modperl-2.0/src/modules/perl modperl_env.h
dougm 01/09/28 12:26:37
Modified:src/modules/perl modperl_env.h
Log:
use new MP_magical_ macros for modperl_env_{tie,untie}
Revision ChangesPath
1.8 +2 -3 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_env.h 2001/09/28 18:34:30 1.7
+++ modperl_env.h 2001/09/28 19:26:37 1.8
@@ -6,11 +6,10 @@
#endif
#define modperl_env_untie(mg_flags) \
-mg_flags = SvMAGICAL((SV*)ENVHV); \
-SvMAGICAL_off((SV*)ENVHV)
+MP_magical_untie(ENVHV, mg_flags)
#define modperl_env_tie(mg_flags) \
-SvFLAGS((SV*)ENVHV) |= mg_flags
+MP_magical_tie(ENVHV, mg_flags)
void modperl_env_clear(pTHX);
cvs commit: modperl-2.0/todo missing_old_features.txt
dougm 01/09/28 12:29:53
Modified:todo missing_old_features.txt
Log:
update todos on %ENV
Revision ChangesPath
1.9 +10 -1 modperl-2.0/todo/missing_old_features.txt
Index: missing_old_features.txt
===
RCS file: /home/cvs/modperl-2.0/todo/missing_old_features.txt,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- missing_old_features.txt 2001/09/28 15:16:06 1.8
+++ missing_old_features.txt 2001/09/28 19:29:53 1.9
@@ -22,7 +22,16 @@
- PerlFreshRestart
-- cgi emulation, i.e. %ENV/END{}/exit() management
+- cgi emulation, i.e. END{}/exit() management
+
+- %ENV managment:
+ - %ENV is currently only saved/restored for the perl-script
+ handler, i.e. changes to %ENV outside of a perl-script handler
+ are not cleared. of course, clean modules would use local() to
+ modify %ENV, but there should be an option to save/restore
+ globals outside of the perl-script handler
+
+ - see if we can avoid touching environ[] until a fork() from Perl happens
- die 404;
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_cmd.c modperl_cmd.h modperl_config.c modperl_types.h
stas01/09/28 12:51:40
Modified:src/modules/perl mod_perl.c modperl_cmd.c modperl_cmd.h
modperl_config.c modperl_types.h
Log:
- implementation of PerlSetVar and PerlAddVar
Revision ChangesPath
1.85 +3 -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.84
retrieving revision 1.85
diff -u -r1.84 -r1.85
--- mod_perl.c2001/09/28 19:33:58 1.84
+++ mod_perl.c2001/09/28 19:51:40 1.85
@@ -173,7 +173,7 @@
if (!modperl_config_apply_PerlRequire(s, scfg, perl, p)) {
exit(1);
}
-
+
#ifdef USE_ITHREADS
if (!MpSrvENABLE(scfg)) {
@@ -415,6 +415,8 @@
MP_CMD_SRV_ITERATE(PerlModule, modules, PerlModule),
MP_CMD_SRV_ITERATE(PerlRequire, requires, PerlRequire),
MP_CMD_DIR_ITERATE(PerlOptions, options, Perl Options),
+MP_CMD_DIR_TAKE2(PerlSetVar, set_var, PerlSetVar),
+MP_CMD_DIR_ITERATE2(PerlAddVar, add_var, PerlAddVar),
#ifdef MP_TRACE
MP_CMD_SRV_TAKE1(PerlTrace, trace, Trace level),
#endif
1.12 +32 -0 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- modperl_cmd.c 2001/09/27 19:41:44 1.11
+++ modperl_cmd.c 2001/09/28 19:51:40 1.12
@@ -60,6 +60,38 @@
return NULL;
}
+MP_CMD_SRV_DECLARE2(set_var)
+{
+MP_dSCFG(parms-server);
+modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
+
+if (parms-path) {
+apr_table_set(dcfg-SetVar, arg1, arg2);
+MP_TRACE_d(MP_FUNC, DIR: arg1 = %s, arg2 = %s\n, arg1, arg2);
+}
+else {
+apr_table_set(scfg-SetVar, arg1, arg2);
+MP_TRACE_d(MP_FUNC, SRV: arg1 = %s, arg2 = %s\n, arg1, arg2);
+}
+return NULL;
+}
+
+MP_CMD_SRV_DECLARE2(add_var)
+{
+MP_dSCFG(parms-server);
+modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
+
+if (parms-path) {
+apr_table_add(dcfg-SetVar, arg1, arg2);
+MP_TRACE_d(MP_FUNC, DIR: arg1 = %s, arg2 = %s\n, arg1, arg2);
+}
+else {
+apr_table_add(scfg-SetVar, arg1, arg2);
+MP_TRACE_d(MP_FUNC, SRV: arg1 = %s, arg2 = %s\n, arg1, arg2);
+}
+return NULL;
+}
+
MP_CMD_SRV_DECLARE(options)
{
MP_dSCFG(parms-server);
1.14 +14 -5 modperl-2.0/src/modules/perl/modperl_cmd.h
Index: modperl_cmd.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- modperl_cmd.h 2001/09/27 19:41:44 1.13
+++ modperl_cmd.h 2001/09/28 19:51:40 1.14
@@ -4,14 +4,13 @@
char *modperl_cmd_push_handlers(MpAV **handlers, const char *name,
apr_pool_t *p);
-
#define MP_CMD_SRV_DECLARE(item) \
-const char *modperl_cmd_##item(cmd_parms *parms, \
- void *mconfig, const char *arg)
+const char *modperl_cmd_##item(cmd_parms *parms, void *mconfig, \
+ const char *arg)
#define MP_CMD_SRV_DECLARE2(item) \
-const char *modperl_cmd_##item(cmd_parms *parms, \
- void *mconfig, const char *arg1, const char *arg2)
+const char *modperl_cmd_##item(cmd_parms *parms, void *mconfig, \
+ const char *arg1, const char *arg2)
#define MP_CMD_SRV_DECLARE_FLAG(item) \
const char *modperl_cmd_##item(cmd_parms *parms, \
@@ -21,6 +20,8 @@
MP_CMD_SRV_DECLARE(switches);
MP_CMD_SRV_DECLARE(modules);
MP_CMD_SRV_DECLARE(requires);
+MP_CMD_SRV_DECLARE2(set_var);
+MP_CMD_SRV_DECLARE2(add_var);
MP_CMD_SRV_DECLARE(options);
#ifdef MP_COMPAT_1X
@@ -73,6 +74,10 @@
AP_INIT_ITERATE( name, modperl_cmd_##item, NULL, \
RSRC_CONF, desc )
+#define MP_CMD_SRV_ITERATE2(name, item, desc) \
+ AP_INIT_ITERATE2( name, modperl_cmd_##item, NULL, \
+ RSRC_CONF, desc )
+
#define MP_CMD_DIR_TAKE1(name, item, desc) \
AP_INIT_TAKE1( name, modperl_cmd_##item, NULL, \
OR_ALL, desc )
@@ -83,6 +88,10 @@
#define MP_CMD_DIR_ITERATE(name, item, desc) \
AP_INIT_ITERATE( name, modperl_cmd_##item, NULL, \
+ OR_ALL, desc )
+
+#define MP_CMD_DIR_ITERATE2(name, item, desc) \
+AP_INIT_ITERATE2( name, modperl_cmd_##item, NULL, \
OR_ALL, desc )
#define MP_CMD_DIR_FLAG(name, item, desc) \
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/09/28 12:53:22
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
use the address of sv for modperl_perl_global_svpv_t, since it might point to a
different SV when restore happens
Revision ChangesPath
1.3 +4 -4 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_perl_global.c 2001/09/28 19:24:44 1.2
+++ modperl_perl_global.c 2001/09/28 19:53:22 1.3
@@ -5,7 +5,7 @@
globals-env.gv= PL_envgv;
globals-inc.gv= PL_incgv;
globals-defout.gv = PL_defoutgv;
-globals-rs.sv = PL_rs;
+globals-rs.sv = PL_rs;
}
static void
@@ -92,14 +92,14 @@
static void
modperl_perl_global_svpv_save(pTHX_ modperl_perl_global_svpv_t *svpv)
{
-svpv-cur = SvCUR(svpv-sv);
-strncpy(svpv-pv, SvPVX(svpv-sv), sizeof(svpv-pv));
+svpv-cur = SvCUR(*svpv-sv);
+strncpy(svpv-pv, SvPVX(*svpv-sv), sizeof(svpv-pv));
}
static void
modperl_perl_global_svpv_restore(pTHX_ modperl_perl_global_svpv_t *svpv)
{
-sv_setpvn(svpv-sv, svpv-pv, svpv-cur);
+sv_setpvn(*svpv-sv, svpv-pv, svpv-cur);
}
typedef enum {
1.3 +1 -1 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_perl_global.h 2001/09/28 19:24:44 1.2
+++ modperl_perl_global.h 2001/09/28 19:53:22 1.3
@@ -19,7 +19,7 @@
} modperl_perl_global_gvio_t;
typedef struct {
-SV *sv;
+SV **sv;
char pv[256]; /* XXX: only need enough for $/ at the moment */
I32 cur;
} modperl_perl_global_svpv_t;
cvs commit: modperl-2.0/src/modules/perl modperl_config.c
stas01/09/28 13:08:34
Modified:src/modules/perl modperl_config.c
Log:
- the empty slot check should be done against the original table. If we
test against the overlayed table, we will copy only the first value for
a given key in case there are more than one value for the same key.
hence s/mrg-item/add-item/ in the check
Revision ChangesPath
1.43 +1 -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.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- modperl_config.c 2001/09/28 19:51:40 1.42
+++ modperl_config.c 2001/09/28 20:08:34 1.43
@@ -24,7 +24,7 @@
mrg-item = apr_table_copy(p, add-item); \
for (i = 0; i arr-nelts; i++) { \
char *val; \
-if ((val = (char *)apr_table_get(mrg-item, entries[i].key))){ \
+if ((val = (char *)apr_table_get(add-item, entries[i].key))){ \
continue; \
} \
else if ((val = (char *)apr_table_get(base-item, entries[i].key))){ \
cvs commit: modperl-2.0/xs/maps modperl_functions.map
stas01/09/28 13:11:02
Modified:src/modules/perl modperl_util.h modperl_util.c
t/response/TestAPI request_rec.pm server_rec.pm
xs/Apache/RequestUtil Apache__RequestUtil.h
xs/maps modperl_functions.map
Log:
- implements modperl_table_get_set for other functions to use
- implements Apache::Server::dir_config + tests
- implements Apache::RequestRec::dir_config + tests
- implements new features coming from modperl_table_get_set for free
$(s|r)-dir_config($key = $val); # == set($key, $val)
$(s|r)r-dir_config($key = undef); # == unset($key)
- adds tests for PerlSetVar and PerlAddVar via dir_config
Revision ChangesPath
1.19 +6 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- modperl_util.h2001/09/28 19:24:44 1.18
+++ modperl_util.h2001/09/28 20:11:01 1.19
@@ -66,4 +66,10 @@
MP_INLINE void *modperl_hash_tied_object(pTHX_ const char *classname,
SV *tsv);
+MP_INLINE SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
+ char *key, SV *sv_val);
+
+SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
+ SV *sv_val, bool do_taint);
+
#endif /* MODPERL_UTIL_H */
1.19 +57 -0 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- modperl_util.c2001/09/25 19:44:02 1.18
+++ modperl_util.c2001/09/28 20:11:01 1.19
@@ -386,3 +386,60 @@
return NULL;
}
+
+MP_INLINE
+SV *modperl_dir_config(pTHX_ request_rec *r, server_rec *s,
+ char *key, SV *sv_val)
+{
+SV *RETVAL = PL_sv_undef;
+
+if (r r-per_dir_config) {
+MP_dDCFG;
+RETVAL = modperl_table_get_set(aTHX_ dcfg-SetVar, key, sv_val, FALSE);
+}
+
+if (!SvTRUE(RETVAL)) {
+if (s s-module_config) {
+MP_dSCFG(s);
+SvREFCNT_dec(RETVAL); /* in case above did newSV(0) */
+RETVAL = modperl_table_get_set(aTHX_ scfg-SetVar, key, sv_val, FALSE);
+} else {
+RETVAL = PL_sv_undef;
+}
+}
+
+return RETVAL;
+}
+
+SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key,
+ SV *sv_val, bool do_taint)
+{
+SV *RETVAL = PL_sv_undef;
+
+if (table == NULL) {
+/* do nothing */
+}
+else if (key == NULL) {
+RETVAL = modperl_hash_tie(aTHX_ APR::Table, Nullsv, (void*)table);
+}
+else if (sv_val == PL_sv_no) { /* no val was passed */
+char *val;
+if ((val = (char *)apr_table_get(table, key))) {
+RETVAL = newSVpv(val, 0);
+}
+else {
+RETVAL = newSV(0);
+}
+if (do_taint) {
+SvTAINTED_on(RETVAL);
+}
+}
+else if (sv_val == PL_sv_undef) { /* val was passed in as undef */
+apr_table_unset(table, key);
+}
+else {
+apr_table_set(table, key, SvPV_nolen(sv_val));
+}
+
+return RETVAL;
+}
1.8 +99 -2 modperl-2.0/t/response/TestAPI/request_rec.pm
Index: request_rec.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/request_rec.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- request_rec.pm2001/09/15 19:34:12 1.7
+++ request_rec.pm2001/09/28 20:11:02 1.8
@@ -4,11 +4,14 @@
use warnings FATAL = 'all';
use Apache::Test;
+use Apache::TestUtil;
+use Apache::Const -compile = 'OK';
+
sub handler {
my $r = shift;
-plan $r, tests = 40;
+plan $r, tests = 48;
#Apache-request($r); #PerlOptions +GlobalRequest takes care
my $gr = Apache-request;
@@ -86,6 +89,80 @@
#user
+#- dir_config tests -#
+
+# this test doesn't test all $r-dir_config-*(), since
+# dir_config() returns a generic APR::Table which is tested in
+# apr/table.t.
+
+# object test
+my $dir_config = $r-dir_config;
+ok defined $dir_config ref($dir_config) eq 'APR::Table';
+
+# PerlAddVar ITERATE2 test
+{
+my $key = make_key('1');
+my @received = $dir_config-get($key);
+
cvs commit: modperl-2.0/xs/Apache/ServerUtil Apache__ServerUtil.h
stas01/09/28 13:13:08 Modified:xs/Apache/ServerUtil Apache__ServerUtil.h Log: ...an orphan file from the last commit - implements Apache::Server::dir_config Revision ChangesPath 1.2 +3 -0 modperl-2.0/xs/Apache/ServerUtil/Apache__ServerUtil.h Index: Apache__ServerUtil.h === RCS file: /home/cvs/modperl-2.0/xs/Apache/ServerUtil/Apache__ServerUtil.h,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- Apache__ServerUtil.h 2001/03/17 06:03:37 1.1 +++ Apache__ServerUtil.h 2001/09/28 20:13:08 1.2 @@ -38,3 +38,6 @@ return modperl_handler_perl_get_handlers(aTHX_ handp, s-process-pconf); } + +#define mpxs_Apache__Server_dir_config(s, key, sv_val) \ +modperl_dir_config(aTHX_ NULL, s, key, sv_val)
cvs commit: modperl-2.0/src/modules/perl modperl_env.c modperl_env.h
dougm 01/09/28 09:39:15
Modified:src/modules/perl modperl_env.c modperl_env.h
Log:
cut down on some noise with new ENVHV macro
Revision ChangesPath
1.9 +4 -4 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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_env.c 2001/09/28 15:16:06 1.8
+++ modperl_env.c 2001/09/28 16:39:15 1.9
@@ -1,6 +1,6 @@
#include mod_perl.h
-#define EnvMgObj SvMAGIC((SV*)GvHV(PL_envgv))-mg_ptr
+#define EnvMgObj SvMAGIC((SV*)ENVHV)-mg_ptr
static MP_INLINE
void modperl_env_hv_store(pTHX_ HV *hv, apr_table_entry_t *elt)
@@ -39,7 +39,7 @@
void modperl_env_request_populate(pTHX_ request_rec *r)
{
MP_dRCFG;
-HV *hv = GvHV(PL_envgv);
+HV *hv = ENVHV;
int i;
U32 mg_flags;
apr_array_header_t *array;
@@ -121,7 +121,7 @@
PL_vtbl_envelem.svt_set = MEMBER_TO_FPTR(modperl_env_request_set);
#ifdef MP_PERL_HV_GMAGICAL_AWARE
-SvGMAGICAL_on((SV*)GvHV(PL_envgv));
+SvGMAGICAL_on((SV*)ENVHV);
PL_vtbl_envelem.svt_get = MEMBER_TO_FPTR(modperl_env_request_get);
#endif
}
@@ -130,7 +130,7 @@
{
PL_vtbl_envelem.svt_set = MEMBER_TO_FPTR(Perl_magic_setenv);
#ifdef MP_PERL_HV_GMAGICAL_AWARE
-SvGMAGICAL_off((SV*)GvHV(PL_envgv));
+SvGMAGICAL_off((SV*)ENVHV);
PL_vtbl_envelem.svt_get = 0;
#endif
}
1.5 +7 -3 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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_env.h 2001/09/28 15:16:06 1.4
+++ modperl_env.h 2001/09/28 16:39:15 1.5
@@ -1,12 +1,16 @@
#ifndef MODPERL_ENV_H
#define MODPERL_ENV_H
+#ifndef ENVHV
+# define ENVHV GvHV(PL_envgv)
+#endif
+
#define modperl_env_untie(mg_flags) \
-mg_flags = SvMAGICAL((SV*)GvHV(PL_envgv)); \
-SvMAGICAL_off((SV*)GvHV(PL_envgv))
+mg_flags = SvMAGICAL((SV*)ENVHV); \
+SvMAGICAL_off((SV*)ENVHV)
#define modperl_env_tie(mg_flags) \
-SvFLAGS((SV*)GvHV(PL_envgv)) |= mg_flags
+SvFLAGS((SV*)ENVHV) |= mg_flags
void modperl_env_request_populate(pTHX_ request_rec *r);
cvs commit: modperl-2.0/todo api.txt
dougm 01/09/28 06:51:57
Modified:lib/Apache compat.pm
todo api.txt
Log:
add $r-header_(in/out)() to Apache::compat
Submitted by: Philippe M . Chiasson [EMAIL PROTECTED]
Reviewed by: dougm
Revision ChangesPath
1.13 +29 -0 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- compat.pm 2001/09/15 17:57:25 1.12
+++ compat.pm 2001/09/28 13:51:57 1.13
@@ -57,6 +57,35 @@
package Apache::RequestRec;
+sub table_set_get {
+my($r, $table) = (shift, shift);
+my($key, $value) = @_;
+
+if (1 == @_) {
+return $table-{$key};
+}
+elsif (2 == @_) {
+return $table-{$key} = $value;
+}
+elsif (0 == @_) {
+return $table;
+}
+else {
+my $name = (caller(1))[3];
+warn Usage: $name([key [,val]]);
+}
+}
+
+sub header_out {
+my $r = shift;
+return $r-table_set_get(scalar $r-headers_out, @_);
+}
+
+sub header_in {
+my $r = shift;
+return $r-table_set_get(scalar $r-headers_in, @_);
+}
+
sub register_cleanup {
shift-pool-cleanup_register(@_);
}
1.6 +0 -3 modperl-2.0/todo/api.txt
Index: api.txt
===
RCS file: /home/cvs/modperl-2.0/todo/api.txt,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- api.txt 2001/09/25 19:44:03 1.5
+++ api.txt 2001/09/28 13:51:57 1.6
@@ -9,9 +9,6 @@
need apr_finfo_t - struct stat conversion (might already be there,
haven't looked close enough yet)
-$r-header_{in,out}:
-deprecated, but should be included in Apache::compat
-
$r-pnotes:
not yet implemented
Re: cvs commit: modperl-2.0/todo api.txt
On Fri, 28 Sep 2001, Philippe M . Chiasson wrote: Aie ! There is a slight problem with this patch, as was pointed out by Stas a while ago. Blame it on the annoying TZ lag introduced in e-mail when living in Singapore ;-) This patch works, but doesn't preserve ARRAY context, thus: ok. could probably just pass wantarray to table_get_set and do: return $wantarray ? ($table-get($key)) : scalar $table-get($key)
cvs commit: modperl-2.0/todo missing_old_features.txt
dougm 01/09/28 08:16:06
Modified:lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_callback.c
modperl_config.c modperl_env.c modperl_env.h
modperl_options.c modperl_types.h
todo missing_old_features.txt
Log:
fix SetupEnv such that:
PerlOptions +SetupEnv happens as early as possible
+SetEnv is the default only for perl-script handler
Revision ChangesPath
1.70 +10 -3 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.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- Code.pm 2001/09/27 19:04:38 1.69
+++ Code.pm 2001/09/28 15:16:06 1.70
@@ -96,13 +96,20 @@
Srv = ['NONE', @ithread_opts, qw(ENABLE AUTOLOAD MERGE_HANDLERS),
@hook_flags, 'UNSET'],
Dir = [qw(NONE PARSE_HEADERS SETUP_ENV MERGE_HANDLERS GLOBAL_REQUEST UNSET)],
-Req = [qw(NONE SET_GLOBAL_REQUEST)],
+Req = [qw(NONE SET_GLOBAL_REQUEST SETUP_ENV)],
Interp = [qw(NONE IN_USE PUTBACK CLONED BASE)],
Handler = [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC)],
);
+$flags{DirSeen} = $flags{Dir};
+
my %flags_options = map { $_,1 } qw(Srv Dir);
+my %flags_field = (
+DirSeen = 'flags-opts_seen',
+(map { $_, 'flags-opts' } keys %flags_options),
+);
+
sub new {
my $class = shift;
bless {
@@ -334,9 +341,9 @@
}
my $flags = join $class, qw(Mp FLAGS);
+my $field = $flags_field{$class} || 'flags';
-print $h_fh \n#define $flags(p) ,
- ($flags_options{$class} ? '(p)-flags-opts' : '(p)-flags'), \n;
+print $h_fh \n#define $flags(p) (p)-$field\n;
$class = Mp$class;
print $h_fh \n#define ${class}Type $n\n;
1.79 +5 -0 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.78
retrieving revision 1.79
diff -u -r1.78 -r1.79
--- mod_perl.c2001/09/27 23:29:51 1.78
+++ mod_perl.c2001/09/28 15:16:06 1.79
@@ -511,6 +511,11 @@
}
#endif
+/* default is +SetupEnv, skip if PerlOption -SetupEnv */
+if (MpDirSETUP_ENV(dcfg) || !MpDirSeenSETUP_ENV(dcfg)) {
+modperl_env_request_populate(aTHX_ r);
+}
+
if (MpDirPARSE_HEADERS(dcfg)) {
rcfg-wbucket.header_parse = 1;
}
1.44 +5 -0 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.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- modperl_callback.c2001/09/17 23:36:36 1.43
+++ modperl_callback.c2001/09/28 15:16:06 1.44
@@ -138,6 +138,11 @@
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);
+}
break;
case MP_HANDLER_TYPE_CONNECTION:
modperl_handler_make_args(aTHX_ av_args,
1.41 +0 -2 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.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- modperl_config.c 2001/09/27 23:31:36 1.40
+++ modperl_config.c 2001/09/28 15:16:06 1.41
@@ -9,8 +9,6 @@
dcfg-interp_scope = MP_INTERP_SCOPE_UNDEF;
#endif
-MpDirSETUP_ENV_On(dcfg); /* %ENV setup on by default */
-
return dcfg;
}
1.8 +16 -9 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_env.c 2001/09/27 23:31:36 1.7
+++ modperl_env.c 2001/09/28 15:16:06 1.8
@@ -36,19 +36,30 @@
{ NULL }
};
-static void modperl_env_request_populate(pTHX_ request_rec *r)
+void modperl_env_request_populate(pTHX_ request_rec *r)
{
+MP_dRCFG;
HV *hv = GvHV(PL_envgv);
int i;
U32 mg_flags;
-apr_array_header_t *array = apr_table_elts(r-subprocess_env);
-
cvs commit: modperl-2.0/t/hooks/TestHooks headerparser.pm
dougm 01/09/28 08:21:15
Modified:t/hooks .cvsignore
Added: t/hooks/TestHooks headerparser.pm
Log:
add PerlHeaderParserHandler/SetupEnv test
Revision ChangesPath
1.2 +1 -0 modperl-2.0/t/hooks/.cvsignore
Index: .cvsignore
===
RCS file: /home/cvs/modperl-2.0/t/hooks/.cvsignore,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- .cvsignore2001/09/12 17:11:48 1.1
+++ .cvsignore2001/09/28 15:21:15 1.2
@@ -1,3 +1,4 @@
+headerparser.t
access.t
authen.t
authz.t
1.1 modperl-2.0/t/hooks/TestHooks/headerparser.pm
Index: headerparser.pm
===
package TestHooks::headerparser;
use strict;
use warnings FATAL = 'all';
use Apache::Test;
sub handler {
my $r = shift;
$r-notes-set(url = $ENV{REQUEST_URI});
Apache::OK;
}
sub response {
my $r = shift;
plan $r, tests = 1;
ok $r-notes-get('url') eq $r-uri;
Apache::OK;
}
1;
__DATA__
PerlOptions +SetupEnv
PerlResponseHandler TestHooks::headerparser::response
SetHandler modperl
