attach.pl

package Attach;

require 'base64.pl';
require 'jcode.pl';

%image = (
	'text/plain', '/icons/text.gif',
	'image/gif' , '/icons/image2.gif',
	'image/jpeg', '/icons/image2.gif',
	'image/png' , '/icons/image2.gif',
	'text/html' , '/icons/layout.gif',
	'text/pdf'  , '/icons/layout.gif',
	'application/octet-stream'
				, '/icons/binary.gif',
	'UNKNOWN'   ,'/icons/unknown.gif',
);


# 添付ファイルの切り分け
# 本文の参照と、boundaryを渡す。

# 本文からは、添付ファイルが除かれる。
# "$content{NAME}\0$content{FILE}\0$image"
# という形式の配列を返す

sub text{
	local(*contents, $boundary) = @_;
	local($header, $null, @rest, $rest);
	local(@attach);

	local(@content) = &split_contents(*contents, $boundary);

	$contents = "";

	foreach (@content){
		local($header, $null, @rest) = split(/(\r\n\r\n)/);
		$rest = join("", @rest);
		@rest = ();

		%content = &get_header($header);

		$image = $image{$content{TYPE}} || $image{UNKNOWN};

		if($content{TYPE} eq "text/plain" && $content{NAME} eq ""){
			$contents .= $rest;
		}else{		
			push(@attach, "$content{NAME}\0$content{FILE}\0$image");
		}
	}
	# 本文がなかったときのデフォルトの文章
	$contents = $contents || 'This is a multi-part message in MIME format.';
	@attach;
}

sub get{
	local(*contents, $boundary, $file) = @_;
	local($header, $null, @rest, $rest);
	
	local(@content) = &split_contents(*contents, $boundary);

	foreach(@content){
		local($header, $null, @rest) = split(/(\r\n\r\n)/);
		$rest = join("", @rest);
		@rest = ();

		%content = &get_header($header);

		next unless($file eq $content{FILE});

		$content  = "Content-Type: $content{TYPE}\n";
		$content .= qq!Content-Disposition: filename="$content{FILE}"\n\n!;
		$content .= &base64'b64decode($rest) if($content{ENCODE} eq 'base64');
	}
	$content;
}

# メッセージ本体を、boundaryで分割して返す
# 内部で使われる

sub split_contents{
	local(*contents, $boundary) = @_;

	# boundaryが空なら異常終了
	&main'error("No boundary") unless $boundary =~ /\S/;

	$contents =~ s/--$boundary--\r\n(.|\n)*//;
	local(@content) = split(/--$boundary/o, $contents);
	shift(@content); # 先頭の余分な文字列を削る

	@content;
}

# ヘッダ情報を取得して連想配列で返す
# 返すのは、NAME,FILE,ENCODEの3つ。
# 内部で使われる

sub get_header{
	local($header) = @_;
	local(%content);

	foreach(split(/\r\n/, $header)){
		if    (/^Content-Type: +([^ ;]*)/i){
			$content{TYPE} = $1;
			if(/; +name="?([^; "]+)/i){
				$content{NAME} = $1;
			}
		}elsif(/^Content-Disposition: /i){
			if(/; +filename="?([^; "]+)/i){
				$content{FILE} = $1;
			}
		}elsif(/^Content-Transfer-Encoding: +([^ ;]*)/i){
			$content{ENCODE} = $1;
		}
	}
	# FILEとNAMEと、片方が空なら補う
	$content{FILE} = $content{FILE} || $content{NAME};
	$content{NAME} = $content{NAME} || $content{FILE};
	%content;
}
1;