? 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 16:03:20 -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 16:03:21 -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
@@ -546,6 +613,36 @@
+=head2 C<setaside>
+
+Ensure the bucket's data lasts at least as long as the given pool.
+
+
+ my $status = $bucket->setaside($pool);
+
+=over 4
+
+=item obj: C<$bucket>
+( C<L<APR::Bucket object|docs::2.0::api::APR::Bucket>> )
+
+=item arg1: C<$pool>
+( C<L<APR::Pool object|docs::2.0::api::APR::Pool>> )
+
+=item ret: status code- APR_SUCCESS or error condition.
+
+=item since: 1.99_17
+
+=back
+
+When the a modperl bucket is setaside, its data is detached from the
+original perl scalar and copied into a pool bucket. Usually setaside
+is called by certain output filters, in order to buffer socket writes
+of smaller buckets into a single write.
+
+
+
+
+
=head2 C<type>
Get the type of the data in the bucket.
@@ -621,7 +718,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 16:03:22 -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 16:03:26 -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 16:03:27 -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 16:03:27 -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 16:03:27 -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 16:03:28 -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 16:03:28 -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 16:03:28 -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 16:03:28 -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 16:03:28 -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 16:03:28 -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 16:03:28 -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 16:03:29 -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 16:03:29 -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 16:03:29 -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/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 16:03:30 -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 16:03:30 -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 16:03:30 -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 16:03:30 -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 16:03:30 -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 16:03:30 -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 16:03:31 -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/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 16:03:32 -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 16:03:32 -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 16:03:32 -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 16:03:42 -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 16:03:47 -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]
