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;
+}

Reply via email to