まだうまく行ってるのかどうか疑問だけど、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のバグも吸収してるっぽいし、これで安定してくれるといいんだけど…。

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

『つくって覚えるPerl入門』

オフィス加減

[更新]2013-03-14 11:12:46