package MIME;
# Copyright (C) 1993-94,1997 Noboru Ikuta <noboru@ikuta.ichihara.chiba.jp>
#
# mimew.pl: MIME encoder library Ver.2.02 (1997/12/30)

$main'mimew_version = "2.02";

# インストール : @INC のディレクトリ（通常は /usr/local/lib/perl）にコピー
#                して下さい。
#
# 使用例1 : require 'mimew.pl';
#           $from = "From: 生田 昇 <noboru\@ikuta.ichihara.chiba.jp>";
#           print &mimeencode($from);
#
# 使用例2 : # UNIXでBase64エンコードする場合
#           require 'mimew.pl';
#           undef $/;
#           $body = <>;
#           print &bodyencode($body);
#           print &benflush;
#
# &bodyencode($data,$coding):
#   データをBase64形式またはQuoted-Printable形式でエンコードする。
#   第2パラメータに"qp"または"b64"を指定することによりコーディング形式
#   を指示することができる。第2パラメータを省略するとBase64形式でエン
#   コードする。
#   Base64形式のエンコードの場合は、$foldcol*3/4 バイト単位で変換する
#   ので、渡されたデータのうち半端な部分はバッファに保存され次に呼ばれ
#   たときに処理される。最後にバッファに残ったデータは&benflushを呼ぶ
#   ことにより処理されバッファからクリアされる。
#   Quoted-Printable形式のエンコードの場合は、行単位で変換するため、
#   データの最後に改行文字が無い場合、最後の改行文字の後ろのデータは
#   バッファに保存され、次に呼ばれたときに処理される。最後にバッファ
#   に残ったデータは&benflush("qp")を呼ぶことにより処理されバッファ
#   からクリアされる。
#
# &benflush($coding):
#   第1パラメータに"b64"または"qp"を指定することにより、それぞれBase64
#   形式またはQuoted-Printable形式のエンコードを指定することができる。
#   第1パラメータに何も指定しなければBase64形式でエンコードされる。
#   Base64のエンコードの場合、&bodyencodeが処理し残したデータを処理し
#   pad文字を出力する。Quoted-Printableの場合、行単位でなくブロック単
#   位で&bodyencodeを呼ぶ場合、&bodyencodeが処理し残したデータがもし
#   バッファに残っていればそれを処理する。
#   一つのデータを(1回または何回かに分けて)&bodyencodeした後に必ず1回
#   呼ぶ必要がある。
#
# &mimeencode($text):
#   第1パラメータが日本語文字列を含んでいれば、その部分をISO-2022-JPに
#   変換したあと、MIME encoded-word(RFC2047参照)に変換する。必要に応じ
#   てencoded-wordの分割とencoded-wordの前後での行分割を行う。
#
#   文字コードの自動判定は、同一行にShiftJISとEUCが混在している場合を
#   除いて漢字コードの混在にも対応している。ShiftJISかEUCかどうしても
#   判断できないときは$often_use_kanjiに設定されているコードと判定する。
#   ISO-2022-JPのエスケープシーケンスは$jis_inと$jis_outに設定すること
#   により変更可能である。

$often_use_kanji = 'SJIS'; # or 'EUC'

$jis_in  = "\x1b\$B"; # ESC-$-B ( or ESC-$-@ )
$jis_out = "\x1b\(B"; # ESC-(-B ( or ESC-(-J )

# 配布条件 : 著作権は放棄しませんが、配布・改変は自由とします。改変して
#            配布する場合は、オリジナルと異なることを明記し、オリジナル
#            のバージョンナンバーに改変版バージョンナンバーを付加した形
#            例えば Ver.2.02-XXXXX のようなバージョンナンバーを付けて下
#            さい。なお、Copyright表示は変更しないでください。
#
# 注意 : &mimeencodeをjperl1.X(の2バイト文字対応モード)で使用すると、SJIS
#        とEUCをうまく7bit JIS(ISO-2022-JP)に変換できません。
#        入力に含まれる文字が7bit JIS(ISO-2022-JP)とASCIIのみであること
#        が保証されている場合を除き、必ずoriginalの英語版のperl（または
#        jperl1.4以上を -Llatin オプション付き）で動かしてください。
#        なお、Perl5対応のjperlは試したことがないのでどのような動作になる
#        かわかりません。
#
# 参照 : RFC1468, RFC2045, RFC2047

## MIME base64 アルファベットテーブル（RFC2045より）
%mime = (
"000000", "A",  "000001", "B",  "000010", "C",  "000011", "D",
"000100", "E",  "000101", "F",  "000110", "G",  "000111", "H",
"001000", "I",  "001001", "J",  "001010", "K",  "001011", "L",
"001100", "M",  "001101", "N",  "001110", "O",  "001111", "P",
"010000", "Q",  "010001", "R",  "010010", "S",  "010011", "T",
"010100", "U",  "010101", "V",  "010110", "W",  "010111", "X",
"011000", "Y",  "011001", "Z",  "011010", "a",  "011011", "b",
"011100", "c",  "011101", "d",  "011110", "e",  "011111", "f",
"100000", "g",  "100001", "h",  "100010", "i",  "100011", "j",
"100100", "k",  "100101", "l",  "100110", "m",  "100111", "n",
"101000", "o",  "101001", "p",  "101010", "q",  "101011", "r",
"101100", "s",  "101101", "t",  "101110", "u",  "101111", "v",
"110000", "w",  "110001", "x",  "110010", "y",  "110011", "z",
"110100", "0",  "110101", "1",  "110110", "2",  "110111", "3",
"111000", "4",  "111001", "5",  "111010", "6",  "111011", "7",
"111100", "8",  "111101", "9",  "111110", "+",  "111111", "/",
);

## JISコード(byte数)→encoded-word の文字数対応
%mimelen = (
 8,30, 10,34, 12,34, 14,38, 16,42,
18,42, 20,46, 22,50, 24,50, 26,54,
28,58, 30,58, 32,62, 34,66, 36,66,
38,70, 40,74, 42,74,
);

## ヘッダエンコード時の行の長さの制限
$limit=74; ## ＊注意＊ $limitを75より大きい数字に設定してはいけない。

## ボディbase64エンコード時の行の長さの制限
$foldcol=72; ## ＊注意＊ $foldcolは76以下の4の倍数に設定すること。

## ボディQuoted-Printableエンコード時の行の長さの制限
$qfoldcol=75; ## ＊注意＊ $foldcolは76以下に設定すること。

## null bitの挿入と pad文字の挿入のためのテーブル
@zero = ( "", "00000", "0000", "000", "00", "0" );
@pad  = ( "", "===",   "==",   "=" );

## ASCII, 7bit JIS, Shift-JIS 及び EUC の各々にマッチするパターン
$match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';
$match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';
$match_sjis = '([\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])+';
$match_euc  = '([\xa1-\xfe]{2})+';

## MIME Part 2(charset=`ISO-2022-JP',encoding=`B') の head と tail
$mime_head = '=?ISO-2022-JP?B?';
$mime_tail = '?=';

## &bodyencode が使う処理残しデータ用バッファ
$benbuf = "";

## &bodyencode の処理単位（バイト）
$bensize = int($foldcol/4)*3;

## &mimeencode interface ##
sub main'mimeencode {
    local($_) = @_;
    s/$match_jis/$jis_in$1/go;
    s/$match_ascii/$jis_out$1/go;
    $kanji = &checkkanji;
    s/$match_sjis/&s2j($&)/geo if ($kanji eq 'SJIS');
    s/$match_euc/&e2j($&)/geo if ($kanji eq 'EUC');
    s/(\x1b[\$\(][BHJ@])+/$1/g;
    1 while s/(\x1b\$[B@][\x21-\x7e]+)\x1b\$[B@]/$1/;
    1 while s/$match_jis/&mimeencode($&,$`,$')/eo;
    s/$match_ascii/$1/go;
    $_;
}

## &bodyencode interface ##
sub main'bodyencode {
    local($_,$coding) = @_;
    if (!defined($coding) || $coding eq "" || $coding eq "b64"){
	$_ = $benbuf . $_;
	local($cut) = int((length)/$bensize)*$bensize;
	$benbuf = substr($_, $cut+$[);
	$_ = substr($_, $[, $cut);
	$_ = &base64encode($_);
	s/.{$foldcol}/$&\n/g;
    }elsif ($coding eq "qp"){
	# $benbuf が空でなければデータの最初に追加する
	$_ = $benbuf . $_;

	# 改行文字を正規化する
	s/\r\n/\n/g;
	s/\r/\n/g;

	# データを行単位に分割する(最後の改行文字以降を $benbuf に保存する)
	@line = split(/\n/,$_,-1);
	$benbuf = pop(@line);

	local($result) = "";
	foreach (@line){
	    $_ = &qpencode($_);
	    $result .= $_ . "\n";
	}
	$_ = $result;
    }
    $_;
}

## &benflush interface ##
sub main'benflush {
    local($coding) = @_;
    local($ret) = "";
    if ((!defined($coding) || $coding eq "" || $coding eq "b64")
	&& $benbuf ne ""){
        $ret = &base64encode($benbuf) . "\n";
        $benbuf = "";
    }elsif ($coding eq "qp" && $benbuf ne ""){
	$ret = &qpencode($benbuf) . "\n";
	$benbuf = "";
    }
    $ret;
}

## MIME ヘッダエンコーディング
sub mimeencode {
    local($_, $befor, $after) = @_;
    local($back, $forw, $blen, $len, $flen, $str);
    $befor = substr($befor, rindex($befor, "\n")+1);
    $after = substr($after, 0, index($after, "\n")-$[);
    $back = " " unless ($befor eq ""
                     || $befor =~ /[ \t\(]$/);
    $forw = " " unless ($after =~ /^\x1b\([BHJ]$/
                     || $after =~ /^\x1b\([BHJ][ \t\)]/);
    $blen = length($befor);
    $flen = length($forw)+length($&)-3 if ($after =~ /^$match_ascii/o);
    $len = length($_);
    return "" if ($len <= 3);
    if ($len > 39 || $blen + $mimelen{$len+3} > $limit){
        if ($limit-$blen < 30){
            $len = 0;
        }else{
            $len = int(($limit-$blen-26)/4)*2+3;
        }
        if ($len >= 5){
            $str = substr($_, 0, $len).$jis_out;
            $str = &base64encode($str);
            $str = $mime_head.$str.$mime_tail;
            $back.$str."\n ".$jis_in.substr($_, $len);
        }else{
            "\n ".$_;
        }
    }else{
        $_ .= $jis_out;
        $_ = &base64encode($_);
        $_ = $back.$mime_head.$_.$mime_tail;
        if ($blen + (length) + $flen > $limit){
            $_."\n ";
        }else{
            $_.$forw;
        }
    }
}

## MIME base64 エンコーディング
sub base64encode {
    local($_) = @_;
    $_ = unpack("B".((length)<<3), $_);
    $_ .= $zero[(length)%6];
    s/.{6}/$mime{$&}/go;
    $_.$pad[(length)%4];
}

## Quoted-Printable エンコーディング
sub qpencode {
    local($_) = @_;

    # `=' 文字を16進表現に変換する
    s/=/=3D/g;

    # 行末のタブとスペースを16進表現に変換する
    s/\t$/=09/;
    s/ $/=20/;

    # 印字可能文字(`!'〜`~')以外の文字を16進表現に変換する
    s/([^!-~ \t])/&qphex($1)/ge;

    # 1行が$qfoldcol文字以下になるようにソフト改行をいれる
    local($folded, $line) = "";
    while (length($_) > $qfoldcol){
	$line = substr($_, 0, $qfoldcol-1);
	if ($line =~ /=$/){
	    $line = substr($_, 0, $qfoldcol-2);
	    $_ = substr($_, $qfoldcol-2);
	}elsif ($line =~ /=[0-9A-Fa-f]$/){
	    $line = substr($_, 0, $qfoldcol-3);
	    $_ = substr($_, $qfoldcol-3);
	}else{
	    $_ = substr($_, $qfoldcol-1);
	}
	$folded .= $line . "=\n";
    }
    $folded . $_;
}

sub qphex {
    local($_) = @_;
    $_ = '=' . unpack("H2", $_);
    tr/a-f/A-F/;
    $_;
}

## Shift-JIS と EUC のどちらの漢字コードが含まれるかをチェック
sub checkkanji {
    local($sjis,$euc);
    $sjis += length($&) while(/$match_sjis/go);
    $euc  += length($&) while(/$match_euc/go);
    return 'NONE' if ($sjis == 0 && $euc == 0);
    return 'SJIS' if ($sjis > $euc);
    return 'EUC'  if ($sjis < $euc);
    $often_use_kanji;
}

## EUC を 7bit JIS に変換
sub e2j {
    local($_) = @_;
    tr/\xa1-\xfe/\x21-\x7e/;
    $jis_in.$_.$jis_out;
}

## Shift-JIS を 7bit JIS に変換
sub s2j {
    local($string);
    local(@ch) = split(//, $_[0]);
    while(($j1,$j2)=unpack("CC",shift(@ch).shift(@ch))){
        if ($j2 > 0x9e){
            $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+2;
            $j2 -= 0x7e;
        }
        else{
            $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+1;
            $j2 -= ($j2>0x7e ? 0x20 : 0x1f);
        }
        $string .= pack("CC", $j1, $j2);
    }
    $jis_in.$string.$jis_out;
}
1;