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, which makes the following possible use Apache2::ConnectionUtil (); ... my $note = $c->pnotes('foo'); you'll need to 'make realclean' before applying the patch, then completely rebuild again in order for the new method to be picked up and the tests to be present. the tests are in the (now expanded) t/modperl/pnotes.t test. I've tested it against 2.0 (worker) and 2.1 (prefork) and it seems to work and not coredump, but more vigorous testing always appreciated. --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.445426566 -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";