使用mod-perl 2获取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: $xmlin\n";

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

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

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

(是的，我也尝试过$r->read(...)，但没有用)

Answer 1

我想我对你的代码为什么不能工作有一个很好的想法。

模块Apache2::RequestIO向Apache2::RequestRec添加了新功能。

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

我首先将Apache2::RequestIO::read更改为Apache2::RequestRec::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

当Content-Type为application/json时。所以我用这样的方式来解决这个问题。然后自己解析body：

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;
}