#!/usr/bin/perl

### データリンクソフト等でパソコンにコピーした SH505i/SH900i/P252i のメールを、
### UCB 形式のメールに変換する。
### (C) 2004 笠井 崇文(Takafumi Kasai), web@kasai.fm

### 動作環境:
# (A) perl 5 以降 (5.8.2 にて動作確認済み)
# (B) 以下の perl モジュール:
# 
# ・Digest::MD5  (http://search.cpan.org/~gaas/Digest-MD5-2.33/MD5.pm)
# ・MIME::Base64 (http://search.cpan.org/search?dist=MIME-Base64)
# ・Jcode        (http://search.cpan.org/~dankogai/Jcode-0.83/Jcode.pm)
# 
# ※1
# 	Digest::MD5 は、メールの重複検出に使ってます(md5_hex 関数)。これ以外の
# 	アルゴリズムで重複検出するように改造すれば、これは不要です。
# 

### 使用方法:
# 
# (1) SH505i 内のメールを、データリンクソフトでパソコンにコピーする。
# (2) SH505i 内のアドレス帳を、データリンクソフトでパソコンにコピーする。
# (3) このプログラムを、以下の通り実行する。
# 		perl sh505i_mail.pl -m xxxxx -a yyyyy > zzzzz.txt
# 	ただし
# 		xxxxx     … (1) の入ったフォルダ
# 		yyyyy     … (2) の入ったフォルダ
# 		zzzzz.txt … 出力する UCB 形式のメール
# 	※ -a yyyyy は省略可能
# 	
# (4) UCB 形式メールのインポート機能を持った、適当なメールソフトで、
#	zzzzz.txt をインポートする。

### 未解決事項:
#	(1) vCard, vMessage を、仕様に従って解析していません(SH505i依存)。
#		将来、階層構造を持った vMessage が i-mode メールで使用されるように
# 		なったら、何とかしないといけません。

use Digest::MD5 qw( md5_hex );
use MIME::Base64;
use Jcode;


##############################
### 変数設定部
##############################


### 自分のアドレス ( @ の前に \ を付けるのを忘れずに…)
### 送信メールを変換する場合、From: のアドレスに。受信メールを変換
### する場合、To: のアドレスに、この文字列が埋め込まれる。
### 実行時、-f オプションを使用した場合、その値で上書きされる。

$My_Address = "takafumi.kasai\@docomo.ne.jp";


### X-Mailer: に付加する文字列。
### 一旦メーラーに取り込んだ後、再度振り分けする場合などに便利。

$My_Mailer  = "Mobile Phone";


### アドレス帳ファイル(vCard)の拡張子 (ピリオドは不要)

$Ext_Addr   = "VCF";


### メールファイル(vMessage)の拡張子 (ピリオドは不要)

$Ext_Mail   = "VMG";


### メールの区切りとして出力する文字列 (UCB 形式の場合、"From ")

$Prefix       = "From ";
$PrefixEscape = ">";

### vCard, vMessage ファイルの改行コード

$/ = "\n";


##############################
### メインルーチン
##############################

### 引数解析

for ( $i = 0; $i < $#ARGV; $i++ ){
	my $t = $ARGV[$i];
	if ( $t =~ /^(\-.+)/ ){
		$ARG{$1} = $ARGV[$i++ + 1];
	}
	else{
		$ARG{$t} = $t;
	}
}


### メール(vMessage)が入ったフォルダが指定されていない場合、使用方法
### を表示して終了。

die ( "usage: $0 -m MAIL_FOLDER [-a ADDRESS_FOLDER] [-f YOUR_ADDRESS]\n" ) unless ( $ARG{"-m"} );


### 引数に指定されたフォルダ名を、変数にセット。

( $Mail_Dir, $Addr_Dir ) = ($ARG{"-m"}, $ARG{"-a"});


### 引数に、自分のアドレスが指定されていた場合、変数にセット。

$My_Address = $ARG{"-f"} if ( $ARG{"-f"} );


### アドレス帳(vCard)フォルダが引数に与えられた場合、そのフォルダ内の
### vCard を読みに行く。　読み込んだ内容は、
###     $Name{メールアドレス} = 日本語氏名
### というハッシュに格納される。(日本語の漢字コードは JIS に変換されている)

if ( $Addr_Dir ){
	my @vcard = &read_dir( $Addr_Dir, $Ext_Addr ) =~ /BEGIN:VCARD?\r?\n(.+?)END:VCARD/sg;
	%Name  = map {
		my $re = $_;
		map { $_ => $re->{N}->[0] } @{$re->{EMAIL}};
	} grep { $_->{EMAIL} } &vcard2hash( @vcard );
}


### vMessage フォルダ内のメールを読みに行き、内容を解析する。

@Mails = &read_dir( $Mail_Dir, $Ext_Mail ) =~ /BEGIN:VBODY?\r?\n(.+?)END:VBODY/sg;

foreach $mail ( @Mails ){
	
	### 重複するメール(ヘッダ・内容が全く同一のメール)はスキップする。
	my $hash = md5_hex( $mail );
	$Exist{$hash}++ && next;

	### 各メールのヘッダを解析し、From:, To: の置換を行った後、標準出力に print。
	my @lines = split( /\n/, $mail );
	print "$Prefix\n";
	foreach ( @lines ){
		my $s;
		print /^To:\s*$/         ? "To: $My_Address\nX-Mailer: $My_Mailer" :
				/^To:\s*(.+)$/     ? "To: ".&get_name($1)."<$1>" :
				/^From:\s*$/       ? "From: $My_Address\nX-Mailer: $My_Mailer" :
				/^From:\s*(.+)$/   ? "From: ".&get_name($1)."<$1>" :
				/^$Prefix(.*)/     ? "${PrefixEscape}${Prefix}$1" :
				/^Subject:\s*(.+)/ ? &convert_subject( $1 ) :
				$_ , "\n";
	}
	print "\n";
}

### 終了

exit;


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


### 第一引数として与えられたフォルダにある、第二引数として与えられた拡張子を
### 持つすべてのファイルの内容を読み、一つの変数($data)につなぎ合わせて返す。
### フォルダが開けなかった場合、die。
### ファイルが開けなかったり読めなかった場合の処理は、sub read_file に依存。

sub read_dir{
	my ( $dir, $ext ) = @_;
	$dir =~ s/\/+$//;
	
	opendir( DIR, $dir ) || die( "Can't open $dir ($!)\n" );
	my @files = grep { /\.$ext$/i } readdir ( DIR );
	closedir( DIR );
	
	my $data;
	$data .= &read_file( "$dir/$_" ) foreach ( @files );
	
	$data;
}


### 第一引数として与えられたファイルの内容を読み、その内容を返す。
### ファイルが開けなかったり読めなかった場合、標準エラー出力にエラーメッセージ
### を出し、そのファイルはスキップして、ヌル文字列を返す。(die はしない)

sub read_file{
	my $file = shift;

	unless ( -e $file ){
		warn( "Cant't find $file. Skipped.\n");
		return;
	}
	
	open( FILE, $file ) || do {
		warn( "Can't open $file ($!). Skipped.\n" );
		return;
	};
	eval {
		flock( FILE, 5 ) || do {
			warn( "Can't read $file exclusively. Skipped.\n" );
			return;
		};
	};
	
	my $data;
	$data .= $_ while( <FILE> );

	close( FILE );

	$data;
}


### 引数として受け取った vCard の内容を、
###    $info{キー} = [値1, 値2, ... ]
### という形にして返す。引数は配列で、各要素が、vCard の内容そのもの。
### 戻り値も配列で、各要素は、%info への参照。

sub vcard2hash{
	my @data = @_;
	my @ret;

	foreach ( @data ){
		my %info;
		my @lines = split( /\n/ );
		foreach ( @lines ){
			my ( $item, $val ) = split( /:/, $_, 2);
			my ( $item_name, @opt ) = split( /;/, $item );
			
			$val =~ s/;//g if ( $item_name eq 'N' );

			$val = Jcode::convert(\$val, 'jis', 'sjis') if ( grep { /^CHARSET=SHIFT_JIS$/i } @opt );
			push (@{$info{$item_name}}, $val);
		}
		push ( @ret, \%info );
	}
	return @ret;
}


### 引数として与えられたメールアドレスに対応する氏名が %Name に
### セットされていた場合、その氏名を返す。
### %Name にセットされていない場合、ヌル文字列を返す。

sub get_name{
	return unless ( $Addr_Dir );

	my $addr = shift;
	return $Name{$addr} ? '"'.escape_jp( $Name{$addr} ).'" ' : "";
}


### 日本語文字列を、メールヘッダに付加できる形式に加工
### ( BASE64 化 + =?ISO-2022-JP?B? 付加)し、返す。

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

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


### Subject の日本語エスケープを、引数に応じて実施する。

sub convert_subject{
	my $in  = shift;
	my $ret = "Subject: ";
	
	$ret .= $ARG{"-s"} =~ /^no$/i ? $in : &escape_jp( Jcode::convert(\$in, 'jis', 'sjis') );
	
	$ret;
}