I'm cleaning up my old cvs checkouts so we can nuke the cvs support and not confuse users. I've found this semi-complete $r->content implementation. All it does is slurping the body instead of doing all that in perl (if you aren't using CGI.pm or A::R):

sub read_post {
    my $r = shift;
    my $debug = shift || 0;

    my $bb = APR::Brigade->new($r->pool,
                               $r->connection->bucket_alloc);

    my $data = '';
    my $seen_eos = 0;
    my $count = 0;
    do {
        $r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
                                       APR::BLOCK_READ, IOBUFSIZE);

        $count++;

        warn "read_post: bb $count\n" if $debug;

        while (!$bb->is_empty) {
            my $b = $bb->first;

            if ($b->is_eos) {
                warn "read_post: EOS bucket:\n" if $debug;
                $seen_eos++;
                last;
            }

            if ($b->read(my $buf)) {
                warn "read_post: DATA bucket: [$buf]\n" if $debug;
                $data .= $buf;
            }

            $b->delete;
        }

    } while (!$seen_eos);

    $bb->destroy;

    return $data;
}

1;

So I'm not sure whether we should bother to finish it off or just drop it. There is some problem in the bucket brigades C code, but I didn't have a chance to look at it.

Anyways here is the patch.



Index: xs/maps/modperl_functions.map
===================================================================
--- xs/maps/modperl_functions.map (revision 122604)
+++ xs/maps/modperl_functions.map (working copy)
@@ -56,6 +56,7 @@
SV *:DEFINE_UNTIE | | request_rec *:r, int:refcnt
mpxs_Apache__RequestRec_sendfile | | r, filename=r->filename, offset=0, len=0
mpxs_Apache__RequestRec_read | | r, buffer, len, offset=0
+ mpxs_Apache__RequestRec_content | | r
SV *:DEFINE_READ | | request_rec *:r, SV *:buffer, apr_size_t:len, apr_off_t:offset=0
mpxs_Apache__RequestRec_write | | r, buffer, len=-1, offset=0
mpxs_Apache__RequestRec_print | | ...
Index: xs/Apache/RequestIO/Apache__RequestIO.h
===================================================================
--- xs/Apache/RequestIO/Apache__RequestIO.h (revision 122604)
+++ xs/Apache/RequestIO/Apache__RequestIO.h (working copy)
@@ -264,6 +264,66 @@
return newSViv(total);
}


+/* get the POSTed body as-is */
+static SV *mpxs_Apache__RequestRec_content(pTHX_ request_rec *r)
+{
+    SV *sv = newSVpvn("", 0);
+    int rc;
+    int seen_eos = 0;
+    apr_bucket_brigade *bb = apr_brigade_create(r->pool,
+                                                r->connection->bucket_alloc);
+
+    do {
+        char *buffer;
+        //apr_bucket *b;
+        apr_size_t bufsiz = HUGE_STRING_LEN;
+
+        rc = ap_get_brigade(r->input_filters, bb, AP_MODE_READBYTES,
+                            APR_BLOCK_READ, HUGE_STRING_LEN);
+        if (rc != APR_SUCCESS) {
+            apr_brigade_destroy(bb);
+            Perl_croak(aTHX_ modperl_error_strerror(aTHX_ rc));
+        }
+
+        /* If this fails, it means that a filter is written
+         * incorrectly and that it needs to learn how to properly
+         * handle APR_BLOCK_READ requests by returning data when
+         * requested.
+         */
+        if (APR_BRIGADE_EMPTY(bb)) {
+            apr_brigade_destroy(bb);
+            /* we can't tell which filter is broken, since others may
+             * just pass data through */
+            Perl_croak(aTHX_ "Aborting read from client. "
+                     "One of the input filters is broken. "
+                     "It returned an empty bucket brigade for "
+                     "the APR_BLOCK_READ mode request");
+        }
+
+        /* search for EOS */
+        if (APR_BUCKET_IS_EOS(APR_BRIGADE_LAST(bb))) {
+            seen_eos = 1;
+        }
+
+        rc = apr_brigade_pflatten(bb, &buffer, &bufsiz, r->pool);
+        if (rc != APR_SUCCESS) {
+            apr_brigade_destroy(bb);
+            Perl_croak(aTHX_ modperl_error_strerror(aTHX_ rc));
+        }
+
+        MP_TRACE_o(MP_FUNC, "read %db [%s]", bufsiz, buffer);
+
+        /* XXX: more efficient way? */
+        sv_catpvn(sv, buffer, bufsiz);
+        apr_brigade_cleanup(bb);
+    }
+    while (!seen_eos);
+
+    apr_brigade_destroy(bb);
+
+    return sv;
+}
+
 static MP_INLINE
 SV *mpxs_Apache__RequestRec_GETC(pTHX_ request_rec *r)
 {
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
--- xs/tables/current/ModPerl/FunctionTable.pm  (revision 122604)
+++ xs/tables/current/ModPerl/FunctionTable.pm  (working copy)
@@ -2,7 +2,7 @@

 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 # ! WARNING: generated by ModPerl::ParseSource/0.01
-# !          Fri Dec 10 13:39:28 2004
+# !          Thu Dec 16 19:50:23 2004
 # !          do NOT edit, any changes will be lost !
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@@ -6545,6 +6545,23 @@
   },
   {
     'return_type' => 'SV *',
+    'name' => 'mpxs_Apache__RequestRec_content',
+    'attr' => [
+      'static'
+    ],
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'request_rec *',
+        'name' => 'r'
+      }
+    ]
+  },
+  {
+    'return_type' => 'SV *',
     'name' => 'mpxs_Apache__RequestRec_content_languages',
     'args' => [
       {
Index: t/filter/TestFilter/both_str_req_mix.pm
===================================================================
--- t/filter/TestFilter/both_str_req_mix.pm     (revision 122604)
+++ t/filter/TestFilter/both_str_req_mix.pm     (working copy)
@@ -114,7 +114,10 @@
     $r->content_type('text/plain');

     if ($r->method_number == Apache::M_POST) {
-        $r->print(TestCommon::Utils::read_post($r));
+        #$r->print(TestCommon::Utils::read_post($r));
+        my $content = $r->content;
+        debug "content: $content";
+        $r->print($content);
     }

     return Apache::OK;
Index: t/filter/TestFilter/out_str_req_mix.pm
===================================================================
--- t/filter/TestFilter/out_str_req_mix.pm      (revision 122604)
+++ t/filter/TestFilter/out_str_req_mix.pm      (working copy)
@@ -61,7 +61,9 @@
     $r->content_type('text/plain');

     if ($r->method_number == Apache::M_POST) {
-        $r->print(TestCommon::Utils::read_post($r));
+        #$r->print(TestCommon::Utils::read_post($r));
+        my $content = $r->content;
+        $r->print($content);
     }

     return Apache::OK;
Index: t/response/TestCompat/request_body.pm
===================================================================
--- t/response/TestCompat/request_body.pm       (revision 122604)
+++ t/response/TestCompat/request_body.pm       (working copy)
@@ -25,7 +25,9 @@

     my %data;
     if ($r->method_number == M_POST) {
+        Apache::compat::override_mp2_api('Apache::RequestRec::content');
         %data = $r->content;
+        Apache::compat::restore_mp2_api('Apache::RequestRec::content');
     }
     else {
         %data = $r->Apache::args;
Index: t/lib/TestCommon/Utils.pm
===================================================================
--- t/lib/TestCommon/Utils.pm   (revision 122604)
+++ t/lib/TestCommon/Utils.pm   (working copy)
@@ -6,6 +6,7 @@
 use APR::Brigade ();
 use APR::Bucket ();
 use Apache::Filter ();
+use Apache::RequestIO ();

 use Apache::Const -compile => qw(MODE_READBYTES);
 use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
@@ -26,6 +27,11 @@
 # t/TEST -trace=debug -start
 sub read_post {
     my $r = shift;
+    $r->content;
+}
+
+sub read_post1 {
+    my $r = shift;
     my $debug = shift || 0;

     my $bb = APR::Brigade->new($r->pool,
Index: lib/Apache/compat.pm
===================================================================
--- lib/Apache/compat.pm        (revision 122604)
+++ lib/Apache/compat.pm        (working copy)
@@ -79,6 +79,21 @@
 # the overriding code, needs to "return" the original CODE reference
 # when eval'ed , so that it can be restored later
 my %overridable_mp2_api = (
+   'Apache::RequestRec::content' => <<'EOI',
+{
+    require Apache::RequestRec;
+    my $orig_sub = *Apache::RequestRec::content{CODE};
+    *Apache::RequestRec::content = sub {
+        my $r = shift;
+        my $data = $r->$content_sub;
+        return $data unless wantarray;
+        return $r->parse_args($data);
+    };
+    $orig_sub;
+}
+
+EOI
+
     'Apache::RequestRec::filename' => <<'EOI',
 {
     require Apache::RequestRec;
@@ -555,44 +570,6 @@
     return $r->parse_args($args);
 }

-use Apache::Const -compile => qw(MODE_READBYTES);
-use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
-
-use constant IOBUFSIZE => 8192;
-
-sub content {
-    my $r = shift;
-
-    my $bb = APR::Brigade->new($r->pool,
-                               $r->connection->bucket_alloc);
-
-    my $data = '';
-    my $seen_eos = 0;
-    do {
-        $r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
-                                       APR::BLOCK_READ, IOBUFSIZE);
-        while (!$bb->is_empty) {
-            my $b = $bb->first;
-
-            if ($b->is_eos) {
-                $seen_eos++;
-                last;
-            }
-
-            if ($b->read(my $buf)) {
-                $data .= $buf;
-            }
-
-            $b->delete;
-        }
-    } while (!$seen_eos);
-
-    $bb->destroy;
-
-    return $data unless wantarray;
-    return $r->parse_args($data);
-}
-
 sub server_root_relative {
     my $r = shift;
     File::Spec->catfile(Apache::ServerUtil::server_root, @_);
@@ -644,7 +621,7 @@
 #XXX: howto convert PerlIO to apr_file_t
 #so we can use the real ap_send_fd function
 #2.0 ap_send_fd() also has an additional offset parameter
-
+use constant IOBUFSIZE => 8192;
 sub send_fd_length {
     my($r, $fh, $length) = @_;


-- __________________________________________________________________ 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]



Reply via email to