ParseMIME.pm

#!/usr/local/bin/perl

package ParseMIME;

use Tool;
use strict;

my $CRLF = '\x0d\x0a';

# 1で非RFC準拠のドキュメントを許す
# 主にIEがヘッダに8ビット文字を含める問題に対応
sub IE_COMPAT{1};

# MIMEメッセージへの参照を受け取って、構文解釈を行って返す
# $return{''}は、メッセージボディ。$return{'要素名'}{''}はその要素の値。
# $return{'項目名'}{'属性名'}その要素の属性'属性名'の値

sub parse_mime{
	my($part) = @_;
	my %return;

	# RFC的定義の正規表現
	my $reg = rfc_regex();

	# pertを行ごとに分割したもの
	my @part = split(/$CRLF/,$$part);
	my %header;

	# whileループで使う
	my($line, $key);

	# ヘッダごとに連想配列に格納する。
	while($_ = shift(@part)){
		last if /^$/; # ヘッダの終わり
		chomp;

		# X-要素はX-の後にtokenを続ける事が出来るので、token扱いしておく
		if (/^($reg->{token}): (.+)/i){
			$key = "\L$1";
			$header{$key} = $2;
		}elsif(s/^\s+/ /){
			$key or Tool::error("malformed header line: $_<br>continuous line have no parent.");
			# 継続行の場合、追加する
			$header{$key} .= $_;
		}else{
			Tool::error("malformed header line: $_");
		}
	}

	# メッセージ・ボディ
	$return{''} = join('', @part);
	undef @part;

	foreach my $key (keys %header){
		$return{$key} = parse_param($header{$key});
	}

	return(\%return);
}

# ヘッダラインの「: 」以降を解釈。値をバラして戻す
sub parse_param{
	my($header_line)= @_;

	my %return;
	my $reg = rfc_regex();

	my @param = split(/; /,$header_line);
	# まずヘッダラインの値を格納
	$return{''} = shift(@param);

	# パラメタの処理
	foreach(@param){
		if(/^($reg->{token})=($reg->{token})/){
			# 値はトークン
			$return{"\L$1"} = $2;
		}elsif(/^($reg->{token})=($reg->{quoted_str})/){
			# 値はquoted-string
			my ($key, $value) = ("\L$1", $2);
			# 値を元に戻す(クオートを外す)
			$value =~ s/^"(.*)"$/$1/;
			$value =~ s/\\(.)/$1/g;
			$return{$key} = $value;
		}else{
			Tool::error("malformed param: '$_' on '$header_line'");
		}
	}
	\%return;
}

# RFC的定義の正規表現
# ここで実際に使うのはtokenとquoted_str
sub rfc_regex{
	my %rfc_reg; # 戻り値

	# 便宜上。
	my $bksl = "\\\\"; #シングルクオートでも同じ。'\\'が入る。

	# RFC1521 http://www.ietf.org/rfc/rfc1521.txt

	# tspecials :=  "(" / ")" / "<" / ">" / "@" / "," / ";" / ":" / "\" / <"> / "/" / "[" / "]" / "?" / "="
	$rfc_reg{tspecials} = qq{\\(\\)\\<\\>\\@\\,\\;\\:\\"\\/\\[\\'\\?\\=$bksl};
	# token  :=  1*<any (ASCII) CHAR except SPACE, CTLs, or tspecials>
	$rfc_reg{token} = "(?:[^\x00-\x20\x7f-\xff$rfc_reg{tspecials}]+)"; # 

	# RFC822 http://www.ietf.org/rfc/rfc822.txt
	
	# qtext = <any CHAR excepting <">, "\" & CR, and including linear-white-space> ; may be folded
	$rfc_reg{qtext} = qq{(?:[^$bksl\\"\x0d\x80-\xff])}; 
	# quoted-pair = "\" CHAR ; may quote any char
	$rfc_reg{quoted_pair} = qq{(?:${bksl}} . qq{[\x00-\x7f])}; # "\" CHAR
	# quoted-string = <"> *(qtext/quoted-pair) <">; 
	$rfc_reg{quoted_str} = qq{(?:\"$rfc_reg{qtext}*(?:$rfc_reg{quoted_pair}$rfc_reg{qtext}*)*\")}; 

	# ゆるいquoted_srtを作る。IE対応用
	if(IE_COMPAT){
		$rfc_reg{qtext} = qq{(?:[^\\"\x0d])}; 
		$rfc_reg{quoted_str} = qq{(?:\"$rfc_reg{qtext}*(?:$rfc_reg{quoted_pair}$rfc_reg{qtext}*)*\")}; 
	}
	
	\%rfc_reg;
}

1;