perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject Re: [mp2] one more pass on mp2/apr read() functions
Date Tue, 08 Jun 2004 16:07:05 GMT
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


Mime
View raw message