▼ 2006/08/09(水) Perlによるbase64エンコード/デコードの実装
■エンコード
MIME::Base64(C実装)を使えば速いのですが、メールのタイトル程度でそこまでする必要はないし*1、かと言って日本で有名な某MIMEルーチンは、巨大変換テーブルという非効率な実装なので、自作した奴。
# テーブル
my $base64table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
# 変換処理
$subject =~ s/(\e\$[\@B].*?\e\([BJ])/ '=?ISO-2022-JP?B?' . &base64encode($1) . '?=' /eg;
sub base64encode {
my $str = shift;
my $table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
my $ret;
# 2 : 0000_0000 1111_1100
# 4 : 0000_0011 1111_0000
# 6 : 0000_1111 1100_0000
my ($i, $j, $x, $y);
for($i=$x=0, $j=2; $i<length($str); $i++) {
$x = ($x<<8) + ord(substr($str,$i,1));
$ret .= substr($table, ($x>>$j) & 0x3f, 1);
if ($j != 6) { $j+=2; next; }
# j==6
$ret .= substr($table, $x & 0x3f, 1);
$j = 2;
}
if ($j != 2) { $ret .= substr($table, ($x<<(8-$j)) & 0x3f, 1); }
if ($j == 4) { $ret .= '=='; }
elsif ($j == 6) { $ret .= '='; }
return $ret;
}
*1 : Perlは外部モジュールロードが速くない
■デコード
# テーブル
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
);
# デコード処理
$subject =~ s/=\?ISO-2022-JP\?B\?([A-Za-z0-9\+\/=]*)\?=/ &base64decode($1) /eg;
sub base64decode {
my $str = shift;
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;
}
- TB-URL http://nabe.blog.abk.nu/064/tb/



1: kattyo 2006年08月11日(金) 深夜2時50分
エラー処理は〜
2: なべ 2006年08月12日(土) 深夜2時21分
デコードではないので、エラーおきないと思うんですけど(^^;
3: 通りすがり 2008年01月31日(木) 午後4時46分
my $self = shift;
があると正しくデコードできませんね。
4: なべ 2008年01月31日(木) 深夜1時01分
訂正しました、ありがとうございました。
5: lunasys 2009年10月31日(土) 深夜0時46分
貴重なコードをありがとうございます。
自サイトの掲示板で投稿通知処理で利用させて戴きます。
6: なべ 2009年11月03日(火) 午後11時30分
JISコードきめうちなので今にすれば少々古いですね。
メールならJISが無難ですが、10年もしたらちUTF8の時代になるのかな。