You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Stas Bekman <st...@stason.org> on 2004/06/08 16:37:52 UTC
[mp2] one more pass on mp2/apr read() functions
I'm doing yet another tweak on the read() API to make things really consistent:
So now we (will) have the following read functions:
- APR::Socket:
$len = $socket->read(my $buffer);
- APR::Bucket:
$len = $bucket->read(my $buffer);
- APR::Filter:
$len = $filter->read(my $buffer);
(plus all the optional arguments as before)
as you can see they now all function indentically and they are much easier to
use, even though you pass $buffer by reference.
The last change required you to write this kind of code (not very suitable for
conditionals)
my $buffer = $x->read();
if (length $buffer) {
...
}
sure you could do
if (length(my $buffer = $x->read()) {
...
}
but the problem is that most people will forget the length() part, since most
of the time it'll work without it. But once you get "0" returned that will
suddently fail.
So using the new API, you just write:
if ($x->read(my $buffer)) { ... }
or:
while($x->read(my $buffer)) { ... }
similar to how streaming filter idiom works:
while ($filter->read(my $buffer)) { $filter->print(lc $buffer) }
I think one more function that needs to be changed is APR::Brigade::flatten,
since it's really a read() function. So I propose:
$len = $bb->flatten(my $buffer, ...);
What do you think?
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: APR::Error constant matching
Posted by Stas Bekman <st...@stason.org>.
[adjusting the subject]
Joe Schaefer wrote:
> Stas Bekman <st...@stason.org> writes:
>
> [...]
>
>
>>>>I'm also going to add a wrapper to replace the crafty
>>>>
>>>> if (ref $@ eq 'Apache::Error' && $@ == APR::TIMEUP) { ... }
>>>>
>>>>with:
>>>>
>>>> if (APR::Error::foo($@, APR::TIMEUP)) { ... }
>
>
> OTOH, why not just write
>
> if ($@ == APR::TIMEUP) { ... }
>
> ? If you're worried about numerification warnings
> (assuming $@ isn't a number or an APR::Error object),
> making APR::TIMEUP an APR::Error object would cause
> perl to call the overloaded "==".
That's an idea I haven't thought of. Though it's going to be hard to figure
out which APR::Const and Apache::Const are to be made APR::Error objects,
since on the C level in apr/apache there is no distinction between these
groups. Moreover even we do find a way to create a subset of those, currently
it'll be really hard to tell whether a certain constant is an APR::Error
object and which a real numerical constant. I suppose we will need to
introduce a whole new concept and separate error constants (like APR::TIMEUP)
from other constants (like APR::SO_NONBLOCK). May be those error constants
then should move into a different class? That's a pretty big change.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Joe Schaefer <jo...@sunstarsys.com>.
Stas Bekman <st...@stason.org> writes:
[...]
> >>I'm also going to add a wrapper to replace the crafty
> >>
> >> if (ref $@ eq 'Apache::Error' && $@ == APR::TIMEUP) { ... }
> >>
> >>with:
> >>
> >> if (APR::Error::foo($@, APR::TIMEUP)) { ... }
OTOH, why not just write
if ($@ == APR::TIMEUP) { ... }
? If you're worried about numerification warnings
(assuming $@ isn't a number or an APR::Error object),
making APR::TIMEUP an APR::Error object would cause
perl to call the overloaded "==".
--
Joe Schaefer
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
Joe Schaefer wrote:
> Stas Bekman <st...@stason.org> writes:
>
>
>>Joe Schaefer wrote:
>
>
> [...]
>
>
>>>perl's eval {} is very slow, and doesn't easily
>>
>>How slow? All mod_perl handlers run as eval {}
>
>
> I retract that, sorry. eval BLOCK isn't bad,
> it's eval STRING that I was thinking of.
Ah :) You scared me for a moment :)
All eval BLOCK does is setting some flags which affect die() logic.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Joe Schaefer <jo...@sunstarsys.com>.
Stas Bekman <st...@stason.org> writes:
> Joe Schaefer wrote:
[...]
> > perl's eval {} is very slow, and doesn't easily
>
> How slow? All mod_perl handlers run as eval {}
I retract that, sorry. eval BLOCK isn't bad,
it's eval STRING that I was thinking of.
--
Joe Schaefer
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
Joe Schaefer wrote:
> Stas Bekman <st...@stason.org> writes:
>
> [...]
>
>
>>>but somehow I'd rather be attaching handlers to exception classes
>>>(like Java & C# do), not dispatching
>>>on the value of $@ directly.
>>
>>Example?
>
>
> perl's eval {} is very slow, and doesn't easily
How slow? All mod_perl handlers run as eval {}
> map to Java's try/catch(ExceptionClass err). It's
> not something modperl can emulate (Perl6 will
> have it IIRC), though.
There are a few Perl modules that do try/catch thingy, but they usually suffer
from the closure effect.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Joe Schaefer <jo...@sunstarsys.com>.
Stas Bekman <st...@stason.org> writes:
[...]
> > but somehow I'd rather be attaching handlers to exception classes
> > (like Java & C# do), not dispatching
> > on the value of $@ directly.
>
> Example?
perl's eval {} is very slow, and doesn't easily
map to Java's try/catch(ExceptionClass err). It's
not something modperl can emulate (Perl6 will
have it IIRC), though.
--
Joe Schaefer
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
Joe Schaefer wrote:
> Stas Bekman <st...@stason.org> writes:
>
>
>>Joe Schaefer wrote:
>>
>>>Stas Bekman <st...@stason.org> writes:
>>>
>>>
>>>>Stas Bekman wrote:
>>>>
>>>>
>>>>>It makes the socket read/write loops similar to filter ones:
>>>>> while ($socket->recv(my $buff, BUFF_LEN)) {
>>>>> $socket->send($buff);
>>>>> }
>>>>
>>>>Sounds like a great idea, Stas!
>>>
>>>+1. It'd be cool if Apache::(Request|Cookie) also took advantage of
>>>APR::Error.
>>
>>It should be trivial to do. just replace Perl_croak calls with
>>modperl_croak(aTHX_ rc, "function name"); and require mod_perl 1.99_14 as a
>>minimal version. that's ofcourse for those places where you have an rc
>>(which must be apr_status_t).
>
>
> No good- modperl_croak() is part of modperl.so. apreq-dev can either
>
> 1) reimplement it in apreq_xs_postperl.h (maintenance?),
> 2) call Apache::Error::new() from XS (slow when compared to modperl_croak()),
> 3) get mp2 to export that function (eg. in a static library) along with
> the other APR:: stubs currently provided by modperl.so.
It will be a part of APR as soon as Randy gets things working on win32. The
patch that I've posted some time ago (and which works fine on unix) has
perl_croak decoupled from mod_perl.so. So I guess you just need to wait till
that happens.
>>I'm also going to add a wrapper to replace the crafty
>>
>> if (ref $@ eq 'Apache::Error' && $@ == APR::TIMEUP) { ... }
>>
>>with:
>>
>> if (APR::Error::foo($@, APR::TIMEUP)) { ... }
>>
>>Not sure how to call that wrapper, APR::Error::check()?
>
>
> Off the top of my head I'd s/foo/isa/ and use something
> like
>
> package APR::Error;
> sub isa {
> my ($obj, $error_type) = @_;
> return unless UNIVERSAL::isa($obj, __PACKAGE__);
> return $obj == $error_type;
> }
I thought to call it isa(), but I thought it'll be confusing with UNIVERSAL::usa.
> but somehow I'd rather be attaching handlers to
> exception classes (like Java & C# do), not dispatching
> on the value of $@ directly.
Example?
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
Joe Schaefer wrote:
> Stas Bekman <st...@stason.org> writes:
>
>
>>Stas Bekman wrote:
>>
>>>It makes the socket read/write loops similar to filter ones:
>>> while ($socket->recv(my $buff, BUFF_LEN)) {
>>> $socket->send($buff);
>>> }
>>
>>Sounds like a great idea, Stas!
>
>
> +1. It'd be cool if Apache::(Request|Cookie) also
> took advantage of APR::Error.
It should be trivial to do. just replace Perl_croak calls with
modperl_croak(aTHX_ rc, "function name"); and require mod_perl 1.99_14 as a
minimal version. that's ofcourse for those places where you have an rc (which
must be apr_status_t).
I'm also going to add a wrapper to replace the crafty
if (ref $@ eq 'Apache::Error' && $@ == APR::TIMEUP) { ... }
with:
if (APR::Error::foo($@, APR::TIMEUP)) { ... }
Not sure how to call that wrapper, APR::Error::check()?
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Joe Schaefer <jo...@sunstarsys.com>.
Stas Bekman <st...@stason.org> writes:
> Stas Bekman wrote:
> > It makes the socket read/write loops similar to filter ones:
> > while ($socket->recv(my $buff, BUFF_LEN)) {
> > $socket->send($buff);
> > }
>
> Sounds like a great idea, Stas!
+1. It'd be cool if Apache::(Request|Cookie) also
took advantage of APR::Error.
--
Joe Schaefer
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
Stas Bekman wrote:
> It makes the socket read/write loops similar to filter ones:
>
> while ($socket->recv(my $buff, BUFF_LEN)) {
> $socket->send($buff);
> }
Sounds like a great idea, Stas!
Now committed.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
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:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2] one more pass on mp2/apr read() functions
Posted by Stas Bekman <st...@stason.org>.
Stas Bekman wrote:
> I'm doing yet another tweak on the read() API to make things really
> consistent:
>
> So now we (will) have the following read functions:
>
> - APR::Socket:
>
> $len = $socket->read(my $buffer);
>
> - APR::Bucket:
>
> $len = $bucket->read(my $buffer);
>
> - APR::Filter:
>
> $len = $filter->read(my $buffer);
plus Apache::RequestRec:
my $len = $r->read(my $buffer);
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org