まだうまく行ってるのかどうか疑問だけど、multipart解析部分で、今回変更したのは。

/usr/local/lib/perl5/site_perl/5.8.6/CGI/Lite.pm

の中の

sub_parse_multipart_data

から、

current_bufferに対して正規表現で disposition header body を取得する部分。

出力用ファイルハンドルを変更する部分（CL00がすでに使われていたら、インクリメントしてファイルハンドルを変更する）

を取り込んでみた。

ファイルハンドルを変更するところは、use strict 環境下では、ブロック内で

no strict ’refs’

が必要。

自作ルーチンでは、disposition データ部分の切り分けで失敗することが多かった、ようなので、すでに枯れて落ち着いてる車輪を導入。

mod_perl下でメモリのキャッシュの挙動がよくわからんし、同時アクセス制御にもなるだろう、ということでファイルハンドルの変更を導入。

といった感じか。

multipart/form-dataを使って、画像などのアップロードするCGIはこのやり口が定番、らしい。Mac版IE5.23のバグも吸収してるっぽいし、これで安定してくれるといいんだけど…。

BLOCK_LTAG

read(STDIN， $buf， $ENV{’CONTENT_LENGTH’})；

my($boundary) = $ENV{’CONTENT_TYPE’} =~ /boundary=-(\S+)$/； バウンダリの取得

my @form_body = split(/\-*${boundary}\-*/， $buf)；

foreach my $c ( @form_body ){

next if ! $c；

my ($disposition，$header，$body)；

if($c =~ /[Cc]ontent-[Dd]isposition: ([^\x0D\x0A]+)\x0D?\x0A Disposition

(?:([A-Za-z].*?)(?:\x0D?\x0A){2})? ヘッダ情報の取得

(?:\x0D?\x0A)? 予約空行

(?=(.+))/xs){ データ行（次のヘッダ情報が含まれていることもある）

($disposition，$header，$body) = ($1，$2，$3)；

}

next if ! $disposition；

if( $disposition =~ /name=\"([^\"]+)\"； *filename=\"([^\"]+)\"/i ){

my $name = $1；

my $filename = $2； $filename =~ s!\\!/!g； $filename =~ s!^.+/!!；

$form_file{$filename} = $body if $filename && $body；

$form{$name} = $filename；

$name=""； $filename =""； $body = ""；

}

else{

my ( $name ) = $disposition =~ /.+name=\"([^\"]+)\"/i；

next if ! $name；

$body =~ s/(\r\n)+$//

$form{$name} = $body；

}

}

BLOCK_RTAG