stas 2004/06/09 07:46:22
Modified: . Changes
lib/Apache compat.pm
t/conf modperl_extra.pl
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
t/protocol/TestProtocol echo_bbs.pm echo_bbs2.pm
echo_block.pm echo_timeout.pm eliza.pm
t/response/TestAPR brigade.pm bucket.pm flatten.pm
t/response/TestError runtime.pm
todo release
xs/APR/Brigade APR__Brigade.h
xs/APR/Bucket APR__Bucket.h
xs/APR/Socket APR__Socket.h
xs/maps apr_functions.map
xs/tables/current/ModPerl FunctionTable.pm
Log:
- $socket->recv(), $bucket->read() and $bucket->flatten are now all return
the number of bytes read and fill the buffer passed as an argument with
the read data
- flatten() throws APR::Error exceptions
Revision Changes Path
1.389 +7 -3 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.388
retrieving revision 1.389
diff -u -u -r1.388 -r1.389
--- Changes 4 Jun 2004 09:38:07 -0000 1.388
+++ Changes 9 Jun 2004 14:46:21 -0000 1.389
@@ -12,7 +12,8 @@
=item 1.99_15-dev
-provide a workaround for a bug in perl's newSVpvn, so that now
+APR::Socket::recv() now returns the length of the read data [Stas]
+
APR::Bucket's read() returns "" instead of undef when there is no data
to read. [Stas]
@@ -74,10 +75,13 @@
- destroy() now throws APR::Error exception (not returning rc)
- rename empty => is_empty
- added the method cleanup()
+ - flatten() now returns the number of bytes read (and passed the
+ buffer by the argument) and throws APR::Error exception
APR::Bucket: [Stas]
- - read() now returns read data and throws APR::Error exception (not
- returning rc). The returned scalar is now TAINTED.
+ - read() now returns the length of the read data and throws
+ APR::Error exception (not returning rc). The returned scalar is
+ now TAINTED.
- type->name now has a module APR::BucketType
- type(), length(), start(), data() are now all readonly
- new() fix a bug in offset handling
1.108 +2 -2 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -u -r1.107 -r1.108
--- compat.pm 4 Jun 2004 09:34:46 -0000 1.107
+++ compat.pm 9 Jun 2004 14:46:21 -0000 1.108
@@ -501,8 +501,8 @@
last;
}
- my $buf = $b->read;
- $data .= $buf if length $buf;
+ $b->read(my $buf);
+ $data .= $buf;
}
} while (!$seen_eos);
1.52 +4 -3 modperl-2.0/t/conf/modperl_extra.pl
Index: modperl_extra.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -u -r1.51 -r1.52
--- modperl_extra.pl 4 Jun 2004 09:35:37 -0000 1.51
+++ modperl_extra.pl 9 Jun 2004 14:46:21 -0000 1.52
@@ -164,9 +164,9 @@
last;
}
- my $buf = $b->read;
+ $b->read(my $buf);
warn "read_post: DATA bucket: [$buf]\n" if $debug;
- $data .= $buf if length $buf;
+ $data .= $buf;
}
} while (!$seen_eos);
@@ -273,7 +273,8 @@
my @data;
for (my $b = $bb->first; $b; $b = $bb->next($b)) {
- push @data, $b->type->name, $b->read;
+ $b->read(my $bdata);
+ push @data, $b->type->name, $bdata;
}
# send the sniffed info to STDERR so not to interfere with normal
1.6 +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.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- in_bbs_body.pm 1 Jun 2004 23:36:16 -0000 1.5
+++ in_bbs_body.pm 9 Jun 2004 14:46:21 -0000 1.6
@@ -34,7 +34,7 @@
last;
}
- if (my $data = $bucket->read) {
+ if ($bucket->read(my $data)) {
#warn"[$data]\n";
$bucket = APR::Bucket->new(scalar reverse $data);
}
1.5 +1 -2 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.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- in_bbs_consume.pm 1 Jun 2004 23:36:16 -0000 1.4
+++ in_bbs_consume.pm 9 Jun 2004 14:46:21 -0000 1.5
@@ -75,8 +75,7 @@
my @data;
for (my $b = $bb->first; $b; $b = $bb->next($b)) {
$seen_eos++, last if $b->is_eos;
- my $bdata = $b->read;
- $bdata = '' unless defined $bdata;
+ $b->read(my $bdata);
push @data, $bdata;
}
return (join('', @data), $seen_eos);
1.9 +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.8
retrieving revision 1.9
diff -u -u -r1.8 -r1.9
--- in_bbs_inject_header.pm 21 May 2004 22:01:16 -0000 1.8
+++ in_bbs_inject_header.pm 9 Jun 2004 14:46:21 -0000 1.9
@@ -63,7 +63,7 @@
if (1) {
# extra debug, wasting cycles
- my $data = $bucket->read;
+ $bucket->read(my $data);
debug "injected header: [$data]";
}
else {
@@ -166,7 +166,7 @@
last;
}
- my $data = $bucket->read;
+ $bucket->read(my $data);
debug "filter read:\n[$data]";
# check that we really work only on the headers
1.10 +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.9
retrieving revision 1.10
diff -u -u -r1.9 -r1.10
--- in_bbs_msg.pm 1 Jun 2004 23:36:16 -0000 1.9
+++ in_bbs_msg.pm 9 Jun 2004 14:46:21 -0000 1.10
@@ -38,7 +38,7 @@
last;
}
- my $data = $bucket->read;
+ $bucket->read(my $data);
debug "FILTER READ:\n$data";
if ($data and $data =~ s,GET $from_url,GET $to_url,) {
1.8 +1 -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.7
retrieving revision 1.8
diff -u -u -r1.7 -r1.8
--- in_bbs_underrun.pm 1 Jun 2004 23:36:16 -0000 1.7
+++ in_bbs_underrun.pm 9 Jun 2004 14:46:21 -0000 1.8
@@ -121,8 +121,7 @@
my @data;
for (my $b = $bb->first; $b; $b = $bb->next($b)) {
$seen_eos++, last if $b->is_eos;
- my $bdata = $b->read;
- $bdata = '' unless defined $bdata;
+ $b->read(my $bdata);
push @data, $bdata;
}
return (join('', @data), $seen_eos);
1.5 +1 -1 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.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- out_bbs_basic.pm 21 May 2004 18:40:50 -0000 1.4
+++ out_bbs_basic.pm 9 Jun 2004 14:46:21 -0000 1.5
@@ -32,7 +32,7 @@
for (my $bucket = $bb->first; $bucket; $bucket = $bb->next($bucket)) {
ok $bucket->type->name;
ok $bucket->length == 2;
- my $data = $bucket->read;
+ $bucket->read(my $data);
ok (defined $data and $data eq 'ok');
}
1.6 +1 -2 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.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- out_bbs_ctx.pm 21 May 2004 18:40:50 -0000 1.5
+++ out_bbs_ctx.pm 9 Jun 2004 14:46:21 -0000 1.6
@@ -43,8 +43,7 @@
last;
}
- my $bdata = $bucket->read;
- if (defined $bdata) {
+ if ($bucket->read(my $bdata)) {
$data .= $bdata;
my $len = length $data;
1.2 +1 -2 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.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- echo_bbs.pm 3 Jun 2004 08:20:50 -0000 1.1
+++ echo_bbs.pm 9 Jun 2004 14:46:22 -0000 1.2
@@ -47,8 +47,7 @@
last;
}
- my $data = $bucket->read;
- if (length $data) {
+ if ($bucket->read(my $data)) {
last if $data =~ /^[\r\n]+$/;
$bucket = APR::Bucket->new(uc $data);
}
1.2 +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.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- echo_bbs2.pm 4 Jun 2004 04:12:53 -0000 1.1
+++ echo_bbs2.pm 9 Jun 2004 14:46:22 -0000 1.2
@@ -36,7 +36,7 @@
last;
}
- my $data = $bb_in->flatten;
+ next unless $bb_in->flatten(my $data);
$bb->cleanup;
#warn "read: [$data]\n";
last if $data =~ /^[\r\n]+$/;
1.6 +2 -6 modperl-2.0/t/protocol/TestProtocol/echo_block.pm
Index: echo_block.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_block.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- echo_block.pm 3 Jun 2004 08:22:21 -0000 1.5
+++ echo_block.pm 9 Jun 2004 14:46:22 -0000 1.6
@@ -31,12 +31,8 @@
or die "failed to set blocking mode";
}
- while (1) {
- my $buff = $socket->recv(BUFF_LEN);
- last unless length $buff; # EOF
-
- my $wlen = $socket->send($buff);
- last if $wlen != length $buff; # write failure?
+ while ($socket->recv(my $buff, BUFF_LEN)) {
+ $socket->send($buff);
}
Apache::OK;
1.5 +3 -3 modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm
Index: echo_timeout.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- echo_timeout.pm 3 Jun 2004 08:22:21 -0000 1.4
+++ echo_timeout.pm 9 Jun 2004 14:46:22 -0000 1.5
@@ -29,20 +29,20 @@
$socket->timeout_set(20_000_000);
while (1) {
- my $buff = eval { $socket->recv(BUFF_LEN) };
+ my $buff;
+ my $rlen = eval { $socket->recv($buff, BUFF_LEN) };
if ($@) {
die "timed out, giving up: $@" if $@ == APR::TIMEUP;
die $@;
}
- last unless length $buff; # EOF
+ last unless $rlen; # EOF
my $wlen = eval { $socket->send($buff) };
if ($@) {
die "timed out, giving up: $@" if $@ == APR::TIMEUP;
die $@;
}
- last if $wlen != length $buff; # write failure?
}
Apache::OK;
1.7 +1 -4 modperl-2.0/t/protocol/TestProtocol/eliza.pm
Index: eliza.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/eliza.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -u -r1.6 -r1.7
--- eliza.pm 4 May 2004 06:14:44 -0000 1.6
+++ eliza.pm 9 Jun 2004 14:46:22 -0000 1.7
@@ -19,10 +19,7 @@
my APR::Socket $socket = $c->client_socket;
my $last = 0;
- while (1) {
- my $buff = $socket->recv(BUFF_LEN);
- last unless length $buff; # EOF
-
+ while ($socket->recv(my $buff, BUFF_LEN)) {
# \r is sent instead of \n if the client is talking over telnet
$buff =~ s/[\r\n]*$//;
$last++ if $buff eq "Good bye, Eliza";
1.4 +11 -4 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.3
retrieving revision 1.4
diff -u -u -r1.3 -r1.4
--- brigade.pm 21 May 2004 22:01:56 -0000 1.3
+++ brigade.pm 9 Jun 2004 14:46:22 -0000 1.4
@@ -20,7 +20,7 @@
my $r = shift;
- plan $r, tests => 10;
+ plan $r, tests => 13;
# basic + pool + destroy
{
@@ -59,7 +59,9 @@
$bb1->concat($bb2);
# bb1: 11, 12, 21, 22
ok t_cmp(8, $bb1->length, "total data length in bb");
- ok t_cmp("11122122", $bb1->flatten, "bb flatten");
+ my $len = $bb1->flatten(my $data);
+ ok t_cmp(8, $len, "bb flatten/len");
+ ok t_cmp("11122122", $data, "bb flatten/data");
t_debug('$bb2 is empty');
ok $bb2->is_empty;
@@ -67,9 +69,14 @@
my $b = $bb1->first; # 11
$b = $bb1->next($b); # 12
my $bb3 = $bb1->split($b);
+
# bb1: 11, bb3: 12, 21, 22
- ok t_cmp("11", $bb1->flatten, "bb flatten");
- ok t_cmp("122122", $bb3->flatten, "bb flatten");
+ $len = $bb1->flatten($data);
+ ok t_cmp(2, $len, "bb1 flatten/len");
+ ok t_cmp("11", $data, "bb1 flatten/data");
+ $len = $bb3->flatten($data);
+ ok t_cmp(6, $len, "bb3 flatten/len");
+ ok t_cmp("122122", $data, "bb3 flatten/data");
}
Apache::OK;
1.4 +16 -9 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.3
retrieving revision 1.4
diff -u -u -r1.3 -r1.4
--- bucket.pm 4 Jun 2004 23:57:32 -0000 1.3
+++ bucket.pm 9 Jun 2004 14:46:22 -0000 1.4
@@ -20,7 +20,7 @@
my $r = shift;
- plan $r, tests => 26;
+ plan $r, tests => 29;
my $ba = $r->connection->bucket_alloc;
@@ -47,8 +47,9 @@
my $offset = 3;
my $real = substr $data, $offset;
my $b = APR::Bucket->new($data, $offset);
- my $read = $b->read;
- ok t_cmp($real, $read, 'new($data, $offset)');
+ my $rlen = $b->read(my $read);
+ ok t_cmp($real, $read, 'new($data, $offset)/buffer');
+ ok t_cmp(length($read), $rlen, 'new($data, $offset)/len');
ok t_cmp($offset, $b->start, 'offset');
}
@@ -60,8 +61,9 @@
my $len = 3;
my $real = substr $data, $offset, $len;
my $b = APR::Bucket->new($data, $offset, $len);
- my $read = $b->read;
- ok t_cmp($real, $read, 'new($data, $offset, $len)');
+ my $rlen = $b->read(my $read);
+ ok t_cmp($real, $read, 'new($data, $offset, $len)/buffer');
+ ok t_cmp(length($read), $rlen, 'new($data, $offse, $lent)/len');
}
# new: offset+ too big len
@@ -97,7 +99,9 @@
ok t_cmp(0, $b->length, "eos b->length");
# buckets with no data to read should return an empty string
- ok t_cmp("", $b->read, "eos b->read");
+ my $rlen = $b->read(my $read);
+ ok t_cmp("", $read, 'eos b->read/buffer');
+ ok t_cmp(0, $rlen, 'eos b->read/len');
}
# flush_create
@@ -137,14 +141,16 @@
### now test
my $b = $bb->first;
- ok t_cmp("d1", $b->read, "d1 bucket");
+ $b->read(my $read);
+ ok t_cmp("d1", $read, "d1 bucket");
$b = $bb->next($b);
t_debug("is_flush");
ok $b->is_flush;
$b = $bb->next($b);
- ok t_cmp("d2", $b->read, "d2 bucket");
+ $b->read($read);
+ ok t_cmp("d2", $read, "d2 bucket");
$b = $bb->last();
t_debug("is_eos");
@@ -176,7 +182,8 @@
my $b = APR::Bucket->new("bbb");
$bb->insert_head($b);
my $b_first = $bb->first;
- ok t_cmp("bbb", $b->read, "first bucket");
+ $b->read(my $read);
+ ok t_cmp("bbb", $read, "first bucket");
# but there is no prev
ok t_cmp(undef, $bb->prev($b_first), "no prev bucket");
1.4 +37 -46 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.3
retrieving revision 1.4
diff -u -u -r1.3 -r1.4
--- flatten.pm 29 Jan 2004 01:26:49 -0000 1.3
+++ flatten.pm 9 Jun 2004 14:46:22 -0000 1.4
@@ -16,7 +16,7 @@
my $r = shift;
- plan $r, tests => 14;
+ plan $r, tests => 20;
# first, create a brigade
my $pool = $r->pool;
@@ -39,35 +39,26 @@
# syntax: require a $bb
eval { APR::Brigade::flatten("") };
- ok t_cmp(qr!expecting an APR::Brigade derived object!,
+ ok t_cmp(qr!usage: \$bb->flatten\(\$buf, \[\$wanted\]\)!,
$@,
'APR::Brigade::flatten() requires a brigade');
# flatten() will slurp up the entire brigade
# equivalent to calling apr_brigade_pflatten
{
- my $data = $bb->flatten();
+ my $len = $bb->flatten(my $data);
- ok t_cmp(200000,
- length($data),
- '$bb->flatten() returned all the data');
-
- # don't use t_cmp() here, else we get 200,000 characters
- # to look at in verbose mode
- t_debug("data all 'x' characters");
- ok ($data !~ m/[^x]/);
+ verify(200000, $len, $data, 1);
}
# flatten(0) returns 0 bytes
{
- my $data = $bb->flatten(0);
+ my $len = $bb->flatten(my $data, 0);
t_debug('$bb->flatten(0) returns a defined value');
ok (defined $data);
-
- ok t_cmp(0,
- length($data),
- '$bb->flatten(0) returned no data');
+
+ verify(0, $len, $data, 0);
}
@@ -75,53 +66,53 @@
# equivalent to calling apr_brigade_flatten
{
# small
- my $data = $bb->flatten(30);
-
- ok t_cmp(30,
- length($data),
- '$bb->flatten(30) returned 30 characters');
-
- t_debug("APR::Brigade::flatten() data all 'x' characters");
- ok ($data !~ m/[^x]/);
+ my $len = $bb->flatten(my $data, 30);
+ verify(30, $len, $data, 1);
}
{
- # large
- my $data = $bb->flatten(190000);
-
- ok t_cmp(190000,
- length($data),
- '$bb->flatten(190000) returned 19000 characters');
-
- t_debug("data all 'x' characters");
- ok ($data !~ m/[^x]/);
+ # large
+ my $len = $bb->flatten(my $data, 190000);
+ verify(190000, $len, $data, 1);
}
{
# more than enough
- my $data = $bb->flatten(300000);
-
- ok t_cmp(200000,
- length($data),
- '$bb->flatten(300000) returned all 200000 characters');
-
- t_debug("data all 'x' characters");
- ok ($data !~ m/[^x]/);
+ my $len = $bb->flatten(my $data, 300000);
+ verify(200000, $len, $data, 1);
}
# fetch from a brigade with no data in it
{
- my $data = APR::Brigade->new($pool, $ba)->flatten();
+ my $len = APR::Brigade->new($pool, $ba)->flatten(my $data);
t_debug('empty brigade returns a defined value');
ok (defined $data);
-
- ok t_cmp(0,
- length($data),
- 'empty brigade returns data of 0 length');
+
+ verify(0, $len, $data, 0);
}
Apache::OK;
}
+
+sub verify {
+ my($expected_len, $len, $data, $check_content) = @_;
+
+ ok t_cmp($expected_len,
+ $len,
+ "\$bb->flatten(\$data, $len) returned $len bytes");
+ ok t_cmp($len,
+ length($data),
+ "\$bb->flatten(\$data, $len) returned all expected data");
+
+ if ($check_content) {
+ # don't use t_cmp() here, else we get 200,000 characters
+ # to look at in verbose mode
+ t_debug("data all 'x' characters");
+ ok ($data !~ m/[^x]/);
+ }
+
+}
+
1;
1.5 +2 -2 modperl-2.0/t/response/TestError/runtime.pm
Index: runtime.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestError/runtime.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- runtime.pm 30 May 2004 18:51:30 -0000 1.4
+++ runtime.pm 9 Jun 2004 14:46:22 -0000 1.5
@@ -85,7 +85,7 @@
sub eval_string_mp_error {
my($r, $socket) = @_;
- eval "\$socket->recv(SIZE)";
+ eval '$socket->recv(my $buffer, SIZE)';
if ($@ && ref($@) && $@ == APR::TIMEUP) {
$r->print("ok eval_string_mp_error");
}
@@ -121,7 +121,7 @@
# fails because of the timeout set earlier in the handler
sub mp_error {
my $socket = shift;
- $socket->recv(SIZE);
+ $socket->recv(my $buffer, SIZE);
}
1;
1.29 +4 -0 modperl-2.0/todo/release
Index: release
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/release,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -u -r1.28 -r1.29
--- release 5 Jun 2004 05:05:21 -0000 1.28
+++ release 9 Jun 2004 14:46:22 -0000 1.29
@@ -4,6 +4,10 @@
-- see also todo/api_status
+* the following methods/functions are using compat implementations in
+ tests and should use the real 2.0 API: method_register,
+ server_root_relative
+
* filters reset $@ generated by eval, see if we can fix that. The TODO
test: TestFilter::out_str_eval presents the case
The description is here:
1.13 +20 -24 modperl-2.0/xs/APR/Brigade/APR__Brigade.h
Index: APR__Brigade.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Brigade/APR__Brigade.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -u -r1.12 -r1.13
--- APR__Brigade.h 21 May 2004 22:01:16 -0000 1.12
+++ APR__Brigade.h 9 Jun 2004 14:46:22 -0000 1.13
@@ -114,20 +114,20 @@
#define mp_xs_sv2_bb mp_xs_sv2_APR__Brigade
static MP_INLINE
-SV *mpxs_APR__Brigade_flatten(pTHX_ I32 items,
- SV **MARK, SV **SP)
+apr_size_t mpxs_APR__Brigade_flatten(pTHX_ I32 items,
+ SV **MARK, SV **SP)
{
apr_bucket_brigade *bb;
- apr_size_t length;
- apr_status_t status;
- SV *data;
-
- mpxs_usage_va_1(bb, "$bb->flatten([$length])");
-
- if (items > 1) {
- /* APR::Brigade->flatten($length); */
- length = SvIV(*MARK);
+ apr_size_t wanted;
+ apr_status_t rc;
+ SV *buffer;
+
+ mpxs_usage_va_2(bb, buffer, "$bb->flatten($buf, [$wanted])");
+
+ if (items > 2) {
+ /* APR::Brigade->flatten($wanted); */
+ wanted = SvIV(*MARK);
}
else {
/* APR::Brigade->flatten(); */
@@ -137,25 +137,21 @@
*/
apr_off_t actual;
apr_brigade_length(bb, 1, &actual);
- length = (apr_size_t)actual;
+ wanted = (apr_size_t)actual;
}
- data = newSV(0);
- mpxs_sv_grow(data, length);
+ (void)SvUPGRADE(buffer, SVt_PV);
+ mpxs_sv_grow(buffer, wanted);
- status = apr_brigade_flatten(bb, SvPVX(data), &length);
- if (status != APR_SUCCESS) {
- /* XXX croak?
- * note that reading from an empty brigade will return
- * an empty string, not undef, so there is a difference
- */
- return &PL_sv_undef;
+ rc = apr_brigade_flatten(bb, SvPVX(buffer), &wanted);
+ if (!(rc == APR_SUCCESS || rc == APR_EOF)) {
+ modperl_croak(aTHX_ rc, "APR::Brigade::flatten");
}
- mpxs_sv_cur_set(data, length);
- SvTAINTED_on(data);
+ mpxs_sv_cur_set(buffer, wanted);
+ SvTAINTED_on(buffer);
- return data;
+ return wanted;
}
static MP_INLINE
1.10 +9 -21 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.9
retrieving revision 1.10
diff -u -u -r1.9 -r1.10
--- APR__Bucket.h 4 Jun 2004 09:38:06 -0000 1.9
+++ APR__Bucket.h 9 Jun 2004 14:46:22 -0000 1.10
@@ -35,34 +35,22 @@
return modperl_bucket_sv_create(aTHX_ sv, offset, len);
}
-static MP_INLINE SV *mpxs_APR__Bucket_read(pTHX_
- apr_bucket *bucket,
- apr_read_type_e block)
+static MP_INLINE
+apr_size_t mpxs_APR__Bucket_read(pTHX_
+ apr_bucket *bucket,
+ SV *buffer,
+ apr_read_type_e block)
{
- SV *buf;
apr_size_t len;
const char *str;
apr_status_t rc = apr_bucket_read(bucket, &str, &len, block);
-
- if (rc == APR_EOF) {
- return newSVpvn("", 0);
- }
- if (rc != APR_SUCCESS) {
- modperl_croak(aTHX_ rc, "APR::Bucket::read");
+ if (!(rc == APR_SUCCESS || rc == APR_EOF)) {
+ modperl_croak(aTHX_ rc, "APR::Bucket::read");
}
- /* XXX: bug in perl, newSVpvn(NULL, 0) doesn't produce "" sv */
- if (len) {
- buf = newSVpvn(str, len);
- }
- else {
- buf = newSVpvn("", 0);
- }
-
- SvTAINTED_on(buf);
-
- return buf;
+ sv_setpvn(buffer, (len ? str : ""), len);
+ return len;
}
static MP_INLINE int mpxs_APR__Bucket_is_eos(apr_bucket *bucket)
1.11 +12 -14 modperl-2.0/xs/APR/Socket/APR__Socket.h
Index: APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -u -r1.10 -r1.11
--- APR__Socket.h 2 Jun 2004 03:34:32 -0000 1.10
+++ APR__Socket.h 9 Jun 2004 14:46:22 -0000 1.11
@@ -14,24 +14,22 @@
*/
static MP_INLINE
-SV *mpxs_APR__Socket_recv(pTHX_ apr_socket_t *socket, apr_size_t len)
+apr_size_t mpxs_APR__Socket_recv(pTHX_ apr_socket_t *socket,
+ SV *buffer,
+ apr_size_t len)
{
- SV *buf = NEWSV(0, len);
- apr_status_t rc = apr_socket_recv(socket, SvPVX(buf), &len);
+ apr_status_t rc;
- if (len > 0) {
- mpxs_sv_cur_set(buf, len);
- SvTAINTED_on(buf);
- }
- else if (rc == APR_EOF) {
- sv_setpvn(buf, "", 0);
- }
- else if (rc != APR_SUCCESS) {
- SvREFCNT_dec(buf);
- modperl_croak(aTHX_ rc, "APR::Socket::recv");
+ mpxs_sv_grow(buffer, len);
+ rc = apr_socket_recv(socket, SvPVX(buffer), &len);
+
+ if (!(rc == APR_SUCCESS || rc == APR_EOF)) {
+ modperl_croak(aTHX_ rc, "APR::Socket::recv");
}
- return buf;
+ mpxs_sv_cur_set(buffer, len);
+ SvTAINTED_on(buffer);
+ return len;
}
static MP_INLINE
1.82 +1 -1 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.81
retrieving revision 1.82
diff -u -u -r1.81 -r1.82
--- apr_functions.map 4 Jun 2004 04:12:54 -0000 1.81
+++ apr_functions.map 9 Jun 2004 14:46:22 -0000 1.82
@@ -116,7 +116,7 @@
mpxs_APR__Bucket_insert_before #APR_BUCKET_INSERT_AFTER
mpxs_APR__Bucket_remove #APR_BUCKET_REMOVE
#apr_bucket_read
- mpxs_APR__Bucket_read | | bucket, block=APR_BLOCK_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
>apr_bucket_alloc
1.163 +12 -8 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.162
retrieving revision 1.163
diff -u -u -r1.162 -r1.163
--- FunctionTable.pm 2 Jun 2004 18:31:33 -0000 1.162
+++ FunctionTable.pm 9 Jun 2004 14:46:22 -0000 1.163
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Wed Jun 2 11:27:15 2004
+# ! Wed Jun 9 06:41:48 2004
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5189,7 +5189,7 @@
]
},
{
- 'return_type' => 'SV *',
+ 'return_type' => 'apr_size_t',
'name' => 'mpxs_APR__Brigade_flatten',
'args' => [
{
@@ -5408,12 +5408,8 @@
]
},
{
- 'return_type' => 'SV *',
+ 'return_type' => 'apr_size_t',
'name' => 'mpxs_APR__Bucket_read',
- 'attr' => [
- 'static',
- '__inline__'
- ],
'args' => [
{
'type' => 'PerlInterpreter *',
@@ -5424,6 +5420,10 @@
'name' => 'bucket'
},
{
+ 'type' => 'SV *',
+ 'name' => 'buffer'
+ },
+ {
'type' => 'apr_read_type_e',
'name' => 'block'
}
@@ -5524,7 +5524,7 @@
]
},
{
- 'return_type' => 'SV *',
+ 'return_type' => 'apr_size_t',
'name' => 'mpxs_APR__Socket_recv',
'args' => [
{
@@ -5534,6 +5534,10 @@
{
'type' => 'apr_socket_t *',
'name' => 'socket'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'buffer'
},
{
'type' => 'apr_size_t',
