使用modperl2获取http POST请求的主体

Question

我正在编写一个快速脚本来处理提交的文件，并将内容返回给用户。

我的测试代码如下：

#!/path/to/bin/perl
use strict;
use warnings;
use utf8;
use Apache2::RequestRec;
use Apache2::RequestIO; 
my ( $xmlin, $accepts ) = (q{}, q{});
my $format = 'json';
# read the posted content
while (
    Apache2::RequestIO::read($xmlin, 1024)
      ) {};
{
  no warnings;
  $accepts = $Apache2::RequestRec::headers_in{'Accepts'};
}
if ($accepts) {
  for ($accepts) {
    /application/xml/i && do {
      $format = 'xml';
      last;
    };
    /text/plain/i && do {
      $format = 'text';
      last;
    };
  } ## end for ($accepts)
} ## end if ($accepts)
print "format: $format; xml: $xmlinn";

此代码无法使用Undefined subroutine &Apache2::RequestIO::read 进行编译

如果我注释掉while循环，代码运行良好。

不幸的是，Apache2::RequestIO代码是通过Apache2::XSLoader::load __PACKAGE__;引入的，所以我无法检查实际代码。。。。但我不明白为什么不起作用

（是的，我也尝试过$r->read(...)，但没有成功）

Answer 1

我想我已经很清楚为什么您的代码不起作用了。

模块Apache2:：RequestIO为Apache2:：Request Rec添加了新功能。

换句话说，向Apache2:：RequestRec命名空间添加新的方法/函数。

我会首先将Apache2:：RequestIO:：read更改为Apache2:：Request Rec:：read。

如果不起作用，请使用处理程序移动。

我有一个代码可以做类似的事情

在httpd.conf 中

PerlSwitches -I/path/to/module_dir
PerlLoadModule ModuleName
PerlResponseHandler ModuleName

ModuleName.pm

package ModuleName;
use strict;
use warnings;
use Apache2::RequestIO();
use Apache2::RequestRec();
use Apache2::Const -compile => qw(OK);
sub handler {
    my ($r) = @_;
    {
        use bytes;
        my $content = '';
        my $offset = 0;
        my $cnt = 0;
        do {
            $cnt = $r->read($content,8192,$offset);
            $offset += $cnt;
        } while($cnt == 8192);
    }
   return Apache2::Const::HTTP_OK;
}

Answer 2

我还使用Apache2::RequestIO读取正文：

sub body {
    my $self =  shift;
    return $self->{ body }   if defined $self->{ body };
    $self->apr->read( $self->{ body }, $self->headers_in->get( 'Content-Length' ) );
    $self->{ body };
}

在这种情况下，您应该将原始Apache2::Request作为子类。特别要注意our @ISA = qw(Apache2::Request);

我不知道为什么，但标准的body方法返回给我：

$self->body        # {}
$self->body_status # Missing parser

当CCD_ 9是CCD_。所以我以这种方式来解决这个问题。然后自己解析正文：

sub content {
    my $self =  shift;
    return   $self->{ content }   if defined $self->{ content };
    my $content_type =  $self->headers_in->get('Content-Type');
    $content_type =~ s/^(.*?);.*$/$1/;
    return   unless exists $self->{ $content_type };
    return $self->{ content } =  $self->{ $content_type }( $self->body, $self );
}

其中：

use JSON;
sub new {
    my ($proto, $r) = @_;
    my $self = $proto->SUPER::new($r);
    $self->{ 'application/json' } =  sub {
        decode_json shift;
    };
    return $self;
}