libapreq2でやれんのか?

で、これまでは、普通にCGIモジュールを使って、POSTメソッドでのファイルのアップロードを処理していました。

use CGI::Fast qw(:standard :no_xhtml);

my $buf;
my $post = new CGI::Fast;
my $postfile =$post->param('editfile');
my $tempfile = "temp.dat";
open(TEMP,">", "./save/$tempfile") or die("Can't open $tempfile.\n");
binmode TEMP;
while (read($postfile, $buf, 1024)) {
  print TEMP $buf;
}
close(TEMP);
print $post->header(-charset=>'Shift_JIS');
・・・・・

 が、mod_Perlを使うと、次のように書けって、mod_perlのサイトに書いてある。

use APR::Brigade ();
use APR::Bucket ();
use Apache2::Filter ();

use Apache2::Const -compile => qw(MODE_READBYTES);
use APR::Const    -compile => qw(SUCCESS BLOCK_READ);

use constant IOBUFSIZE => 8192;

sub read_post {
    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, Apache2::Const::MODE_READBYTES,
                                          APR::Const::BLOCK_READ, IOBUFSIZE);
          for (my $b = $bb->first; $b; $b = $bb->next($b)) {
            if ($b->is_eos) {
                $seen_eos++;
                last;
            }
            if ($b->read(my $buf)) {
                $data .= $buf;
            }
            $b->remove; # optimization to reuse memory
        }
    } while (!$seen_eos);  
    $bb->destroy; 
    return $data;
}

 正直、これ見て、mod_Perlをやめようと思った。
EOS(end of string:ファイルの終端文字)を自分で検出しなければいけないなんて!
が、しかし、Apache2::Uploadの解説ページを見て、「これならやれる!」と思った。
本当にやれんのか?
動いた!

#!/usr/bin/perl

use Apache2::RequestRec();
use CGI::Carp;

my $r =shift;
savefile::handler($r);

package savefile;

use CGI::Carp;
use Apache2::Upload;

sub handler {
my ($gomi,$r) =@_;
local $req = Apache2::Request->new($r);
local $upload = $req->upload('editfile');
my $tempfile = "temp.dat";
open(TEMP,">", "./save/$tempfile") or die("Can't open $tempfile.\n");
binmode TEMP;
my $buf='';
read($upload->fh, $buf, $upload->size);
print TEMP $buf;
$buf='';
close(TEMP);
return 1;
}
return 1;

 CGI::Fastから普通のCGIモジュールに戻したのは、naoyaのはてなダイアリーの中で、CGIモジュール内にmod_perlモードがあると書いてあったので。
packageの中にサブルーチン書いて、mainから呼び出すように書かないと、"my"や"local"で変数を宣言しても、mod_perl内全体でのグローバル変数になってしまうために、おかしな挙動になるから。
でも、基本的なサブルーチンだから、インラインパッケージじゃなくって、モジュール化しても良いかも。
で、ボヤキなのですが、本当は元のソースみたいに、

while (read($upload->fh, $buf, 1024)) {
  print TEMP $buf;
}

 って、1KBごとに読みたかったのですが、こう書くと、最初の1KBだけが延々と出力された。Apacheを停止する他なく、その間に400MBのファイルが出来てしまった。
もし、この書き方で成功していても、事前にファイルサイズをチェックして、それ以上は読み込まないような処理を入れなきゃいけない気がしたので、この方法を追求するのはやめました。
まぁ、libapreq2が動いただけでも、ひと山越せた気がします。

Apache2::Requestの解説ページで、

my $req = Apache2::Request->new($r, POST_MAX => "1M");

 って、例が書かれていて、uploadのファイルサイズを制限できるって書いてあるので、コピペして使ったら、600KBぐらいのファイルをアップロードしたのにエラーになった。
Apacheのerror_logをみたら、

[error] [client ::1] (20014)Internal error: Content-Length header (588573) exceeds configured max_body limit (1),
[error] Exceeds configured maximum limit

をいをい、1MBじゃなくって、1バイトに設定されているがな。
どっちにしても、500KBあたりを超えると、

[error] Internal apreq error

 というエラーでアップロード出来ない。。。