#!/usr/bin/perl

#### 概要
# 軽快電話6のメールファイル(独自形式のバイナリ)を、mbox(ucb)形式に変換し、
# 標準出力に出力します。
# ただし、抽出できるのは、「受信(送信)日時」「本文」「題名」「差出人(宛先)」
# のみです。
# また、このバイナリの解析は、私が自力でおこなっています。SOURCENEXT から
# 資料提供などは受けておりません。従って、すべてのメールファイルを正しく
# 解析できるとは限りませんので、ご了承ください。

#### 動作環境
# perl 5 以降
# 以下のモジュールが必要です。
#   MIME::Base64
#   Jcode
#
# このスクリプトは、Shift-JIS コードで保存する必要があります。

#### 使用方法
# > perl keikai2ucb.pl [-o|-i] input_file.kml > output_file.mbx
# 
# -o を指定すると、送信トレイをエクスポートするモードで動作します。
# -i を指定すると、受信トレイをエクスポートするモードで動作します。
#
# input_file.kml は、軽快電話6のメールデータファイル(バイナリ)です。
# 軽快電話6をインストールすると、マイドキュメントに、軽快電話用の
# フォルダができますが、この直下にある、
#    keikai_outbox.kml が、送信トレイ。
#    keikai_inbox.kml  が、受信トレイです。
#
# このプログラムは、結果を標準出力に出力します。なので、結果を特定の
# ファイルに保存したい場合、> (リダイレクト)を使って下さい。


################## ライブラリの読み込み。

use bytes;
use MIME::Base64;
use Jcode;

#################
	
$Usage = "$0 [-o|-i] input_file.kml > output_file.mbx\n";


################## 引数チェック

if ( $ARGV[0] !~ /^-[oi]$/i ){
	print $Usage;
	die("Mode is not specified. Use \"-o\" for outbox, \"-i\" for inbox.\n");

}
if ( !$ARGV[1] ){
	print $Usage;
	die("Input file is not specified.\n");
}
if ( -e $ARGV[1] ){
	die("Input file is not found.\n");
}

################## ユーザ設定の変数。
################## ご自分の環境にあわせて書き換えて下さい。

### 自分のメールアドレス。
### 受信トレイをエクスポートする場合 "To: "ヘッダの値として、
### 送信トレイをエクスポートする場合 "From: "ヘッダの値として使用されます。
### "@"の前には、"\"をつけてください。
$My_Address = "my_mail_address\@docomo.ne.jp";


### メーラーの名称。
### "X-Mailer: "ヘッダの値として使用されます。
$My_Mailer  = "Mobile Phone";

### メールアドレスのコメント部。このハッシュに名前を書いておくと、
### "To:" ヘッダや "From:" ヘッダが、
###    友達の名前<xxxxx@docomo.ne.jp>
### のように出力されます。この部分の処理は、"友達の名前"が Shift-JIS
### であることを前提としているので、このスクリプトは、Shift-JIS で
### 保存をお願いします。さもないと文字化けします。
%Name = (
"your_friend_1\@docomo.ne.jp" => "友達の名前",
"your_friend_2\@ezweb.ne.jp" => "友達の名前",
"your_friend_3\@t.vodafone.ne.jp" => "友達の名前",
);


################## 内部変数の定義。

### 動作モード
$Mode = $ARGV[0] =~ /i/i ? "Inbox" : "Outbox";

### 読み込むファイル名
$Infile  = $ARGV[1];

### mbox 形式で使用する、曜日と月の英語表記
@Wday  = ( qw (Sun Mon Tue Wed Thu Fri Sat) );
@Month = ( qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) );


### From: と To: の出力形式。動作モードにより変わる。
if ( $Mode eq "Inbox" ){
	$Com_format = "From: %s<%s>\nTo: $My_Address";
}
else{
	$Com_format = "To: %s<%s>\nFrom: $My_Address";
}


################## ファイルを読み込む。

open(IN, $Infile) || die("Can't read $Infile : $!\n");
binmode(IN);

while(<IN>){
	$Data .= $_;
}
close(IN);


################## データ解析

### 先頭から36バイトは取り除く。
### 37バイト目から、同じようなデータが繰り返し入っているので、これらが
### 本文と考えられる。先頭はたぶん、軽快電話メールが使用するメタデータ??)
$Data = substr($Data, 36);

### メール一通ずつの処理。(37バイト目以降)
while( $Data ){
	my ($addr, $date, $subject, $body, $meta, $rest, $com);
	
	### メールの各フィールドは、"値の長さ" + "値" という形式で入っている
	### 模様。"値の長さ" が 0xFF の場合、続く 2バイトを、"値の長さ"として
	### 処理するようだ。
	### 下記の "get_ld" サブルーチンは、引数の文字列から、"値の長さ" + "値"
	### を読み、"値" と "残り部分" を返す。
	
	($addr,    $rest) = &get_ld( $Data );	# 差出人または宛先
	($subject, $rest) = &get_ld( $rest );	# 題名
	($body,    $rest) = &get_ld( $rest );	# 本文
	
	### 受信(送信)日時は、上記の方式と違い、40バイト固定長の領域に
	### 書き込まれている模様。　これをメタデータとして、あとでじっくり料理。
	$meta = substr( $rest,  0, 40 );	
	$Data = substr( $rest, 40 );

	### メタデータには、受信(送信)日時が、年、月、日、時、分、秒に分割され
	### 書き込まれている。それぞれ、メタデータの先頭から 0, 4, 8, 12, 16 バイト目
	my ($year, $month, $day, $hour, $min, $wday) = map { unpack("C", substr($meta, $_, 1)) }
	   (    0,      4,    8,    12,   16);

	### 年だけは、なぜかこのような半端な値が入れてある。
	$year = $year + 2000 - 208;

	### From: と To: の処理。
	$com = sprintf($Com_format, $Name{$addr} ? escape_jp( $Name{$addr} ) : "", $addr );

	### Subject: の処理。
	$subject = escape_jp( $subject );

	### 本文の処理。
	$body =~ s/\r\n/\n/g;
	
	### 受信(送信)日時の曜日を、ツェラーの公式を使って調べる。
	### timelocal が使えない環境でも OK!
	$wday = get_wday( $year, $month, $day );
	
	### 受信(送信)日時を、mbox 形式のものに整形する。
	$date = sprintf("%s, %d %s %d %02d:%02d:%02d %s %s",
	                  $wday,$day,$Month[$month-1],$year,$hour, $min,"00", "+0900", "(JST)"  );
	
	### 標準出力にプリント。
	print <<MAIL;
From 
Date: $date
$com
Subject: $subject
X-Mailer: $My_Mailer
MIME-Version: 1.0
Content-Type: text/plain;charset="shift-jis"
Content-Transfer-Encoding: 8bit

$body

MAIL
}

################## 終了処理

exit;


################## サブルーチン

sub escape_jp{
	my $in  = shift;
	my $b64 = encode_base64( $in );
	$b64 =~ s/\n$//;

	return sprintf( "=?ISO-2022-JP?B?%s?=", $b64 );
}

sub get_ld{
	my $in  = shift;
	my ($out, $rest);

	my $len = unpack("C", substr($in, 0, 1));
	my $sublen;

	if ( $len == 255 ){
		$sublen = unpack("S", substr($in, 1, 2));
		$out  = substr($in, 3, $sublen);
		$rest = substr($in, 3 + $sublen);
	}
	else{
		$out  = substr($in, 1, $len);
		$rest = substr($in, 1 + $len);
	}
	
	return ( $out, $rest );
}

sub get_wday{
	my ( $year, $month, $day ) = @_;
	
	if ( $month == 1 || $month == 2 ) {
		$year--;
		$month += 12;
	}

	my $i = ($year + int($year/4) - int($year/100) + int($year/400) + int((13*$month + 8)/5) + $day) %7;

	return $Wday[$i];
}