Geoffrey Young wrote: > > Jeff Ambrosino wrote: > >>I've made great use of $r->pnotes, and now finding myself in need of a >>similar way to stash objects within the connection object. While >>there are regular 'notes' offered by the connection ($c->notes), >>unfortunately there is no 'pnotes'. Any suggestions for a workaround? > > > try this patch
blarg, that patch was incomplete. here's the right one (I hope). sorry. --Geoff
Index: src/modules/perl/modperl_config.c =================================================================== --- src/modules/perl/modperl_config.c (revision 328346) +++ 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 328346) +++ 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 328346) +++ 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: xs/maps/modperl_functions.map =================================================================== --- xs/maps/modperl_functions.map (revision 328346) +++ xs/maps/modperl_functions.map (working copy) @@ -91,6 +91,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/tables/current/ModPerl/FunctionTable.pm =================================================================== --- xs/tables/current/ModPerl/FunctionTable.pm (revision 328346) +++ xs/tables/current/ModPerl/FunctionTable.pm (working copy) @@ -1481,6 +1481,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' => [ @@ -6182,6 +6192,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 328346) +++ 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; } --- /dev/null 2005-10-24 04:58:49.190343808 -0700 +++ t/modperl/pnotes.t 2005-10-25 10:56:46.000000000 -0700 @@ -0,0 +1,26 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::TestRequest qw(GET_BODY_ASSERT); +use Apache::Test; +use Apache::TestUtil; + +my $module = 'TestModperl::pnotes'; +my $url = Apache::TestRequest::module2url($module); + +t_debug("connecting to $url"); + +plan tests => (22 * 3); + +# first with keepalives +Apache::TestRequest::user_agent(reset => 1, keep_alive => 1); +t_debug("issuing first request"); +print GET_BODY_ASSERT "$url?1"; + +# now close the connection +t_debug("issuing second request"); +print GET_BODY_ASSERT "$url?2", Connection => 'close'; + +# finally, check for a cleared $c->pnotes +t_debug("issuing final request"); +print GET_BODY_ASSERT "$url?3"; --- /dev/null 2005-10-24 04:58:49.190343808 -0700 +++ xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h 2005-10-25 10:33:27.000000000 -0700 @@ -0,0 +1,53 @@ +/* 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; + SV *retval = NULL; + + /* note we do not need to implement a per-connection cleanup to + * reset $c->pnotes. this is because we don't hook into + * ap_hook_create_connection and therefore each new connection + * has no &perl_module data in the configuration vector + */ + if (!ccfg) { + MP_TRACE_a(MP_FUNC, "creating new ccfg"); + modperl_config_con_init(c, ccfg); + } + + if (!ccfg->pnotes) { + ccfg->pnotes = newHV(); + } + + if (key) { + STRLEN len; + char *k = SvPV(key, len); + + if (val) { + retval = *hv_store(ccfg->pnotes, k, len, + SvREFCNT_inc(val), 0); + } + else if (hv_exists(ccfg->pnotes, k, len)) { + retval = *hv_fetch(ccfg->pnotes, k, len, FALSE); + } + } + else { + retval = newRV_inc((SV *)ccfg->pnotes); + } + + return retval ? SvREFCNT_inc(retval) : &PL_sv_undef; +}