Author: stas
Date: Sun Dec 26 17:06:31 2004
New Revision: 123375

URL: http://svn.apache.org/viewcvs?view=rev&rev=123375
Log:
- Apache::RequestUtil: new: create the pool dependency 
- adjust modperl_xs_sv2request_rec not to assume that there is only one 
magic: check that mg->mg_ptr is set (i.e. created by modperl and not 
Apache::RequestUtil::new) before returning it

Modified:
   perl/modperl/trunk/Changes
   perl/modperl/trunk/src/modules/perl/modperl_util.c
   perl/modperl/trunk/t/response/TestAPI/request_rec.pm
   perl/modperl/trunk/todo/release
   perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h
   perl/modperl/trunk/xs/maps/modperl_functions.map
   perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm

Modified: perl/modperl/trunk/Changes
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=123375&p1=perl/modperl/trunk/Changes&r1=123374&p2=perl/modperl/trunk/Changes&r2=123375
==============================================================================
--- perl/modperl/trunk/Changes  (original)
+++ perl/modperl/trunk/Changes  Sun Dec 26 17:06:31 2004
@@ -26,6 +26,7 @@
 - APR::Table: copy, overlay, make
 - APR::ThreadMutex: new
 - APR::URI: parse
+- Apache::RequestUtil: new
 
 speed up the 'perl Makefile.PL' stage [Randy Kobes]:
  - reduce the number of calls to build_config() of

Modified: perl/modperl/trunk/src/modules/perl/modperl_util.c
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/modperl_util.c?view=diff&rev=123375&p1=perl/modperl/trunk/src/modules/perl/modperl_util.c&r1=123374&p2=perl/modperl/trunk/src/modules/perl/modperl_util.c&r2=123375
==============================================================================
--- perl/modperl/trunk/src/modules/perl/modperl_util.c  (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_util.c  Sun Dec 26 17:06:31 2004
@@ -154,7 +154,9 @@
         return r;
     }
 
-    if ((mg = mg_find(sv, PERL_MAGIC_ext))) {
+    /* there could be pool magic attached to custom $r object, so make
+     * sure that mg->mg_ptr is set */
+    if ((mg = mg_find(sv, PERL_MAGIC_ext)) && mg->mg_ptr) {
         return (request_rec *)mg->mg_ptr;
     }
     else {

Modified: perl/modperl/trunk/t/response/TestAPI/request_rec.pm
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestAPI/request_rec.pm?view=diff&rev=123375&p1=perl/modperl/trunk/t/response/TestAPI/request_rec.pm&r1=123374&p2=perl/modperl/trunk/t/response/TestAPI/request_rec.pm&r2=123375
==============================================================================
--- perl/modperl/trunk/t/response/TestAPI/request_rec.pm        (original)
+++ perl/modperl/trunk/t/response/TestAPI/request_rec.pm        Sun Dec 26 
17:06:31 2004
@@ -11,6 +11,7 @@
 use Apache::RequestUtil ();
 
 use APR::Finfo ();
+use APR::Pool ();
 
 use Apache::Const -compile => qw(OK M_GET M_PUT);
 use APR::Const    -compile => qw(FINFO_NORM);
@@ -23,7 +24,7 @@
 sub handler {
     my $r = shift;
 
-    plan $r, tests => 53;
+    plan $r, tests => 54;
 
     #Apache->request($r); #PerlOptions +GlobalRequest takes care
     my $gr = Apache->request;
@@ -207,6 +208,18 @@
         ok t_cmp $@, qr/$err/, "invalid $r object";
     }
 
+    # out-of-scope pools
+    {
+        my $newr = Apache::RequestRec->new($r->connection, APR::Pool->new);
+        {
+            require APR::Table;
+            # try to overwrite the pool
+            my $table = APR::Table::make(APR::Pool->new, 50);
+            $table->set($_ => $_) for 'aa'..'za';
+        }
+        # check if $newr is still OK
+        ok $newr->connection->isa('Apache::Connection');
+    }
 
     # tested in other tests
     # - input_filters:    TestAPI::in_out_filters

Modified: perl/modperl/trunk/todo/release
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/todo/release?view=diff&rev=123375&p1=perl/modperl/trunk/todo/release&r1=123374&p2=perl/modperl/trunk/todo/release&r2=123375
==============================================================================
--- perl/modperl/trunk/todo/release     (original)
+++ perl/modperl/trunk/todo/release     Sun Dec 26 17:06:31 2004
@@ -45,7 +45,4 @@
   
   APR::Pool:
   ? mpxs_apr_pool_create (having problems): APR__Pool.patch
-  
-  Apache::RequestUtil:
-  ? mpxs_Apache__RequestRec_new (having problems): Apache__RequestUtil.patch
 

Modified: perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h?view=diff&rev=123375&p1=perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h&r1=123374&p2=perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h&r2=123375
==============================================================================
--- perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h      
(original)
+++ perl/modperl/trunk/xs/Apache/RequestUtil/Apache__RequestUtil.h      Sun Dec 
26 17:06:31 2004
@@ -54,17 +54,21 @@
  */
 
 static MP_INLINE
-request_rec *mpxs_Apache__RequestRec_new(SV *classname,
-                                         conn_rec *c,
-                                         apr_pool_t *base_pool)
+SV *mpxs_Apache__RequestRec_new(pTHX_ SV *classname,
+                                conn_rec *c,
+                                SV *base_pool_sv)
 {
-    apr_pool_t *p;
+    apr_pool_t *p, *base_pool;
     request_rec *r;
     server_rec *s = c->base_server;
+    SV *r_sv;
 
     /* see: httpd-2.0/server/protocol.c:ap_read_request */
 
-    if (!base_pool) {
+    if (base_pool_sv) {
+        base_pool = mp_xs_sv2_APR__Pool(base_pool_sv);
+    }
+    else {
         base_pool = c->pool;
     }
 
@@ -113,7 +117,13 @@
     r->assbackwards    = 1;
     r->protocol        = "UNKNOWN";
 
-    return r;
+    r_sv = sv_setref_pv(NEWSV(0, 0), "Apache::RequestRec", (void*)r);
+
+    if (base_pool_sv) {
+        mpxs_add_pool_magic(r_sv, base_pool_sv);
+    }
+    
+    return r_sv;
 }
 
 static MP_INLINE

Modified: perl/modperl/trunk/xs/maps/modperl_functions.map
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/maps/modperl_functions.map?view=diff&rev=123375&p1=perl/modperl/trunk/xs/maps/modperl_functions.map&r1=123374&p2=perl/modperl/trunk/xs/maps/modperl_functions.map&r2=123375
==============================================================================
--- perl/modperl/trunk/xs/maps/modperl_functions.map    (original)
+++ perl/modperl/trunk/xs/maps/modperl_functions.map    Sun Dec 26 17:06:31 2004
@@ -39,7 +39,7 @@
  mpxs_Apache__RequestRec_set_basic_credentials
  mpxs_Apache__RequestRec_no_cache | | r, flag=Nullsv
 PACKAGE=Apache::RequestRec
- mpxs_Apache__RequestRec_new | | classname, c, base_pool=NULL
+ mpxs_Apache__RequestRec_new | | classname, c, base_pool_sv=Nullsv
  SV *:DEFINE_dir_config | | request_rec *:r, char *:key=NULL, SV 
*:sv_val=Nullsv
  SV *:DEFINE_slurp_filename | | request_rec *:r, int:tainted=1
 

Modified: perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm
Url: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm?view=diff&rev=123375&p1=perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm&r1=123374&p2=perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm&r2=123375
==============================================================================
--- perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm       
(original)
+++ perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm       Sun Dec 
26 17:06:31 2004
@@ -2,7 +2,7 @@
 
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 # ! WARNING: generated by ModPerl::ParseSource/0.01
-# !          Fri Dec 24 18:39:57 2004
+# !          Fri Dec 24 18:59:48 2004
 # !          do NOT edit, any changes will be lost !
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -6836,10 +6836,14 @@
     ]
   },
   {
-    'return_type' => 'request_rec *',
+    'return_type' => 'SV *',
     'name' => 'mpxs_Apache__RequestRec_new',
     'args' => [
       {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
         'type' => 'SV *',
         'name' => 'classname'
       },
@@ -6848,8 +6852,8 @@
         'name' => 'c'
       },
       {
-        'type' => 'apr_pool_t *',
-        'name' => 'base_pool'
+        'type' => 'SV *',
+        'name' => 'base_pool_sv'
       }
     ]
   },

Reply via email to