Philip M. Gollucci wrote: >>I'll work something up when I have the chance... in a month or two :) > > God do I know the feeling. > > Thanks for the good eyes Gozer.
No problem, and attached is a modified patch that: 1 - Doesn't leak a HV * on each pass 2 - Merges the pnotes logic between r->pnotes & c->pnotes in one piece of code Passes all tests, but I see tons (66 to be precise) of this warning in the error_log, geoff ? "Use of uninitialized value in caller at /usr/lib/perl5/5.8.6/Test.pm line 374." -------------------------------------------------------------------------------- Philippe M. Chiasson m/gozer\@(apache|cpan|ectoplasm)\.org/ GPG KeyID : 88C3A5A5 http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3A5A5
Index: src/modules/perl/modperl_config.c
===================================================================
--- src/modules/perl/modperl_config.c (revision 385602)
+++ src/modules/perl/modperl_config.c (working copy)
@@ -147,6 +147,17 @@
return rcfg;
}
+
+modperl_config_con_t *modperl_config_con_new(conn_rec *c)
+{
+ modperl_config_con_t *ccfg =
+ (modperl_config_con_t *)apr_pcalloc(c->pool, sizeof(*ccfg));
+
+ MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)ccfg);
+
+ return ccfg;
+}
+
modperl_config_srv_t *modperl_config_srv_new(apr_pool_t *p, server_rec *s)
{
modperl_config_srv_t *scfg = (modperl_config_srv_t *)
Index: src/modules/perl/modperl_types.h
===================================================================
--- src/modules/perl/modperl_types.h (revision 385602)
+++ src/modules/perl/modperl_types.h (working copy)
@@ -259,6 +259,7 @@
typedef struct {
MpAV *handlers_connection[MP_HANDLER_NUM_CONNECTION];
+ HV *pnotes;
} modperl_config_con_t;
typedef struct {
Index: src/modules/perl/modperl_config.h
===================================================================
--- src/modules/perl/modperl_config.h (revision 385602)
+++ src/modules/perl/modperl_config.h (working copy)
@@ -26,6 +26,8 @@
modperl_config_req_t *modperl_config_req_new(request_rec *r);
+modperl_config_con_t *modperl_config_con_new(conn_rec *c);
+
void *modperl_config_srv_create(apr_pool_t *p, server_rec *s);
void *modperl_config_srv_merge(apr_pool_t *p, void *basev, void *addv);
@@ -78,6 +80,19 @@
#define MP_dRCFG \
modperl_config_req_t *rcfg = modperl_config_req_get(r)
+#define modperl_config_con_init(c, ccfg) \
+ if (!ccfg) { \
+ ccfg = modperl_config_con_new(c); \
+ modperl_set_module_config(c->conn_config, ccfg); \
+ }
+
+#define modperl_config_con_get(c) \
+ (c ? (modperl_config_con_t *) \
+ modperl_get_module_config(c->conn_config) : NULL)
+
+#define MP_dCCFG \
+ modperl_config_con_t *ccfg = modperl_config_con_get(c)
+
#define modperl_config_dir_get(r) \
(r ? (modperl_config_dir_t *) \
modperl_get_module_config(r->per_dir_config) : NULL)
Index: src/modules/perl/modperl_util.c
===================================================================
--- src/modules/perl/modperl_util.c (revision 385602)
+++ src/modules/perl/modperl_util.c (working copy)
@@ -828,3 +828,69 @@
modperl_global_get_server_rec()->process->pool);
return data ? *(int *)data : 0;
}
+
+#ifdef USE_ITHREADS
+typedef struct {
+ HV **pnotes;
+ PerlInterpreter *perl;
+} modperl_cleanup_pnotes_data;
+#endif
+
+static MP_INLINE
+apr_status_t modperl_cleanup_pnotes(void *data) {
+ HV **pnotes;
+#ifdef USE_ITHREADS
+ modperl_cleanup_pnotes_data *cleanup_data = data;
+ dTHXa(cleanup_data->perl);
+ pnotes = cleanup_data->pnotes;
+#else
+ pnotes = data;
+#endif
+
+ if (*pnotes) {
+ SvREFCNT_dec(*pnotes);
+ *pnotes = Nullhv;
+ }
+
+ return APR_SUCCESS;
+}
+
+SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val,
+ request_rec *r, conn_rec *c) {
+ SV *retval = Nullsv;
+
+ if (!*pnotes) {
+ apr_pool_t *pool = r ? r->pool : c->pool;
+
+#ifdef USE_ITHREADS
+ modperl_cleanup_pnotes_data *cleanup_data =
+ apr_palloc(pool, sizeof(*cleanup_data));
+ cleanup_data->pnotes = pnotes;
+ cleanup_data->perl = aTHX;
+#else
+ void *cleanup_data = pnotes;
+#endif
+ apr_pool_cleanup_register(pool, cleanup_data,
+ modperl_cleanup_pnotes,
+ apr_pool_cleanup_null);
+ *pnotes = newHV();
+ }
+
+ if (key) {
+ STRLEN len;
+ char *k = SvPV(key, len);
+
+ if (val) {
+ retval = *hv_store(*pnotes, k, len,
+ SvREFCNT_inc(val), 0);
+ }
+ else if (hv_exists(*pnotes, k, len)) {
+ retval = *hv_fetch(*pnotes, k, len, FALSE);
+ }
+ }
+ else {
+ retval = newRV_inc((SV *)*pnotes);
+ }
+
+ return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
+}
Index: src/modules/perl/modperl_util.h
===================================================================
--- src/modules/perl/modperl_util.h (revision 385602)
+++ src/modules/perl/modperl_util.h (working copy)
@@ -145,4 +145,8 @@
void modperl_restart_count_inc(server_rec *base_server);
int modperl_restart_count(void);
+SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val, request_rec *r, conn_rec *c);
+#define modperl_rpnotes(pnotes, key, val) modperl_pnotes(aTHX_ pnotes, key, val, r, NULL)
+#define modperl_cpnotes(pnotes, key, val) modperl_pnotes(aTHX_ pnotes, key, val, NULL, c)
+
#endif /* MODPERL_UTIL_H */
Index: xs/maps/modperl_functions.map
===================================================================
--- xs/maps/modperl_functions.map (revision 385602)
+++ xs/maps/modperl_functions.map (working copy)
@@ -93,6 +93,9 @@
MODULE=Apache2::Connection
mpxs_Apache2__Connection_client_socket | | c, s=NULL
+MODULE=Apache2::ConnectionUtil PACKAGE=guess
+ mpxs_Apache2__Connection_pnotes | | c, key=Nullsv, val=Nullsv
+
MODULE=Apache2::Filter
modperl_filter_attributes | MPXS_ | ... | MODIFY_CODE_ATTRIBUTES
Index: xs/Apache2/RequestUtil/Apache2__RequestUtil.h
===================================================================
--- xs/Apache2/RequestUtil/Apache2__RequestUtil.h (revision 385602)
+++ xs/Apache2/RequestUtil/Apache2__RequestUtil.h (working copy)
@@ -212,32 +212,12 @@
SV *mpxs_Apache2__RequestRec_pnotes(pTHX_ request_rec *r, SV *key, SV *val)
{
MP_dRCFG;
- SV *retval = NULL;
if (!rcfg) {
return &PL_sv_undef;
}
- if (!rcfg->pnotes) {
- rcfg->pnotes = newHV();
- }
-
- if (key) {
- STRLEN len;
- char *k = SvPV(key, len);
-
- if (val) {
- retval = *hv_store(rcfg->pnotes, k, len,
- SvREFCNT_inc(val), 0);
- }
- else if (hv_exists(rcfg->pnotes, k, len)) {
- retval = *hv_fetch(rcfg->pnotes, k, len, FALSE);
- }
- }
- else {
- retval = newRV_inc((SV *)rcfg->pnotes);
- }
-
- return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
+
+ return modperl_rpnotes(&rcfg->pnotes, key, val);
}
#define mpxs_Apache2__RequestRec_dir_config(r, key, sv_val) \
Index: xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h
===================================================================
--- xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h (revision 0)
+++ xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h (revision 0)
@@ -0,0 +1,28 @@
+/* Copyright 2001-2005 The Apache Software Foundation
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+
+static MP_INLINE
+SV *mpxs_Apache2__Connection_pnotes(pTHX_ conn_rec *c, SV *key, SV *val)
+{
+ MP_dCCFG;
+
+ modperl_config_con_init(c, ccfg);
+
+ if (!ccfg) {
+ return &PL_sv_undef;
+ }
+
+ return modperl_cpnotes(&ccfg->pnotes, key, val);
+}
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm (revision 385602)
+++ xs/tables/current/ModPerl/FunctionTable.pm (working copy)
@@ -1493,6 +1493,16 @@
]
},
{
+ 'return_type' => 'modperl_config_con_t *',
+ 'name' => 'modperl_config_con_new',
+ 'args' => [
+ {
+ 'type' => 'conn_rec *',
+ 'name' => 'c'
+ }
+ ]
+ },
+ {
'return_type' => 'apr_status_t',
'name' => 'modperl_config_request_cleanup',
'args' => [
@@ -6208,6 +6218,28 @@
},
{
'return_type' => 'SV *',
+ 'name' => 'mpxs_Apache2__Connection_pnotes',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'conn_rec *',
+ 'name' => 'c'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'key'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'val'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'SV *',
'name' => 'mpxs_Apache2__Directive_as_hash',
'attr' => [
'static',
Index: t/response/TestModperl/pnotes.pm
===================================================================
--- t/response/TestModperl/pnotes.pm (revision 385602)
+++ t/response/TestModperl/pnotes.pm (working copy)
@@ -4,6 +4,7 @@
use warnings FATAL => 'all';
use Apache2::RequestUtil ();
+use Apache2::ConnectionUtil ();
use Apache::Test;
use Apache::TestUtil;
@@ -11,39 +12,88 @@
use Apache2::Const -compile => 'OK';
sub handler {
+
my $r = shift;
- plan $r, tests => 9;
+ # make it ok to call ok() here while plan()ing elsewhere
+ Apache::Test::init_test_pm($r);
+ $Test::ntest = 1 + (22 * ($r->args - 1));
+ $Test::planned = 22;
- ok $r->pnotes;
+ my $c = $r->connection;
- ok t_cmp($r->pnotes('pnotes_foo', 'pnotes_bar'),
- 'pnotes_bar',
- q{$r->pnotes(key,val)});
+ # we call this handler 3 times.
+ # $r->pnotes('request') should be unset each time
+ # $c->pnotes('connection') should be unset the first
+ # time but set the second time due to the keepalive
+ # request. the second request then cleans up after
+ # itself, leaving $c->pnotes again unset at the
+ # start of the third request
+ if ($r->args == 2) {
+ ok t_cmp($c->pnotes('connection'),
+ 'CSET',
+ '$c->pnotes() persists across keepalive requests');
+ }
+ else {
+ t_debug('testing $c->pnotes is empty');
+ ok (! $c->pnotes('connection'));
+ }
- ok t_cmp($r->pnotes('pnotes_foo'),
- 'pnotes_bar',
- q{$r->pnotes(key)});
+ # $r->pnotes should be reset each time
+ t_debug('testing $r->pnotes is empty');
+ ok (! $r->pnotes('request'));
- ok t_cmp(ref($r->pnotes), 'HASH', q{ref($r->pnotes)});
+ foreach my $map ({type => 'r', object => $r},
+ {type => 'c', object => $c}) {
- ok t_cmp($r->pnotes()->{'pnotes_foo'}, 'pnotes_bar',
- q{$r->pnotes()->{}});
+ my $type = $map->{type};
- # unset the entry (but the entry remains with undef value)
- $r->pnotes('pnotes_foo', undef);
- ok t_cmp($r->pnotes('pnotes_foo'), undef,
- q{unset entry contents});
- my $exists = exists $r->pnotes->{'pnotes_foo'};
- $exists = 1 if $] < 5.008001; # changed in perl 5.8.1
- ok $exists;
+ my $o = $map->{object};
- # now delete completely (possible only via the hash inteface)
- delete $r->pnotes()->{'pnotes_foo'};
- ok t_cmp($r->pnotes('pnotes_foo'), undef,
- q{deleted entry contents});
- ok !exists $r->pnotes->{'pnotes_foo'};
+ t_debug("testing $type->pnotes call");
+ ok $o->pnotes;
+ ok t_cmp($o->pnotes('pnotes_foo', 'pnotes_bar'),
+ 'pnotes_bar',
+ "$type->pnotes(key,val)");
+
+ ok t_cmp($o->pnotes('pnotes_foo'),
+ 'pnotes_bar',
+ "$type->pnotes(key)");
+
+ ok t_cmp(ref($o->pnotes), 'HASH', "ref($type->pnotes)");
+
+ ok t_cmp($o->pnotes()->{'pnotes_foo'}, 'pnotes_bar',
+ "$type->pnotes()->{}");
+
+ # unset the entry (but the entry remains with undef value)
+ $o->pnotes('pnotes_foo', undef);
+ ok t_cmp($o->pnotes('pnotes_foo'), undef,
+ "unset $type contents");
+
+ my $exists = exists $o->pnotes->{'pnotes_foo'};
+ $exists = 1 if $] < 5.008001; # changed in perl 5.8.1
+ ok $exists;
+
+ # now delete completely (possible only via the hash inteface)
+ delete $o->pnotes()->{'pnotes_foo'};
+ ok t_cmp($o->pnotes('pnotes_foo'), undef,
+ "deleted $type contents");
+ ok !exists $o->pnotes->{'pnotes_foo'};
+ }
+
+ # set pnotes so we can test unset on later connections
+ $r->pnotes(request => 'RSET');
+ $c->pnotes(connection => 'CSET');
+
+ ok t_cmp($r->pnotes('request'),
+ 'RSET',
+ '$r->pnotes() set');
+
+ ok t_cmp($c->pnotes('connection'),
+ 'CSET',
+ '$c->pnotes() set');
+
Apache2::Const::OK;
}
signature.asc
Description: OpenPGP digital signature
