joes 2004/10/03 19:16:43
Modified: src/modules/perl modperl_bucket.c modperl_bucket.h
t/api in_out_filters.t
t/filter/TestFilter in_bbs_body.pm in_bbs_consume.pm
in_bbs_inject_header.pm in_bbs_msg.pm
in_bbs_underrun.pm out_bbs_basic.pm out_bbs_ctx.pm
out_bbs_filebucket.pm
t/lib/TestAPRlib bucket.pm
t/protocol/TestProtocol echo_bbs.pm echo_bbs2.pm
t/response/TestAPI in_out_filters.pm
t/response/TestAPR brigade.pm bucket.pm flatten.pm
todo release
xs/APR/Bucket APR__Bucket.h
xs/maps apr_functions.map apr_structures.map
xs/tables/current/APR FunctionTable.pm
xs/tables/current/Apache FunctionTable.pm
xs/tables/current/ModPerl FunctionTable.pm
Log:
Reimplement APR::Bucket using apr_bucket_alloc_t -
* $bucket_alloc argument added to APR::Bucket::new
* new subs:
APR::Bucket::setaside
APR::Bucket::alloc_create
APR::Bucket::alloc_destroy
APR::Brigade::bucket_alloc
* new setaside implementation, using pool buckets
instead of heap buckets for better performance
and leak safety.
Reviewed by: stas
Revision Changes Path
1.13 +45 -16 modperl-2.0/src/modules/perl/modperl_bucket.c
Index: modperl_bucket.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_bucket.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- modperl_bucket.c 13 Aug 2004 01:41:35 -0000 1.12
+++ modperl_bucket.c 4 Oct 2004 02:16:42 -0000 1.13
@@ -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);
}
1.4 +2 -2 modperl-2.0/src/modules/perl/modperl_bucket.h
Index: modperl_bucket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_bucket.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_bucket.h 13 Jun 2004 05:39:09 -0000 1.3
+++ modperl_bucket.h 4 Oct 2004 02:16:42 -0000 1.4
@@ -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 */
1.2 +1 -1 modperl-2.0/t/api/in_out_filters.t
Index: in_out_filters.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/api/in_out_filters.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- in_out_filters.t 24 Jul 2004 06:54:25 -0000 1.1
+++ in_out_filters.t 4 Oct 2004 02:16:42 -0000 1.2
@@ -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';
1.11 +1 -1 modperl-2.0/t/filter/TestFilter/in_bbs_body.pm
Index: in_bbs_body.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_body.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- in_bbs_body.pm 21 Aug 2004 00:27:22 -0000 1.10
+++ in_bbs_body.pm 4 Oct 2004 02:16:42 -0000 1.11
@@ -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;
1.6 +1 -1 modperl-2.0/t/filter/TestFilter/in_bbs_consume.pm
Index: in_bbs_consume.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_consume.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- in_bbs_consume.pm 9 Jun 2004 14:46:21 -0000 1.5
+++ in_bbs_consume.pm 4 Oct 2004 02:16:42 -0000 1.6
@@ -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";
}
1.12 +2 -2 modperl-2.0/t/filter/TestFilter/in_bbs_inject_header.pm
Index: in_bbs_inject_header.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_inject_header.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- in_bbs_inject_header.pm 21 Aug 2004 00:42:00 -0000 1.11
+++ in_bbs_inject_header.pm 4 Oct 2004 02:16:42 -0000 1.12
@@ -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]";
}
1.15 +1 -1 modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm
Index: in_bbs_msg.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- in_bbs_msg.pm 21 Aug 2004 00:27:22 -0000 1.14
+++ in_bbs_msg.pm 4 Oct 2004 02:16:42 -0000 1.15
@@ -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;
1.9 +2 -2 modperl-2.0/t/filter/TestFilter/in_bbs_underrun.pm
Index: in_bbs_underrun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_underrun.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- in_bbs_underrun.pm 9 Jun 2004 14:46:21 -0000 1.8
+++ in_bbs_underrun.pm 4 Oct 2004 02:16:42 -0000 1.9
@@ -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";
}
1.7 +2 -2 modperl-2.0/t/filter/TestFilter/out_bbs_basic.pm
Index: out_bbs_basic.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_basic.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- out_bbs_basic.pm 15 Aug 2004 06:30:50 -0000 1.6
+++ out_bbs_basic.pm 4 Oct 2004 02:16:42 -0000 1.7
@@ -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));
1.11 +5 -4 modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm
Index: out_bbs_ctx.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- out_bbs_ctx.pm 21 Aug 2004 00:27:22 -0000 1.10
+++ out_bbs_ctx.pm 4 Oct 2004 02:16:42 -0000 1.11
@@ -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);
}
}
1.6 +1 -1 modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm
Index: out_bbs_filebucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- out_bbs_filebucket.pm 21 Aug 2004 00:27:22 -0000 1.5
+++ out_bbs_filebucket.pm 4 Oct 2004 02:16:42 -0000 1.6
@@ -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;
1.6 +35 -11 modperl-2.0/t/lib/TestAPRlib/bucket.pm
Index: bucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/lib/TestAPRlib/bucket.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- bucket.pm 1 Oct 2004 03:30:11 -0000 1.5
+++ bucket.pm 4 Oct 2004 02:16:42 -0000 1.6
@@ -9,19 +9,23 @@
use Apache::TestUtil;
use TestCommon::Utils;
+use APR::Pool ();
use APR::Bucket ();
use APR::BucketType ();
sub num_of_tests {
- return 16;
+ return 18;
}
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;
@@ -40,7 +44,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');
@@ -54,7 +58,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');
@@ -66,7 +70,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)');
@@ -77,10 +81,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");
}
@@ -94,7 +98,7 @@
my @data = qw(ABCD EF);
my @received = ();
for my $str (@data) {
- my $b = func($str);
+ my $b = func($ba, $str);
push @buckets, $b;
}
@@ -115,8 +119,9 @@
# 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);
}
}
@@ -124,7 +129,7 @@
# read data is tainted
{
my $data = "xxx";
- my $b = APR::Bucket->new($data);
+ my $b = APR::Bucket->new($ba, $data);
$b->read(my $read);
ok t_cmp($read, $data, 'new($data)');
ok TestCommon::Utils::is_tainted($read);
@@ -132,7 +137,7 @@
# 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;
@@ -144,6 +149,25 @@
# 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;
1.9 +1 -1 modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm
Index: echo_bbs.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- echo_bbs.pm 21 Aug 2004 00:27:22 -0000 1.8
+++ echo_bbs.pm 4 Oct 2004 02:16:42 -0000 1.9
@@ -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);
1.7 +1 -1 modperl-2.0/t/protocol/TestProtocol/echo_bbs2.pm
Index: echo_bbs2.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_bbs2.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- echo_bbs2.pm 14 Jul 2004 08:42:07 -0000 1.6
+++ echo_bbs2.pm 4 Oct 2004 02:16:42 -0000 1.7
@@ -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);
1.4 +2 -1 modperl-2.0/t/response/TestAPI/in_out_filters.pm
Index: in_out_filters.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/in_out_filters.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- in_out_filters.pm 21 Aug 2004 00:27:22 -0000 1.3
+++ in_out_filters.pm 4 Oct 2004 02:16:42 -0000 1.4
@@ -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;
1.6 +9 -9 modperl-2.0/t/response/TestAPR/brigade.pm
Index: brigade.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/brigade.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- brigade.pm 8 Jul 2004 06:06:33 -0000 1.5
+++ brigade.pm 4 Oct 2004 02:16:42 -0000 1.6
@@ -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);
1.12 +5 -5 modperl-2.0/t/response/TestAPR/bucket.pm
Index: bucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/bucket.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- bucket.pm 21 Aug 2004 00:41:36 -0000 1.11
+++ bucket.pm 4 Oct 2004 02:16:42 -0000 1.12
@@ -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;
1.8 +1 -1 modperl-2.0/t/response/TestAPR/flatten.pm
Index: flatten.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/flatten.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- flatten.pm 1 Oct 2004 03:30:12 -0000 1.7
+++ flatten.pm 4 Oct 2004 02:16:42 -0000 1.8
@@ -28,7 +28,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);
}
1.65 +0 -3 modperl-2.0/todo/release
Index: release
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/release,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- release 24 Sep 2004 19:55:35 -0000 1.64
+++ release 4 Oct 2004 02:16:42 -0000 1.65
@@ -53,9 +53,6 @@
See test TestAPR::pool
http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=108547894817083&w=2
-* consider changing the allocation method in APR::Bucket::new from
- malloc/free to bucket_alloc, like all other buckets do
-
* revamp directive handlers, expose modperl_module_add, fix
PerlLoadModule, etc.
http://marc.theaimsgroup.com/?t=108309295200003
1.15 +9 -3 modperl-2.0/xs/APR/Bucket/APR__Bucket.h
Index: APR__Bucket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Bucket/APR__Bucket.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- APR__Bucket.h 1 Oct 2004 03:30:12 -0000 1.14
+++ APR__Bucket.h 4 Oct 2004 02:16:42 -0000 1.15
@@ -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
1.88 +4 -3 modperl-2.0/xs/maps/apr_functions.map
Index: apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -r1.87 -r1.88
--- apr_functions.map 22 Sep 2004 23:22:06 -0000 1.87
+++ apr_functions.map 4 Oct 2004 02:16:42 -0000 1.88
@@ -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
1.18 +1 -1 modperl-2.0/xs/maps/apr_structures.map
Index: apr_structures.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_structures.map,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- apr_structures.map 21 Sep 2004 03:29:18 -0000 1.17
+++ apr_structures.map 4 Oct 2004 02:16:42 -0000 1.18
@@ -34,7 +34,7 @@
<apr_bucket_brigade>
~ pool
> list
-> bucket_alloc
+ bucket_alloc
</apr_bucket_brigade>
<apr_finfo_t>
1.2 +4 -0 modperl-2.0/xs/tables/current/APR/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/APR/FunctionTable.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- FunctionTable.pm 23 Jun 2004 03:30:15 -0000 1.1
+++ FunctionTable.pm 4 Oct 2004 02:16:42 -0000 1.2
@@ -206,6 +206,10 @@
'name' => 'my_perl'
},
{
+ 'type' => 'apr_bucket_alloc_t *',
+ 'name' => 'list'
+ },
+ {
'type' => 'SV *',
'name' => 'sv'
},
1.60 +14 -0 modperl-2.0/xs/tables/current/Apache/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/Apache/FunctionTable.pm,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- FunctionTable.pm 20 Aug 2004 21:00:03 -0000 1.59
+++ FunctionTable.pm 4 Oct 2004 02:16:43 -0000 1.60
@@ -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' => [
{
1.186 +8 -0 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.185
retrieving revision 1.186
diff -u -r1.185 -r1.186
--- FunctionTable.pm 22 Sep 2004 23:22:07 -0000 1.185
+++ FunctionTable.pm 4 Oct 2004 02:16:43 -0000 1.186
@@ -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 *',
