メールの件名だけのためにMIME::Base64とか使いたくないなーと思ったので。
ほぼ、こちら（
http://nabe.blog.abk.nu/064）の丸写しでごめんなさい。
-----------------------------------------------------------------------
#エンコード
my $subject1 = &base64_Encode($target1);
#デコード
my $subject2 = &base64_Decode($target2);
sub base64_Encode {
my ($target) = @_;
my ($base) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
."abcdefghijklmnopqrstuvwxyz"
."0123456789+/";
my $eStr = "";
my $pStr = unpack("B*",$target);
for(my $i = 0;my $cStr = substr($pStr,$i,6); $i += 6){
$eStr .= substr($base,ord(pack("B*","00".$cStr)),1);
if(length($cStr) == 2){
$eStr .= "==";
}
elsif(length($cStr) == 4){
$eStr .= "=";
}
}
return("=?ISO-2022-JP?B?$eStr?=");
}
sub base64_Decode {
my ($str) = @_;
$str =~ s/=\?ISO-2022-JP\?B\?([A-Za-z0-9\+\/=]*)\?=/{&base64_Decode2($1)}/egi;
return $str;
}
sub base64_Decode2 {
my ($str) = @_;
my @base64ary = (
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 0x00〜0x1f
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 0x10〜0x1f
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,62, 0, 0, 0,63, # 0x20〜0x2f
52,53,54,55, 56,57,58,59, 60,61, 0, 0, 0, 0, 0, 0, # 0x30〜0x3f
0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, # 0x40〜0x4f
15,16,17,18, 19,20,21,22, 23,24,25, 0, 0, 0, 0, 0, # 0x50〜0x5f
0,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, # 0x60〜0x6f
41,42,43,44, 45,46,47,48, 49,50,51, 0, 0, 0, 0, 0 # 0x70〜0x7f
);
my $ret;
my $buf;
my $f;
if (substr($str, -1) eq '=') { $f=1; }
if (substr($str, -2) eq '==') { $f=2; }
for(my $i=0; $i<length($str); $i+=4){
$buf = ($buf<<6) + $base64ary[ ord(substr($str,$i ,1)) ];
$buf = ($buf<<6) + $base64ary[ ord(substr($str,$i+1,1)) ];
$buf = ($buf<<6) + $base64ary[ ord(substr($str,$i+2,1)) ];
$buf = ($buf<<6) + $base64ary[ ord(substr($str,$i+3,1)) ];
$ret .= chr(($buf & 0xff0000)>>16) . chr(($buf & 0xff00)>>8) . chr($buf & 0xff);
}
if ($f>0) { chop($ret); }
if ($f>1) { chop($ret); }
return $ret;
}
-----------------------------------------------------------------------
