It makes the socket read/write loops similar to filter ones:
while ($socket->recv(my $buff, BUFF_LEN)) {
$socket->send($buff);
}
Here is the whole patch:
Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.107
diff -u -r1.107 compat.pm
--- lib/Apache/compat.pm 4 Jun 2004 09:34:46 -0000 1.107
+++ lib/Apache/compat.pm 8 Jun 2004 15:59:21 -0000
@@ -501,8 +501,8 @@
last;
}
- my $buf = $b->read;
- $data .= $buf if length $buf;
+ $b->read(my $buf);
+ $data .= $buf;
}
} while (!$seen_eos);
Index: t/conf/modperl_extra.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
retrieving revision 1.51
diff -u -r1.51 modperl_extra.pl
--- t/conf/modperl_extra.pl 4 Jun 2004 09:35:37 -0000 1.51
+++ t/conf/modperl_extra.pl 8 Jun 2004 15:59:21 -0000
@@ -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
Index: t/filter/TestFilter/in_bbs_body.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_body.pm,v
retrieving revision 1.5
diff -u -r1.5 in_bbs_body.pm
--- t/filter/TestFilter/in_bbs_body.pm 1 Jun 2004 23:36:16 -0000 1.5
+++ t/filter/TestFilter/in_bbs_body.pm 8 Jun 2004 15:59:21 -0000
@@ -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);
}
Index: t/filter/TestFilter/in_bbs_consume.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_consume.pm,v
retrieving revision 1.4
diff -u -r1.4 in_bbs_consume.pm
--- t/filter/TestFilter/in_bbs_consume.pm 1 Jun 2004 23:36:16 -0000 1.4
+++ t/filter/TestFilter/in_bbs_consume.pm 8 Jun 2004 15:59:21 -0000
@@ -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);
Index: t/filter/TestFilter/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
diff -u -r1.8 in_bbs_inject_header.pm
--- t/filter/TestFilter/in_bbs_inject_header.pm 21 May 2004 22:01:16 -0000 1.8
+++ t/filter/TestFilter/in_bbs_inject_header.pm 8 Jun 2004 15:59:21 -0000
@@ -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
Index: t/filter/TestFilter/in_bbs_msg.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm,v
retrieving revision 1.9
diff -u -r1.9 in_bbs_msg.pm
--- t/filter/TestFilter/in_bbs_msg.pm 1 Jun 2004 23:36:16 -0000 1.9
+++ t/filter/TestFilter/in_bbs_msg.pm 8 Jun 2004 15:59:21 -0000
@@ -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,) {
Index: t/filter/TestFilter/in_bbs_underrun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_underrun.pm,v
retrieving revision 1.7
diff -u -r1.7 in_bbs_underrun.pm
--- t/filter/TestFilter/in_bbs_underrun.pm 1 Jun 2004 23:36:16 -0000 1.7
+++ t/filter/TestFilter/in_bbs_underrun.pm 8 Jun 2004 15:59:21 -0000
@@ -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);
Index: t/filter/TestFilter/out_bbs_basic.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_basic.pm,v
retrieving revision 1.4
diff -u -r1.4 out_bbs_basic.pm
--- t/filter/TestFilter/out_bbs_basic.pm 21 May 2004 18:40:50 -0000 1.4
+++ t/filter/TestFilter/out_bbs_basic.pm 8 Jun 2004 15:59:21 -0000
@@ -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');
}
Index: t/filter/TestFilter/out_bbs_ctx.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm,v
retrieving revision 1.5
diff -u -r1.5 out_bbs_ctx.pm
--- t/filter/TestFilter/out_bbs_ctx.pm 21 May 2004 18:40:50 -0000 1.5
+++ t/filter/TestFilter/out_bbs_ctx.pm 8 Jun 2004 15:59:22 -0000
@@ -43,8 +43,7 @@
last;
}
- my $bdata = $bucket->read;
- if (defined $bdata) {
+ if ($bucket->read(my $bdata)) {
$data .= $bdata;
my $len = length $data;
Index: t/protocol/TestProtocol/echo_bbs.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm,v
retrieving revision 1.1
diff -u -r1.1 echo_bbs.pm
--- t/protocol/TestProtocol/echo_bbs.pm 3 Jun 2004 08:20:50 -0000 1.1
+++ t/protocol/TestProtocol/echo_bbs.pm 8 Jun 2004 15:59:22 -0000
@@ -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);
}
Index: t/protocol/TestProtocol/echo_block.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_block.pm,v
retrieving revision 1.5
diff -u -r1.5 echo_block.pm
--- t/protocol/TestProtocol/echo_block.pm 3 Jun 2004 08:22:21 -0000 1.5
+++ t/protocol/TestProtocol/echo_block.pm 8 Jun 2004 15:59:22 -0000
@@ -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;
Index: t/protocol/TestProtocol/echo_timeout.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm,v
retrieving revision 1.4
diff -u -r1.4 echo_timeout.pm
--- t/protocol/TestProtocol/echo_timeout.pm 3 Jun 2004 08:22:21 -0000 1.4
+++ t/protocol/TestProtocol/echo_timeout.pm 8 Jun 2004 15:59:22 -0000
@@ -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;
Index: t/protocol/TestProtocol/eliza.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/eliza.pm,v
retrieving revision 1.6
diff -u -r1.6 eliza.pm
--- t/protocol/TestProtocol/eliza.pm 4 May 2004 06:14:44 -0000 1.6
+++ t/protocol/TestProtocol/eliza.pm 8 Jun 2004 15:59:22 -0000
@@ -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";
Index: t/response/TestAPR/bucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/bucket.pm,v
retrieving revision 1.3
diff -u -r1.3 bucket.pm
--- t/response/TestAPR/bucket.pm 4 Jun 2004 23:57:32 -0000 1.3
+++ t/response/TestAPR/bucket.pm 8 Jun 2004 15:59:22 -0000
@@ -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");
Index: t/response/TestError/runtime.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestError/runtime.pm,v
retrieving revision 1.4
diff -u -r1.4 runtime.pm
--- t/response/TestError/runtime.pm 30 May 2004 18:51:30 -0000 1.4
+++ t/response/TestError/runtime.pm 8 Jun 2004 15:59:22 -0000
@@ -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;
Index: xs/APR/Bucket/APR__Bucket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Bucket/APR__Bucket.h,v
retrieving revision 1.9
diff -u -r1.9 APR__Bucket.h
--- xs/APR/Bucket/APR__Bucket.h 4 Jun 2004 09:38:06 -0000 1.9
+++ xs/APR/Bucket/APR__Bucket.h 8 Jun 2004 15:59:22 -0000
@@ -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)
Index: xs/APR/Socket/APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.10
diff -u -r1.10 APR__Socket.h
--- xs/APR/Socket/APR__Socket.h 2 Jun 2004 03:34:32 -0000 1.10
+++ xs/APR/Socket/APR__Socket.h 8 Jun 2004 15:59:22 -0000
@@ -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
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.81
diff -u -r1.81 apr_functions.map
--- xs/maps/apr_functions.map 4 Jun 2004 04:12:54 -0000 1.81
+++ xs/maps/apr_functions.map 8 Jun 2004 15:59:22 -0000
@@ -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
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.162
diff -u -r1.162 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 2 Jun 2004 18:31:33 -0000 1.162
+++ xs/tables/current/ModPerl/FunctionTable.pm 8 Jun 2004 15:59:22 -0000
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Wed Jun 2 11:27:15 2004
+# ! Tue Jun 8 07:27:14 2004
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5408,12 +5408,8 @@
]
},
{
- 'return_type' => 'SV *',
+ 'return_type' => 'apr_size_t',
'name' => 'mpxs_APR__Bucket_read',
- 'attr' => [
- 'static',Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.107
diff -u -r1.107 compat.pm
--- lib/Apache/compat.pm 4 Jun 2004 09:34:46 -0000 1.107
+++ lib/Apache/compat.pm 8 Jun 2004 15:59:21 -0000
@@ -501,8 +501,8 @@
last;
}
- my $buf = $b->read;
- $data .= $buf if length $buf;
+ $b->read(my $buf);
+ $data .= $buf;
}
} while (!$seen_eos);
Index: t/conf/modperl_extra.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
retrieving revision 1.51
diff -u -r1.51 modperl_extra.pl
--- t/conf/modperl_extra.pl 4 Jun 2004 09:35:37 -0000 1.51
+++ t/conf/modperl_extra.pl 8 Jun 2004 15:59:21 -0000
@@ -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
Index: t/filter/TestFilter/in_bbs_body.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_body.pm,v
retrieving revision 1.5
diff -u -r1.5 in_bbs_body.pm
--- t/filter/TestFilter/in_bbs_body.pm 1 Jun 2004 23:36:16 -0000 1.5
+++ t/filter/TestFilter/in_bbs_body.pm 8 Jun 2004 15:59:21 -0000
@@ -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);
}
Index: t/filter/TestFilter/in_bbs_consume.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_consume.pm,v
retrieving revision 1.4
diff -u -r1.4 in_bbs_consume.pm
--- t/filter/TestFilter/in_bbs_consume.pm 1 Jun 2004 23:36:16 -0000 1.4
+++ t/filter/TestFilter/in_bbs_consume.pm 8 Jun 2004 15:59:21 -0000
@@ -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);
Index: t/filter/TestFilter/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
diff -u -r1.8 in_bbs_inject_header.pm
--- t/filter/TestFilter/in_bbs_inject_header.pm 21 May 2004 22:01:16 -0000 1.8
+++ t/filter/TestFilter/in_bbs_inject_header.pm 8 Jun 2004 15:59:21 -0000
@@ -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
Index: t/filter/TestFilter/in_bbs_msg.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm,v
retrieving revision 1.9
diff -u -r1.9 in_bbs_msg.pm
--- t/filter/TestFilter/in_bbs_msg.pm 1 Jun 2004 23:36:16 -0000 1.9
+++ t/filter/TestFilter/in_bbs_msg.pm 8 Jun 2004 15:59:21 -0000
@@ -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,) {
Index: t/filter/TestFilter/in_bbs_underrun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_underrun.pm,v
retrieving revision 1.7
diff -u -r1.7 in_bbs_underrun.pm
--- t/filter/TestFilter/in_bbs_underrun.pm 1 Jun 2004 23:36:16 -0000 1.7
+++ t/filter/TestFilter/in_bbs_underrun.pm 8 Jun 2004 15:59:21 -0000
@@ -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);
Index: t/filter/TestFilter/out_bbs_basic.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_basic.pm,v
retrieving revision 1.4
diff -u -r1.4 out_bbs_basic.pm
--- t/filter/TestFilter/out_bbs_basic.pm 21 May 2004 18:40:50 -0000 1.4
+++ t/filter/TestFilter/out_bbs_basic.pm 8 Jun 2004 15:59:21 -0000
@@ -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');
}
Index: t/filter/TestFilter/out_bbs_ctx.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm,v
retrieving revision 1.5
diff -u -r1.5 out_bbs_ctx.pm
--- t/filter/TestFilter/out_bbs_ctx.pm 21 May 2004 18:40:50 -0000 1.5
+++ t/filter/TestFilter/out_bbs_ctx.pm 8 Jun 2004 15:59:22 -0000
@@ -43,8 +43,7 @@
last;
}
- my $bdata = $bucket->read;
- if (defined $bdata) {
+ if ($bucket->read(my $bdata)) {
$data .= $bdata;
my $len = length $data;
Index: t/protocol/TestProtocol/echo_bbs.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm,v
retrieving revision 1.1
diff -u -r1.1 echo_bbs.pm
--- t/protocol/TestProtocol/echo_bbs.pm 3 Jun 2004 08:20:50 -0000 1.1
+++ t/protocol/TestProtocol/echo_bbs.pm 8 Jun 2004 15:59:22 -0000
@@ -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);
}
Index: t/protocol/TestProtocol/echo_block.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_block.pm,v
retrieving revision 1.5
diff -u -r1.5 echo_block.pm
--- t/protocol/TestProtocol/echo_block.pm 3 Jun 2004 08:22:21 -0000 1.5
+++ t/protocol/TestProtocol/echo_block.pm 8 Jun 2004 15:59:22 -0000
@@ -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;
Index: t/protocol/TestProtocol/echo_timeout.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm,v
retrieving revision 1.4
diff -u -r1.4 echo_timeout.pm
--- t/protocol/TestProtocol/echo_timeout.pm 3 Jun 2004 08:22:21 -0000 1.4
+++ t/protocol/TestProtocol/echo_timeout.pm 8 Jun 2004 15:59:22 -0000
@@ -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;
Index: t/protocol/TestProtocol/eliza.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/eliza.pm,v
retrieving revision 1.6
diff -u -r1.6 eliza.pm
--- t/protocol/TestProtocol/eliza.pm 4 May 2004 06:14:44 -0000 1.6
+++ t/protocol/TestProtocol/eliza.pm 8 Jun 2004 15:59:22 -0000
@@ -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";
Index: t/response/TestAPR/bucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/bucket.pm,v
retrieving revision 1.3
diff -u -r1.3 bucket.pm
--- t/response/TestAPR/bucket.pm 4 Jun 2004 23:57:32 -0000 1.3
+++ t/response/TestAPR/bucket.pm 8 Jun 2004 15:59:22 -0000
@@ -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");
Index: t/response/TestError/runtime.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestError/runtime.pm,v
retrieving revision 1.4
diff -u -r1.4 runtime.pm
--- t/response/TestError/runtime.pm 30 May 2004 18:51:30 -0000 1.4
+++ t/response/TestError/runtime.pm 8 Jun 2004 15:59:22 -0000
@@ -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;
Index: xs/APR/Bucket/APR__Bucket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Bucket/APR__Bucket.h,v
retrieving revision 1.9
diff -u -r1.9 APR__Bucket.h
--- xs/APR/Bucket/APR__Bucket.h 4 Jun 2004 09:38:06 -0000 1.9
+++ xs/APR/Bucket/APR__Bucket.h 8 Jun 2004 15:59:22 -0000
@@ -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)
Index: xs/APR/Socket/APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.10
diff -u -r1.10 APR__Socket.h
--- xs/APR/Socket/APR__Socket.h 2 Jun 2004 03:34:32 -0000 1.10
+++ xs/APR/Socket/APR__Socket.h 8 Jun 2004 15:59:22 -0000
@@ -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
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.81
diff -u -r1.81 apr_functions.map
--- xs/maps/apr_functions.map 4 Jun 2004 04:12:54 -0000 1.81
+++ xs/maps/apr_functions.map 8 Jun 2004 15:59:22 -0000
@@ -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
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.162
diff -u -r1.162 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 2 Jun 2004 18:31:33 -0000 1.162
+++ xs/tables/current/ModPerl/FunctionTable.pm 8 Jun 2004 15:59:22 -0000
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Wed Jun 2 11:27:15 2004
+# ! Tue Jun 8 07:27:14 2004
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -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',
- '__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',
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
