? config.nice
? log
? smoke-report-Fri_Sep_24_01-02-55_2004.txt.1.temp
? smoke-report-Mon_Sep_27_21-17-48_2004.txt.2.temp
? smoke-report-Mon_Sep_27_22-11-02_2004.txt.1.temp
? smoke-report-Sun_Sep_26_16-28-45_2004.txt.1.temp
? src/modules/perl/modperl_bucket.c.testing
? t/core.10540
? t/core.12306
? t/core.17751
? t/core.25455
? t/core.28581
? t/core.2901
Index: docs/api/APR/Brigade.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/api/APR/Brigade.pod,v
retrieving revision 1.10
diff -u -r1.10 Brigade.pod
--- docs/api/APR/Brigade.pod	12 Jul 2004 23:13:22 -0000	1.10
+++ docs/api/APR/Brigade.pod	29 Sep 2004 15:42:06 -0000
@@ -389,6 +389,31 @@
 
 
 
+=head2 C<bucket_alloc>
+
+  my $ba = $bb->bucket_alloc();
+  $bb2->bucket_alloc($ba);
+
+=over 4
+
+=item obj: C<$bb>
+( C<L<APR::Brigade object or class|docs::2.0::api::APR::Brigade>> )
+
+
+=item opt arg1: C<$bucket_alloc>
+( C<L<APR::BucketAlloc object|docs::2.0::api::APR::BucketAlloc>> )
+
+Get/set the bucket allocator associated with this brigade.
+
+=item since: 1.99_17
+
+=back
+
+
+
+
+
+
 =head2 C<next>
 
 Return the next bucket in a brigade
@@ -525,9 +550,9 @@
 brigade such that the second brigade will have the last two buckets.
 
   my $bb1 = APR::Brigade->new($r->pool, $c->bucket_alloc);
-  $bb1->insert_tail(APR::Bucket->new("1"));
-  $bb1->insert_tail(APR::Bucket->new("2"));
-  $bb1->insert_tail(APR::Bucket->new("3"));
+  $bb1->insert_tail(APR::Bucket->new($c->bucket_alloc, "1"));
+  $bb1->insert_tail(APR::Bucket->new($c->bucket_alloc, "2"));
+  $bb1->insert_tail(APR::Bucket->new($c->bucket_alloc, "3"));
 
 C<$bb1> now contains buckets "1", "2", "3". Now do the split at the
 second bucket:
Index: docs/api/APR/Bucket.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/api/APR/Bucket.pod,v
retrieving revision 1.13
diff -u -r1.13 Bucket.pod
--- docs/api/APR/Bucket.pod	21 Aug 2004 00:48:47 -0000	1.13
+++ docs/api/APR/Bucket.pod	29 Sep 2004 15:42:06 -0000
@@ -10,7 +10,7 @@
   use APR::Bucket ();
   my $ba = $c->bucket_alloc;
   
-  $b1 = APR::Bucket->new("aaa");
+  $b1 = APR::Bucket->new($ba, "aaa");
   $b2 = APR::Bucket::eos_create($ba);
   $b3 = APR::Bucket::flush_create($ba);
   
@@ -44,8 +44,8 @@
 to visualize the operations:
 
   my $bb = APR::Brigade->new($r->pool, $ba);
-  my $d1 = APR::Bucket->new("d1");
-  my $d2 = APR::Bucket->new("d2");
+  my $d1 = APR::Bucket->new($ba, "d1");
+  my $d2 = APR::Bucket->new($ba, "d2");
   my $f1 = APR::Bucket::flush_create($ba);
   my $f2 = APR::Bucket::flush_create($ba);
   my $e1 = APR::Bucket::eos_create($ba);
@@ -105,7 +105,7 @@
 
   for (my $b = $bb->first; $b; $b = $bb->next($b)) {
      if ($b->read(my $data)) {
-          my $nb = APR::Bucket->new(uc $data);
+          my $nb = APR::Bucket->new($bb->bucket_alloc, uc $data);
           $b->insert_before($nb);
           $b->delete;
           $b = $nb;
@@ -152,6 +152,70 @@
 
 
 
+=head2 C<alloc_create>
+
+Create an C<APR::BucketAlloc> freelist.
+
+  $ba = APR::Bucket::alloc_create($pool);
+
+=over 4
+
+=item arg1: C<$pool>
+( C<L<APR::Pool object|docs::2.0::api::APR::Pool>> )
+
+The pool used to create this this freelist.
+
+=item ret: C<$ba>
+( C<L<APR::BucketAlloc object|docs::2.0::api::APR::BucketAlloc>> )
+
+The new freelist.
+
+=item since: 1.99_17
+
+=back
+
+These freelists are used to create new buckets and bucket
+brigades.  Normally it is not necesssary to create them,
+since the existing bucket brigades and/or connection objects 
+in modperl-2 provide them automatically.
+
+Example:
+
+  use APR::Bucket ();
+  use Apache::Connection ();
+  my $ba = APR::Bucket::alloc_create($c->$pool);
+  my $eos_b = APR::Bucket::eos_create($ba);
+
+
+
+
+
+=head2 C<alloc_destroy>
+
+Destroy an C<APR::BucketAlloc> freelist.
+
+  APR::Bucket::alloc_destroy($ba);
+
+=over 4
+
+=item arg1: C<$ba>
+( C<L<APR::BucketAlloc object|docs::2.0::api::APR::BucketAlloc>> )
+
+The freelist to destroy.
+
+=item since: 1.99_17
+
+=back
+
+Destroys the freelist; this object may not be used again.
+Normally it is not necessary to destroy allocators, since
+the pool which created them will destroy them during pool
+cleanup.
+
+
+
+
+
 =head2 C<eos_create>
 
 Create an I<EndOfStream> bucket.
@@ -351,17 +415,20 @@
 
 Create a new bucket and initialize it with data:
 
-  $nb = APR::Bucket->new($data);
-  $nb =          $b->new($data);
-  $nb = APR::Bucket->new($data, $offset);
-  $nb = APR::Bucket->new($data, $offset, $len);
+  $nb = APR::Bucket->new($bucket_alloc, $data);
+  $nb =          $b->new($bucket_alloc, $data);
+  $nb = APR::Bucket->new($bucket_alloc, $data, $offset);
+  $nb = APR::Bucket->new($bucket_alloc, $data, $offset, $len);
 
 =over 4
 
 =item obj: C<$b>
 ( C<L<APR::Bucket object or class|docs::2.0::api::APR::Bucket>> )
 
-=item arg1: C<$data> ( string )
+=item arg1: C<$bucket_alloc>
+( C<L<APR::BucketAlloc object|docs::2.0::api::APR::BucketAlloc>> )
+
+=item arg2: C<$data> ( string )
 
 The data to initialize with.
 
@@ -370,11 +437,11 @@
 after passing it to C<new()> you will modify the data in the bucket as
 well. To avoid that pass to C<new()> a copy which you won't modify.
 
-=item opt arg2: C<$offset> ( number )
+=item opt arg3: C<$offset> ( number )
 
 Optional offset inside C<$data>. Default: 0.
 
-=item opt arg3: C<$len> ( number )
+=item opt arg4: C<$len> ( number )
 
 Optional partial length to read.
 
@@ -391,7 +458,7 @@
 
 a newly created bucket object
 
-=item since: 1.99_10
+=item since: 1.99_17
 
 =back
 
@@ -405,7 +472,7 @@
 
   use APR::Bucket ();
   my $data = "my data";
-  my $b = APR::Bucket->new($data);
+  my $b = APR::Bucket->new($ba, $data);
 
 now the bucket contains the string I<'my data'>.
 
@@ -416,7 +483,7 @@
   use APR::Bucket ();
   my $data   = "my data";
   my $offset = 3;
-  my $b = APR::Bucket->new($data, $offset);
+  my $b = APR::Bucket->new($ba, $data, $offset);
 
 now the bucket contains the string I<'data'>.
 
@@ -429,7 +496,7 @@
   my $data   = "my data";
   my $offset = 3;
   my $len    = 3;
-  my $b = APR::Bucket->new($data, $offset, $len);
+  my $b = APR::Bucket->new($ba, $data, $offset, $len);
 
 now the bucket contains the string I<'dat'>.
 
@@ -443,7 +510,7 @@
 
 Read the data from the bucket.
 
-  $len = $b->read($buffer,);
+  $len = $b->read($buffer);
   $len = $b->read($buffer, $block);
 
 =over 4
@@ -621,7 +688,7 @@
 It gives the offset to when a new bucket is created with a non-zero
 offset value:
 
-  my $b = APR::Bucket->new($data, $offset, $len);
+  my $b = APR::Bucket->new($ba, $data, $offset, $len);
 
 So if the offset was 3. C<$start> will be 3 too.
 
Index: docs/api/Apache/RequestRec.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/api/Apache/RequestRec.pod,v
retrieving revision 1.32
diff -u -r1.32 RequestRec.pod
--- docs/api/Apache/RequestRec.pod	21 Sep 2004 13:58:03 -0000	1.32
+++ docs/api/Apache/RequestRec.pod	29 Sep 2004 15:42:08 -0000
@@ -1180,7 +1180,7 @@
       my $bb = APR::Brigade->new($r->pool,
                                  $r->connection->bucket_alloc);
   
-      my $b = APR::Bucket->new($data);
+      my $b = APR::Bucket->new($bb->bucket_alloc, $data);
       $bb->insert_tail($b);
       $r->output_filters->fflush($bb);
       $bb->destroy;
Index: docs/user/handlers/filters.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/user/handlers/filters.pod,v
retrieving revision 1.46
diff -u -r1.46 filters.pod
--- docs/user/handlers/filters.pod	15 Aug 2004 07:54:00 -0000	1.46
+++ docs/user/handlers/filters.pod	29 Sep 2004 15:42:11 -0000
@@ -1535,7 +1535,7 @@
           warn("data: $data\n");
   
           if ($data and $data =~ s|^GET|HEAD|) {
-              my $nb = APR::Bucket->new($data);
+              my $nb = APR::Bucket->new($bb->bucket_alloc, $data);
               $b->insert_after($nb);
               $b->remove; # no longer needed
               $f->ctx(1); # flag that that we have done the job
@@ -1769,7 +1769,7 @@
           }
   
           my $len = $b->read(my $data);
-          $b = APR::Bucket->new(lc $data) if $len;
+          $b = APR::Bucket->new($bb->bucket_alloc, lc $data) if $len;
   
           $b->remove;
           $bb->insert_tail($b);
@@ -2120,7 +2120,7 @@
           if ($b->read(my $data)) {
               $data = join "",
                   map {scalar(reverse $_), "\n"} split "\n", $data;
-              $b = APR::Bucket->new($data);
+              $b = APR::Bucket->new($bb->bucket_alloc, $data);
           }
   
           $b->remove;
@@ -2355,7 +2355,7 @@
       # in ctx
       for (split_buffer($buffer)) {
           if (length($_) == TOKEN_SIZE) {
-              $bb->insert_tail(APR::Bucket->new($_));
+              $bb->insert_tail(APR::Bucket->new($ba, $_));
           }
           else {
               $ctx .= $_;
@@ -2365,7 +2365,7 @@
       my $len = length($ctx);
       if ($seen_eos) {
           # flush the remainder
-          $bb->insert_tail(APR::Bucket->new($ctx));
+          $bb->insert_tail(APR::Bucket->new($ba, $ctx));
           $bb->insert_tail(APR::Bucket::eos_create($ba));
           warn "seen eos, flushing the remaining: $len bytes\n";
       }
Index: docs/user/handlers/protocols.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/user/handlers/protocols.pod,v
retrieving revision 1.28
diff -u -r1.28 protocols.pod
--- docs/user/handlers/protocols.pod	15 Aug 2004 07:54:00 -0000	1.28
+++ docs/user/handlers/protocols.pod	29 Sep 2004 15:42:12 -0000
@@ -366,7 +366,7 @@
               if ($b->read(my $data)) {
                   $last++ if $data =~ /^[\r\n]+$/;
                   # could do some transformation on data here
-                  $b = APR::Bucket->new($data);
+                  $b = APR::Bucket->new($bb->bucket_alloc, $data);
               }
   
               $b->remove;
@@ -469,7 +469,7 @@
   
               if ($b->read(my $data)) {
                   last if $data =~ /^[\r\n]+$/;
-                  my $nb = APR::Bucket->new(uc $data);
+                  my $nb = APR::Bucket->new($bb->bucket_alloc, uc $data);
                   # head->...->$nb->$b ->...->tail
                   $b->insert_before($nb);
                   $b->remove;
@@ -575,7 +575,7 @@
           last if $data =~ /^[\r\n]+$/;
   
           # could transform data here
-          my $b = APR::Bucket->new($data);
+          my $b = APR::Bucket->new($bb->bucket_alloc, $data);
           $bb->insert_tail($b);
   
           $c->output_filters->fflush($bb);
Index: src/modules/perl/modperl_bucket.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_bucket.c,v
retrieving revision 1.12
diff -u -r1.12 modperl_bucket.c
--- src/modules/perl/modperl_bucket.c	13 Aug 2004 01:41:35 -0000	1.12
+++ src/modules/perl/modperl_bucket.c	29 Sep 2004 15:42:13 -0000
@@ -30,22 +30,25 @@
 modperl_bucket_sv_read(apr_bucket *bucket, const char **str,
                        apr_size_t *len, apr_read_type_e block)
 {
-    modperl_bucket_sv_t *svbucket =
-        (modperl_bucket_sv_t *)bucket->data;
+    modperl_bucket_sv_t *svbucket = bucket->data;
     dTHXa(svbucket->perl);
-    STRLEN n_a;
-    char *pv = SvPV(svbucket->sv, n_a);
+    STRLEN svlen;
+    char *pv = SvPV(svbucket->sv, svlen);
 
     *str = pv + bucket->start;
     *len = bucket->length;
 
+    if (svlen < bucket->start + bucket->length) {
+        /* XXX log error? */
+        return APR_EGENERAL;
+    }
+
     return APR_SUCCESS;
 }
 
 static void modperl_bucket_sv_destroy(void *data)
 {
-    modperl_bucket_sv_t *svbucket = 
-        (modperl_bucket_sv_t *)data;
+    modperl_bucket_sv_t *svbucket = data;
     dTHXa(svbucket->perl);
 
     if (!apr_bucket_shared_destroy(svbucket)) {
@@ -59,7 +62,34 @@
 
     SvREFCNT_dec(svbucket->sv);
 
-    free(svbucket);
+    apr_bucket_free(svbucket);
+}
+
+static 
+apr_status_t modperl_bucket_sv_setaside(apr_bucket *bucket, apr_pool_t *pool)
+{
+    modperl_bucket_sv_t *svbucket = bucket->data;
+    dTHXa(svbucket->perl);
+    STRLEN svlen;
+    char *pv = SvPV(svbucket->sv, svlen);
+
+    if (svlen < bucket->start + bucket->length) {
+        /* XXX log error? */
+        return APR_EGENERAL;
+    }
+
+    pv = apr_pstrmemdup(pool, pv + bucket->start, bucket->length);
+    if (pv == NULL) {
+        return APR_ENOMEM;
+    }
+
+    bucket = apr_bucket_pool_make(bucket, pv, bucket->length, pool);
+    if (bucket == NULL) {
+        return APR_ENOMEM;
+    }
+
+    modperl_bucket_sv_destroy(svbucket);
+    return APR_SUCCESS;
 }
 
 static const apr_bucket_type_t modperl_bucket_sv_type = {
@@ -69,7 +99,7 @@
 #endif
     modperl_bucket_sv_destroy,
     modperl_bucket_sv_read,
-    apr_bucket_setaside_notimpl,
+    modperl_bucket_sv_setaside,
     apr_bucket_shared_split,
     apr_bucket_shared_copy,
 };
@@ -82,11 +112,11 @@
 {
     modperl_bucket_sv_t *svbucket; 
 
-    svbucket = (modperl_bucket_sv_t *)malloc(sizeof(*svbucket));
+    svbucket = apr_bucket_alloc(sizeof(*svbucket), bucket->list);
 
     bucket = apr_bucket_shared_make(bucket, svbucket, offset, len);
     if (!bucket) {
-        free(svbucket);
+        apr_bucket_free(svbucket);
         return NULL;
     }
 
@@ -112,18 +142,17 @@
                (unsigned long)svbucket->sv, SvREFCNT(svbucket->sv));
 
     bucket->type = &modperl_bucket_sv_type;
-    bucket->free = free;
-
     return bucket;
 }
 
-apr_bucket *modperl_bucket_sv_create(pTHX_ SV *sv, apr_off_t offset,
-                                     apr_size_t len)
+apr_bucket *modperl_bucket_sv_create(pTHX_ apr_bucket_alloc_t *list, SV *sv, 
+                                     apr_off_t offset, apr_size_t len)
 {
     apr_bucket *bucket;
 
-    bucket = (apr_bucket *)malloc(sizeof(*bucket));
+    bucket = apr_bucket_alloc(sizeof(*bucket), list);
     APR_BUCKET_INIT(bucket);
-
+    bucket->list = list;
+    bucket->free = apr_bucket_free;
     return modperl_bucket_sv_make(aTHX_ bucket, sv, offset, len);
 }
Index: src/modules/perl/modperl_bucket.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_bucket.h,v
retrieving revision 1.3
diff -u -r1.3 modperl_bucket.h
--- src/modules/perl/modperl_bucket.h	13 Jun 2004 05:39:09 -0000	1.3
+++ src/modules/perl/modperl_bucket.h	29 Sep 2004 15:42:13 -0000
@@ -16,7 +16,7 @@
 #ifndef MODPERL_BUCKET_H
 #define MODPERL_BUCKET_H
 
-apr_bucket *modperl_bucket_sv_create(pTHX_ SV *sv, apr_off_t offset,
-                                     apr_size_t len);
+apr_bucket *modperl_bucket_sv_create(pTHX_ apr_bucket_alloc_t *list, SV *sv, 
+                                     apr_off_t offset, apr_size_t len);
 
 #endif /* MODPERL_BUCKET_H */
Index: t/api/in_out_filters.t
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/api/in_out_filters.t,v
retrieving revision 1.1
diff -u -r1.1 in_out_filters.t
--- t/api/in_out_filters.t	24 Jul 2004 06:54:25 -0000	1.1
+++ t/api/in_out_filters.t	29 Sep 2004 15:42:13 -0000
@@ -14,5 +14,5 @@
 my $expected = lc $content;
 my $received = POST_BODY $location, content => $content;
 
-ok $expected eq $received;
+ok t_cmp $received, $expected, 'lc($in) eq $out';
 
Index: t/filter/TestFilter/in_bbs_body.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/in_bbs_body.pm,v
retrieving revision 1.10
diff -u -r1.10 in_bbs_body.pm
--- t/filter/TestFilter/in_bbs_body.pm	21 Aug 2004 00:27:22 -0000	1.10
+++ t/filter/TestFilter/in_bbs_body.pm	29 Sep 2004 15:42:13 -0000
@@ -24,7 +24,7 @@
 
         if ($b->read(my $data)) {
             #warn"[$data]\n";
-            my $nb = APR::Bucket->new(scalar reverse $data);
+            my $nb = APR::Bucket->new($bb->bucket_alloc, scalar reverse $data);
             $b->insert_before($nb);
             $b->delete;
             $b = $nb;
Index: t/filter/TestFilter/in_bbs_consume.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/in_bbs_consume.pm,v
retrieving revision 1.5
diff -u -r1.5 in_bbs_consume.pm
--- t/filter/TestFilter/in_bbs_consume.pm	9 Jun 2004 14:46:21 -0000	1.5
+++ t/filter/TestFilter/in_bbs_consume.pm	29 Sep 2004 15:42:13 -0000
@@ -48,7 +48,7 @@
 
     if ($seen_eos) {
         # flush the remainder
-        $bb->insert_tail(APR::Bucket->new($buffer));
+        $bb->insert_tail(APR::Bucket->new($ba, $buffer));
         $bb->insert_tail(APR::Bucket::eos_create($ba));
         debug "seen eos, sending: " . length($buffer) . " bytes";
     }
Index: t/filter/TestFilter/in_bbs_inject_header.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/in_bbs_inject_header.pm,v
retrieving revision 1.11
diff -u -r1.11 in_bbs_inject_header.pm
--- t/filter/TestFilter/in_bbs_inject_header.pm	21 Aug 2004 00:42:00 -0000	1.11
+++ t/filter/TestFilter/in_bbs_inject_header.pm	29 Sep 2004 15:42:14 -0000
@@ -179,7 +179,7 @@
         if ($data and $data =~ /^POST/) {
             # demonstrate how to add a header while processing other headers
             my $header = "$header1_key: $header1_val\n";
-            push @{ $ctx->{buckets} }, APR::Bucket->new($header);
+            push @{ $ctx->{buckets} }, APR::Bucket->new($c->bucket_alloc, $header);
             debug "queued header [$header]";
         }
         elsif ($data =~ /^[\r\n]+$/) {
@@ -197,7 +197,7 @@
             # time to add extra headers:
             for my $key (keys %headers) {
                 my $header = "$key: $headers{$key}\n";
-                push @{ $ctx->{buckets} }, APR::Bucket->new($header);
+                push @{ $ctx->{buckets} }, APR::Bucket->new($c->bucket_alloc, $header);
                 debug "queued header [$header]";
             }
 
Index: t/filter/TestFilter/in_bbs_msg.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm,v
retrieving revision 1.14
diff -u -r1.14 in_bbs_msg.pm
--- t/filter/TestFilter/in_bbs_msg.pm	21 Aug 2004 00:27:22 -0000	1.14
+++ t/filter/TestFilter/in_bbs_msg.pm	29 Sep 2004 15:42:14 -0000
@@ -32,7 +32,7 @@
         if ($b->read(my $data)) {
             next unless $data =~ s|GET $from_url|GET $to_url|;
             debug "GET line rewritten to be:\n$data";
-            my $nb = APR::Bucket->new($data);
+            my $nb = APR::Bucket->new($bb->bucket_alloc, $data);
             $b->insert_before($nb);
             $b->delete;
             $b = $nb;
Index: t/filter/TestFilter/in_bbs_underrun.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/in_bbs_underrun.pm,v
retrieving revision 1.8
diff -u -r1.8 in_bbs_underrun.pm
--- t/filter/TestFilter/in_bbs_underrun.pm	9 Jun 2004 14:46:21 -0000	1.8
+++ t/filter/TestFilter/in_bbs_underrun.pm	29 Sep 2004 15:42:14 -0000
@@ -78,7 +78,7 @@
     # in ctx
     for (split_buffer($buffer)) {
         if (length($_) == SIZE) {
-            $bb->insert_tail(APR::Bucket->new($_));
+            $bb->insert_tail(APR::Bucket->new($bb->bucket_alloc, $_));
         }
         else {
             $ctx .= $_;
@@ -87,7 +87,7 @@
 
     if ($seen_eos) {
         # flush the remainder
-        $bb->insert_tail(APR::Bucket->new($ctx));
+        $bb->insert_tail(APR::Bucket->new($bb->bucket_alloc, $ctx));
         $bb->insert_tail(APR::Bucket::eos_create($ba));
         debug "seen eos, flushing the remaining: " . length($ctx) . " bytes";
     }
Index: t/filter/TestFilter/out_bbs_basic.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/out_bbs_basic.pm,v
retrieving revision 1.6
diff -u -r1.6 out_bbs_basic.pm
--- t/filter/TestFilter/out_bbs_basic.pm	15 Aug 2004 06:30:50 -0000	1.6
+++ t/filter/TestFilter/out_bbs_basic.pm	29 Sep 2004 15:42:14 -0000
@@ -39,12 +39,12 @@
         my $tests = Apache::TestToString->finish;
 
         my $brigade = APR::Brigade->new($filter->r->pool, $ba);
-        my $b = APR::Bucket->new($tests);
+        my $b = APR::Bucket->new($ba, $tests);
 
         $brigade->insert_tail($b);
 
         my $ok = $brigade->first->type->name =~ /mod_perl/ ? 4 : 0;
-        $brigade->insert_tail(APR::Bucket->new("ok $ok\n"));
+        $brigade->insert_tail(APR::Bucket->new($ba, "ok $ok\n"));
 
         $brigade->insert_tail(APR::Bucket::eos_create($ba));
 
Index: t/filter/TestFilter/out_bbs_ctx.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm,v
retrieving revision 1.10
diff -u -r1.10 out_bbs_ctx.pm
--- t/filter/TestFilter/out_bbs_ctx.pm	21 Aug 2004 00:27:22 -0000	1.10
+++ t/filter/TestFilter/out_bbs_ctx.pm	29 Sep 2004 15:42:14 -0000
@@ -28,7 +28,8 @@
     debug "filter got called";
 
     my $c = $filter->c;
-    my $bb_ctx = APR::Brigade->new($c->pool, $c->bucket_alloc);
+    my $ba = $c->bucket_alloc;
+    my $bb_ctx = APR::Brigade->new($c->pool, $ba);
 
     my $ctx = $filter->ctx;
     $ctx->{invoked}++;
@@ -40,10 +41,10 @@
         if ($b->is_eos) {
             debug "got EOS";
             # flush the remainings and send a stats signature
-            $bb_ctx->insert_tail(APR::Bucket->new("$data\n")) if $data;
+            $bb_ctx->insert_tail(APR::Bucket->new($ba, "$data\n")) if $data;
             my $sig = join "\n", "received $ctx->{blocks} complete blocks",
                 "filter invoked $ctx->{invoked} times\n";
-            $bb_ctx->insert_tail(APR::Bucket->new($sig));
+            $bb_ctx->insert_tail(APR::Bucket->new($ba, $sig));
             $b->remove;
             $bb_ctx->insert_tail($b);
             last;
@@ -63,7 +64,7 @@
                 $ctx->{blocks} += $blocks;
             }
             if ($blocks) {
-                my $nb = APR::Bucket->new("#" x $blocks);
+                my $nb = APR::Bucket->new($ba, "#" x $blocks);
                 $bb_ctx->insert_tail($nb);
             }
         }
Index: t/filter/TestFilter/out_bbs_filebucket.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm,v
retrieving revision 1.5
diff -u -r1.5 out_bbs_filebucket.pm
--- t/filter/TestFilter/out_bbs_filebucket.pm	21 Aug 2004 00:27:22 -0000	1.5
+++ t/filter/TestFilter/out_bbs_filebucket.pm	29 Sep 2004 15:42:14 -0000
@@ -34,7 +34,7 @@
         last if $b->is_eos;
 
         if (my $len = $b->read(my $data)) {
-            my $nb = APR::Bucket->new(uc $data);
+            my $nb = APR::Bucket->new($bb->bucket_alloc, uc $data);
             $b->insert_before($nb);
             $b->delete;
             $b = $nb;
Index: t/lib/TestAPRlib/bucket.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/lib/TestAPRlib/bucket.pm,v
retrieving revision 1.4
diff -u -r1.4 bucket.pm
--- t/lib/TestAPRlib/bucket.pm	21 Aug 2004 00:41:36 -0000	1.4
+++ t/lib/TestAPRlib/bucket.pm	29 Sep 2004 15:42:15 -0000
@@ -8,19 +8,23 @@
 use Apache::Test;
 use Apache::TestUtil;
 
+use APR::Pool ();
 use APR::Bucket ();
 use APR::BucketType ();
 
 sub num_of_tests {
-    return 14;
+    return 16;
 }
 
 sub test {
 
+    my $pool = APR::Pool->new();
+    my $ba = APR::Bucket::alloc_create($pool);
+
     # new: basic
     {
         my $data = "foobar";
-        my $b = APR::Bucket->new($data);
+        my $b = APR::Bucket->new($ba, $data);
 
         t_debug('$b is defined');
         ok defined $b;
@@ -39,7 +43,7 @@
         my $data   = "foobartar";
         my $offset = 3;
         my $real = substr $data, $offset;
-        my $b = APR::Bucket->new($data, $offset);
+        my $b = APR::Bucket->new($ba, $data, $offset);
         my $rlen = $b->read(my $read);
         ok t_cmp($read, $real, 'new($data, $offset)/buffer');
         ok t_cmp($rlen, length($read), 'new($data, $offset)/len');
@@ -53,7 +57,7 @@
         my $offset = 3;
         my $len    = 3;
         my $real = substr $data, $offset, $len;
-        my $b = APR::Bucket->new($data, $offset, $len);
+        my $b = APR::Bucket->new($ba, $data, $offset, $len);
         my $rlen = $b->read(my $read);
         ok t_cmp($read, $real, 'new($data, $offset, $len)/buffer');
         ok t_cmp($rlen, length($read), 'new($data, $offse, $lent)/len');
@@ -65,7 +69,7 @@
         my $offset = 3;
         my $len    = 10;
         my $real = substr $data, $offset, $len;
-        my $b = eval { APR::Bucket->new($data, $offset, $len) };
+        my $b = eval { APR::Bucket->new($ba, $data, $offset, $len) };
         ok t_cmp($@,
                  qr/the length argument can't be bigger than the total/,
                  'new($data, $offset, $len_too_big)');
@@ -76,10 +80,10 @@
     {
         my $data = "A" x 10;
         my $orig = $data;
-        my $b = APR::Bucket->new($data);
+        my $b = APR::Bucket->new($ba, $data);
         $data =~ s/^..../BBBB/;
         $b->read(my $read);
-        ok !t_cmp($read, $orig,
+        ok t_cmp($read, $data,
                  "data inside the bucket should get affected by " .
                  "the changes to the Perl variable it's created from");
     }
@@ -93,7 +97,7 @@
         my @data      = qw(ABCD EF);
         my @received     = ();
         for my $str (@data) {
-            my $b = func($str);
+            my $b = func($ba, $str);
             push @buckets, $b;
         }
 
@@ -114,15 +118,16 @@
         # buckets point to the same SV, and having the latest bucket's
         # data override the previous one
         sub func {
+            my $ba = shift;
             my $data = shift;
-            return APR::Bucket->new(lc $data);
+            return APR::Bucket->new($ba, lc $data);
         }
 
     }
 
     # remove/destroy
     {
-        my $b = APR::Bucket->new("aaa");
+        my $b = APR::Bucket->new($ba, "aaa");
         # remove $b when it's not attached to anything (not sure if
         # that should be an error)
         $b->remove;
@@ -134,6 +139,26 @@
 
         # real remove from bb is tested in many other filter tests
     }
+
+    # setaside
+    {
+        my $data = "A" x 10;
+        my $orig = $data;
+        my $b = APR::Bucket->new($ba, $data);
+        my $status = $b->setaside($pool);
+        ok t_cmp $status, 0, "setaside status";
+        $data =~ s/^..../BBBB/;
+        $b->read(my $read);
+        ok !t_cmp($read, $data,
+                 "data inside the setaside bucket is uaffected by " .
+                 "changes to the Perl variable it's created from");
+        $b->destroy;
+    }
+
+
+
+    APR::Bucket::alloc_destroy($ba);
+
 }
 
 1;
Index: t/lib/TestAPRlib/pool.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/lib/TestAPRlib/pool.pm,v
retrieving revision 1.3
diff -u -r1.3 pool.pm
--- t/lib/TestAPRlib/pool.pm	16 Jul 2004 20:31:59 -0000	1.3
+++ t/lib/TestAPRlib/pool.pm	29 Sep 2004 15:42:15 -0000
@@ -123,7 +123,6 @@
         $table->clear;
     }
 
-
     # test: destroying a sub-pool before the parent pool and trying to
     # call APR::Pool methods on the a subpool object which points to a
     # destroyed pool
Index: t/protocol/TestProtocol/echo_bbs.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm,v
retrieving revision 1.8
diff -u -r1.8 echo_bbs.pm
--- t/protocol/TestProtocol/echo_bbs.pm	21 Aug 2004 00:27:22 -0000	1.8
+++ t/protocol/TestProtocol/echo_bbs.pm	29 Sep 2004 15:42:15 -0000
@@ -44,7 +44,7 @@
 
             if ($b->read(my $data)) {
                 last if $data =~ /^[\r\n]+$/;
-                my $nb = APR::Bucket->new(uc $data);
+                my $nb = APR::Bucket->new($bb->bucket_alloc, uc $data);
                 # head->...->$nb->$b ->...->tail
                 # XXX: the next 3 lines could be replaced with a
                 # wrapper function $b->replace($nb);
Index: t/protocol/TestProtocol/echo_bbs2.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/protocol/TestProtocol/echo_bbs2.pm,v
retrieving revision 1.6
diff -u -r1.6 echo_bbs2.pm
--- t/protocol/TestProtocol/echo_bbs2.pm	14 Jul 2004 08:42:07 -0000	1.6
+++ t/protocol/TestProtocol/echo_bbs2.pm	29 Sep 2004 15:42:15 -0000
@@ -43,7 +43,7 @@
         last if $data =~ /^[\r\n]+$/;
 
         # transform data here
-        my $bucket = APR::Bucket->new(uc $data);
+        my $bucket = APR::Bucket->new($bb_in->bucket_alloc, uc $data);
         $bb_out->insert_tail($bucket);
 
         $c->output_filters->fflush($bb_out);
Index: t/response/TestAPI/in_out_filters.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPI/in_out_filters.pm,v
retrieving revision 1.3
diff -u -r1.3 in_out_filters.pm
--- t/response/TestAPI/in_out_filters.pm	21 Aug 2004 00:27:22 -0000	1.3
+++ t/response/TestAPI/in_out_filters.pm	29 Sep 2004 15:42:15 -0000
@@ -1,3 +1,4 @@
+
 package TestAPI::in_out_filters;
 
 # testing: $r->input_filters and $r->output_filters
@@ -38,7 +39,7 @@
     my $bb = APR::Brigade->new($r->pool,
                                $r->connection->bucket_alloc);
 
-    my $b = APR::Bucket->new($data);
+    my $b = APR::Bucket->new($r->connection->bucket_alloc, $data);
     $bb->insert_tail($b);
     $r->output_filters->fflush($bb);
     $bb->destroy;
Index: t/response/TestAPR/brigade.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/brigade.pm,v
retrieving revision 1.5
diff -u -r1.5 brigade.pm
--- t/response/TestAPR/brigade.pm	8 Jul 2004 06:06:33 -0000	1.5
+++ t/response/TestAPR/brigade.pm	29 Sep 2004 15:42:15 -0000
@@ -19,12 +19,12 @@
 sub handler {
 
     my $r = shift;
-
+    my $ba = $r->connection->bucket_alloc;
     plan $r, tests => 13;
 
     # basic + pool + destroy
     {
-        my $bb = APR::Brigade->new($r->pool, $r->connection->bucket_alloc);
+        my $bb = APR::Brigade->new($r->pool, $ba);
 
         t_debug('$bb is defined');
         ok defined $bb;
@@ -47,13 +47,13 @@
 
     # concat / split / length / flatten
     {
-        my $bb1 = APR::Brigade->new($r->pool, $r->connection->bucket_alloc);
-        $bb1->insert_head(APR::Bucket->new("11"));
-        $bb1->insert_tail(APR::Bucket->new("12"));
-
-        my $bb2 = APR::Brigade->new($r->pool, $r->connection->bucket_alloc);
-        $bb2->insert_head(APR::Bucket->new("21"));
-        $bb2->insert_tail(APR::Bucket->new("22"));
+        my $bb1 = APR::Brigade->new($r->pool, $ba);
+        $bb1->insert_head(APR::Bucket->new($ba, "11"));
+        $bb1->insert_tail(APR::Bucket->new($ba, "12"));
+
+        my $bb2 = APR::Brigade->new($r->pool, $ba);
+        $bb2->insert_head(APR::Bucket->new($ba, "21"));
+        $bb2->insert_tail(APR::Bucket->new($ba, "22"));
 
         # concat
         $bb1->concat($bb2);
Index: t/response/TestAPR/bucket.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/bucket.pm,v
retrieving revision 1.11
diff -u -r1.11 bucket.pm
--- t/response/TestAPR/bucket.pm	21 Aug 2004 00:41:36 -0000	1.11
+++ t/response/TestAPR/bucket.pm	29 Sep 2004 15:42:16 -0000
@@ -53,8 +53,8 @@
 
     # insert_after / insert_before / is_eos / is_flush
     {
-        my $d1 = APR::Bucket->new("d1");
-        my $d2 = APR::Bucket->new("d2");
+        my $d1 = APR::Bucket->new($ba, "d1");
+        my $d2 = APR::Bucket->new($ba, "d2");
         my $f1 = APR::Bucket::flush_create($ba);
         my $f2 = APR::Bucket::flush_create($ba);
         my $e1 = APR::Bucket::eos_create($ba);
@@ -111,7 +111,7 @@
         ok t_cmp($bb->last,  undef, "no last bucket");
 
         ## now there is first
-        my $b = APR::Bucket->new("bbb");
+        my $b = APR::Bucket->new($ba, "bbb");
         $bb->insert_head($b);
         my $b_first = $bb->first;
         $b->read(my $read);
@@ -127,8 +127,8 @@
     # delete+destroy
     {
         my $bb = APR::Brigade->new($r->pool, $ba);
-        $bb->insert_head(APR::Bucket->new("a"));
-        $bb->insert_head(APR::Bucket->new("b"));
+        $bb->insert_head(APR::Bucket->new($ba, "a"));
+        $bb->insert_head(APR::Bucket->new($ba, "b"));
 
         my $b1 = $bb->first;
         $b1->remove;
Index: t/response/TestAPR/flatten.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPR/flatten.pm,v
retrieving revision 1.6
diff -u -r1.6 flatten.pm
--- t/response/TestAPR/flatten.pm	8 Jul 2004 06:06:33 -0000	1.6
+++ t/response/TestAPR/flatten.pm	29 Sep 2004 15:42:16 -0000
@@ -27,7 +27,7 @@
     # now, let's put several buckets in it
     for (1 .. 10) {
         my $data = 'x' x 20000;
-        my $bucket = APR::Bucket->new($data);
+        my $bucket = APR::Bucket->new($ba, $data);
         $bb->insert_tail($bucket);
     }
 
Index: xs/APR/Bucket/APR__Bucket.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Bucket/APR__Bucket.h,v
retrieving revision 1.13
diff -u -r1.13 APR__Bucket.h
--- xs/APR/Bucket/APR__Bucket.h	20 Aug 2004 21:11:00 -0000	1.13
+++ xs/APR/Bucket/APR__Bucket.h	29 Sep 2004 15:42:16 -0000
@@ -18,11 +18,17 @@
 #define mpxs_APR__Bucket_delete  apr_bucket_delete
 #define mpxs_APR__Bucket_destroy apr_bucket_destroy
 
-static apr_bucket *mpxs_APR__Bucket_new(pTHX_ SV *classname, SV *sv,
-                                        apr_off_t offset, apr_size_t len)
+static apr_bucket *mpxs_APR__Bucket_new(pTHX_  SV *classname, apr_bucket_alloc_t *list,
+                                        SV *sv, apr_off_t offset, apr_size_t len)
 {
 
     apr_size_t full_len;
+
+    if (sv == Nullsv) {
+        sv = newSV(0);
+        SvUPGRADE(sv, SVt_PV);
+    }
+
     (void)SvPV(sv, full_len);
 
     if (len) {
@@ -35,7 +41,7 @@
         len = full_len - offset;
     }
     
-    return modperl_bucket_sv_create(aTHX_ sv, offset, len);
+    return modperl_bucket_sv_create(aTHX_ list, sv, offset, len);
 }
 
 static MP_INLINE
Index: xs/APR/Pool/APR__Pool.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
retrieving revision 1.17
diff -u -r1.17 APR__Pool.h
--- xs/APR/Pool/APR__Pool.h	14 Jul 2004 23:15:01 -0000	1.17
+++ xs/APR/Pool/APR__Pool.h	29 Sep 2004 15:42:17 -0000
@@ -17,6 +17,9 @@
 
 typedef struct {
     SV *sv;
+#ifdef USE_ITHREADS
+    PerlInterpreter *perl;
+#endif
 } mpxs_pool_account_t;
 
 /* XXX: this implementation has a problem with perl ithreads. if a
@@ -50,26 +53,12 @@
 static MP_INLINE apr_status_t
 mpxs_apr_pool_cleanup(void *cleanup_data)
 {
-    mpxs_pool_account_t *data;
-    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW,
-                          (apr_pool_t *)cleanup_data);
-    if (!(data && data->sv)) {
-        /* if there is no data, there is nothing to unset */
-        MP_POOL_TRACE(MP_FUNC, "this pool seems to be destroyed already");
-    }
-    else {
-        MP_POOL_TRACE(MP_FUNC,
-                      "pool 0x%lx contains a valid sv 0x%lx, invalidating it",
-                      (unsigned long)data->sv, (unsigned long)cleanup_data);
-
-        /* invalidate all Perl objects referencing this sv */
-        SvIVX(data->sv) = 0;
-
-        /* invalidate the reference stored in the pool */
-        data->sv = NULL;
-        /* data->sv will go away by itself when all objects will go away */
-    }
-
+    mpxs_pool_account_t *acct = cleanup_data;
+#ifdef USE_ITHREADS
+    dTHXa(acct->perl);
+#endif
+    mg_free(acct->sv);
+    SvIVX(acct->sv) = 0;
     return APR_SUCCESS;
 }
 
@@ -116,9 +105,6 @@
      * mess, trying to destroy an already destroyed pool or even worse
      * a pool allocate in the place of the old one.
      */
-    apr_pool_cleanup_register(child_pool, (void *)child_pool,
-                              mpxs_apr_pool_cleanup,
-                              apr_pool_cleanup_null);
 #if APR_POOL_DEBUG
     /* child <-> parent <-> ... <-> top ancestry traversal */
     {
@@ -139,17 +125,23 @@
 #endif
 
     {
-        mpxs_pool_account_t *data =
-            (mpxs_pool_account_t *)apr_pcalloc(child_pool, sizeof(*data));
-
         SV *rv = sv_setref_pv(NEWSV(0, 0), "APR::Pool", (void*)child_pool);
+        SV *sv = SvRV(rv);
+        mpxs_pool_account_t *acct = apr_palloc(child_pool, sizeof *acct);
 
-        data->sv = SvRV(rv);
+        acct->sv = sv;
+#ifdef USE_ITHREADS
+        acct->perl = aTHX;
+#endif
+        sv_magic(sv, Nullsv, PERL_MAGIC_ext, "APR::Pool", sizeof("APR::Pool"));
 
-        MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
-                      (unsigned long)child_pool, data->sv, rv);
 
-        apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, child_pool);
+        apr_pool_cleanup_register(child_pool, (void *)acct,
+                                  mpxs_apr_pool_cleanup,
+                                  apr_pool_cleanup_null);
+
+        MP_POOL_TRACE(MP_FUNC, "sub-pool p: 0x%lx, sv: 0x%lx, rv: 0x%lx",
+                      (unsigned long)child_pool, sv, rv);
 
         return rv;
     }
@@ -158,10 +150,10 @@
 static MP_INLINE void mpxs_APR__Pool_clear(pTHX_ SV *obj)
 {
     apr_pool_t *p = mp_xs_sv2_APR__Pool(obj);
-    mpxs_pool_account_t *data;
+    SV *sv = SvRV(obj);
+    mpxs_pool_account_t *acct;
 
-    apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
-    if (!(data && data->sv)) {
+    if (mg_find(sv, PERL_MAGIC_ext) == NULL) {
         MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
                       (unsigned long)p);
         apr_pool_clear(p);
@@ -171,20 +163,25 @@
     MP_POOL_TRACE(MP_FUNC,
                   "parent pool (0x%lx) is a custom pool, sv 0x%lx",
                   (unsigned long)p,
-                  (unsigned long)data->sv);
+                  (unsigned long)sv);
 
     apr_pool_clear(p);
 
-    /* apr_pool_clear removes all the user data, so we need to restore
+    /* apr_pool_clear removes all the cleanup, so we need to restore
      * it. Since clear triggers mpxs_apr_pool_cleanup call, our
      * object's guts get nuked too, so we need to restore them too */
 
     /* this is sv_setref_pv, but for an existing object */
-    sv_setiv(newSVrv(obj, "APR::Pool"), PTR2IV((void*)p));
-    data->sv = SvRV(obj);
-
-    /* reinstall the user data */
-    apr_pool_userdata_set(data, MP_APR_POOL_NEW, NULL, p);
+    sv_magic(sv, Nullsv, PERL_MAGIC_ext, "APR::Pool", sizeof("APR::Pool"));
+    SvIVX(sv) = (IV)p;
+    acct = apr_palloc(p, sizeof *acct);
+    acct->sv = sv;
+#ifdef USE_ITHREADS
+    acct->perl = aTHX;
+#endif
+    apr_pool_cleanup_register(p, (void *)acct,
+                              mpxs_apr_pool_cleanup,
+                              apr_pool_cleanup_null);
 }
 
 
@@ -294,30 +291,7 @@
     apr_pool_t *parent_pool = apr_pool_parent_get(child_pool);
 
     if (parent_pool) {
-        /* ideally this should be done by mp_xs_APR__Pool_2obj. Though
-         * since most of the time we don't use custom pools, we don't
-         * want the overhead of reading and writing pool's userdata in
-         * the general case. therefore we do it here and in
-         * mpxs_apr_pool_create. Though if there are any other
-         * functions, that return perl objects whose guts include a
-         * reference to a custom pool, they must do the ref-counting
-         * as well.
-         */
-        mpxs_pool_account_t *data;
-        apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, parent_pool);
-        if (data && data->sv) {
-            MP_POOL_TRACE(MP_FUNC,
-                          "parent pool (0x%lx) is a custom pool, sv 0x%lx",
-                          (unsigned long)parent_pool,
-                          (unsigned long)data->sv);
-
-            return newRV_inc(data->sv);
-        }
-        else {
-            MP_POOL_TRACE(MP_FUNC, "parent pool (0x%lx) is a core pool",
-                          (unsigned long)parent_pool);
-            return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
-        }
+        return SvREFCNT_inc(mp_xs_APR__Pool_2obj(parent_pool));
     }
     else {
         MP_POOL_TRACE(MP_FUNC, "pool (0x%lx) has no parents",
@@ -335,37 +309,9 @@
     apr_pool_t *p;
     SV *sv = SvRV(obj);
 
-    /* MP_POOL_TRACE(MP_FUNC, "DESTROY 0x%lx-0x%lx",       */
-    /*              (unsigned long)obj,(unsigned long)sv); */
-    /* do_sv_dump(0, Perl_debug_log, obj, 0, 4, FALSE, 0); */
-
     p = mpxs_sv_object_deref(obj, apr_pool_t);
-    if (!p) {
-        /* non-custom pool */
-        MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: not a custom pool");
-        return;
-    }
 
-    if (sv && SvOK(sv)) {
-        mpxs_pool_account_t *data;
-
-        apr_pool_userdata_get((void **)&data, MP_APR_POOL_NEW, p);
-        if (!(data && data->sv)) {
-            MP_POOL_TRACE(MP_FUNC, "skip apr_pool_destroy: no sv found");
-            return;
-        }
-
-        if (SvREFCNT(sv) == 1) {
-            MP_POOL_TRACE(MP_FUNC, "call apr_pool_destroy: last reference");
-            apr_pool_destroy(p);
-        }
-        else {
-            /* when the pool object dies, sv's ref count decrements
-             * itself automatically */
-            MP_POOL_TRACE(MP_FUNC,
-                          "skip apr_pool_destroy: refcount > 1 (%d)",
-                          SvREFCNT(sv));
-        }
-    }
+    if (mg_find(sv, PERL_MAGIC_ext))
+        apr_pool_destroy(p);
 }
 
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.87
diff -u -r1.87 apr_functions.map
--- xs/maps/apr_functions.map	22 Sep 2004 23:22:06 -0000	1.87
+++ xs/maps/apr_functions.map	29 Sep 2004 15:42:17 -0000
@@ -119,12 +119,13 @@
  #apr_bucket_read
  mpxs_APR__Bucket_read | | bucket, buffer, block=APR_BLOCK_READ
  #modperl_bucket_sv_create
- mpxs_APR__Bucket_new  | | classname, sv, offset=0, len=0
+ mpxs_APR__Bucket_new  | | classname, list, sv, offset=0, len=0
  void:DEFINE_destroy | | apr_bucket:bucket
  void:DEFINE_delete  | | apr_bucket:bucket
 >apr_bucket_alloc
->apr_bucket_alloc_create
->apr_bucket_alloc_destroy
+ apr_bucket_alloc_create
+ apr_bucket_alloc_destroy
+ apr_bucket_setaside
 >apr_bucket_free
 !apr_bucket_copy_notimpl
 !apr_bucket_shared_copy
Index: xs/maps/apr_structures.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_structures.map,v
retrieving revision 1.17
diff -u -r1.17 apr_structures.map
--- xs/maps/apr_structures.map	21 Sep 2004 03:29:18 -0000	1.17
+++ xs/maps/apr_structures.map	29 Sep 2004 15:42:17 -0000
@@ -34,7 +34,7 @@
 <apr_bucket_brigade>
 ~  pool
 >  list
->  bucket_alloc
+   bucket_alloc
 </apr_bucket_brigade>
 
 <apr_finfo_t>
Index: xs/tables/current/APR/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/APR/FunctionTable.pm,v
retrieving revision 1.1
diff -u -r1.1 FunctionTable.pm
--- xs/tables/current/APR/FunctionTable.pm	23 Jun 2004 03:30:15 -0000	1.1
+++ xs/tables/current/APR/FunctionTable.pm	29 Sep 2004 15:42:18 -0000
@@ -206,6 +206,10 @@
         'name' => 'my_perl'
       },
       {
+        'type' => 'apr_bucket_alloc_t *',
+        'name' => 'list'
+      },
+      {
         'type' => 'SV *',
         'name' => 'sv'
       },
Index: xs/tables/current/Apache/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/FunctionTable.pm,v
retrieving revision 1.59
diff -u -r1.59 FunctionTable.pm
--- xs/tables/current/Apache/FunctionTable.pm	20 Aug 2004 21:00:03 -0000	1.59
+++ xs/tables/current/Apache/FunctionTable.pm	29 Sep 2004 15:42:28 -0000
@@ -7379,6 +7379,20 @@
   },
   {
     'return_type' => 'apr_status_t',
+    'name' => 'apr_bucket_setaside',
+    'args' => [
+      {
+        'type' => 'apr_bucket *',
+        'name' => 'data'
+      },
+      {
+        'type' => 'apr_pool_t *',
+        'name' => 'pool'
+      }
+    ]
+  },
+  {
+    'return_type' => 'apr_status_t',
     'name' => 'apr_bucket_setaside_noop',
     'args' => [
       {
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.185
diff -u -r1.185 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm	22 Sep 2004 23:22:07 -0000	1.185
+++ xs/tables/current/ModPerl/FunctionTable.pm	29 Sep 2004 15:42:33 -0000
@@ -92,6 +92,10 @@
         'name' => 'my_perl'
       },
       {
+        'type' => 'apr_bucket_alloc_t *',
+        'name' => 'list'
+      },
+      {
         'type' => 'SV *',
         'name' => 'sv'
       },
@@ -5425,6 +5429,10 @@
       {
         'type' => 'SV *',
         'name' => 'classname'
+      },
+      {
+        'type' => 'apr_bucket_alloc_t *',
+        'name' => 'list'
       },
       {
         'type' => 'SV *',



-- 
Joe Schaefer

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to