FileUpload.pm

#!/usr/local/bin/perl
package FileUpload;

use Tool;
use strict;
use ParseMIME;

my $max_length = 100_000;
my $CRLF = '\x0d\x0a';

sub get{
	# Content-Typeを解釈する
	my $ctype = ParseMIME::parse_param($ENV{CONTENT_TYPE});
	my $mime_type = $ctype->{''};
	my $boundary = $ctype->{'boundary'};

	# multipartかどうかチェック
	if($mime_type ne 'multipart/form-data' and $mime_type ne 'multipart/mixed'){
		Tool::error("not multipart: $mime_type");
	}

	# boundaryチェック
	$boundary or Tool::error("No boundary: $ENV{CONTENT_TYPE}");

	# フォームデータ取得
	my $form_data = read_data($boundary);

	# 戻り値を格納する変数
	my %part;
	my %param;

	foreach my $part (@$form_data){
		# メッセージパートごとにMIMEヘッダを解釈します
		my $return = ParseMIME::parse_mime(\$part);
		my $name = $return->{'content-disposition'}{name};

		# 値を格納
		$part{$name}{filename} = $return->{'content-disposition'}{filename};
		$part{$name}{ctype}    = $return->{'content-type'}{''};
		$part{$name}{content}  = $return->{''};
		$param{$name}          = $return->{''}; # 普通のパラメタ
	}
	wantarray ? (\%part, \%param) : \%part;
}

# boundaryを受け取り、STDINから読み取ったFORM_DATAを分割して返す
sub read_data{
	my($boundary) = @_;

	my $content_length = $ENV{CONTENT_LENGTH};
	my $form_data; # 読み取り用
	my @form_data; # 分割後

	# サイズチェック
	Tool::error("Too large: ${content_length}bytes") if $content_length > $max_length;

	# データ読み取り
	read(STDIN, $form_data, $content_length);

	# 末尾のデリミタを削除
	$form_data =~ s/--$boundary--(.|\n)*$//;

	# boundaryで分割
	my @form_data = split(/(?:^|$CRLF)--$boundary$CRLF/,$form_data);
	undef $form_data;

	\@form_data;
}

1;