#	メーリングリストのmboxアーカイブからレス関係を抽出するプログラム
#		author		yoji-o
#		first edit	2006-10-12
#		last edit	2007-11-15
#
#		◇入力
#			mbox形式のメールアーカイブ
#		◇出力
#			関係リスト、もしくは、Pajek形式データ
#
#		◇使用法
#			コマンドラインで、以下のコマンドをたたく(要 Perl 5 以上)
#			perl getRelation.pl [filename1,filename2,...]
#			
#		◇引数
#			filename1...	mboxファイル、指定しなければ標準入力から読み込む
#					複数指定した場合は、mboxをマージしてから読み込む
#

#use strict;
#use warnings;

#変数宣言
my $filename;			#引数に与えられたファイル名を保存する

my $mailsplitter = '^From ';	#メールの区切りを示す正規表現
my $mail_rexp = '[a-zA-Z0-9\.\-\_\+]+\@[a-zA-Z0-9\.\-\_]+';	#メールの正規表現
my $mid_rexp  = '[a-zA-Z0-9\.\-\_]+\@[a-zA-Z0-9\.\-\_]+';	#Message-Idの正規表現

#ここから
&parse();			#parseする
exit;


################################################################################
#parse
#	mailboxをparseする
sub parse {
	my $fromMail;		#差出人メールアドレス
	my $fromName;		#From行から抽出した名前
	my $message_id;		#メッセージID
	my $in_reply_to;	#返信元メッセージID
	my $flag = -1;
	
	#データがファイルで与えられた場合、ファイルに出力するためファイル名を覚えておく
	if($ARGV[0]) {
		$filename = $ARGV[0];
	}

	while (<>) {

		#前処理
		#改行除去
		chomp $_;
		#スパム対策メールアドレス偽装を解除
		$_ =~ s/ at /@/ig;

		#以下はゴミ処理
		#「"」を除去
		$_ =~ s/"//g;
		#「%」を除去
		$_ =~ s/%//g;
		#末尾のスペースを除去
		$_ =~ s/\s*$//; # 後方一致
		#末尾の「,」の除去
		$_ =~ s/,+$//;
		# 連続する<または>の除去
		$_ =~ s/<+/</g;
		$_ =~ s/>+/>/g;
		#↓以下の2つの処理については注意が必要．全期間のMLを目視で確認(byまえし)したところ" >，] "が名前の中で使われていたりした事例は
		#　なく，以降にゴミが多く見受けられたので思い切って切り捨てました．前よりかはむしろメールアドレスの抽出の精度が上がったと思います
		#　")"についてはML(主にApache)によってはFrom行の名前の中でも利用されることがあるので，ここでは処理しません
		#　※以下の2つの処理は，Apache・GIMP・Netscapeを対象にした場合に有効と考えてください（その場限りの対処の仕方で申し訳ありませんm(_ _)m）
		# 「>」以降を除去
		$_ =~ s/>.*/>/;
		# 「]」以降を除去
		$_ =~ s/].*/]>/;
		# 末尾の =20 または =0D の削除	※" >，] "以降を除去しているので，この部分は不要かもしれない
		$_ =~ s/(\=20)$|(\=0D)$//;

		#メールの区切りがあれば
		if ($_ =~ /$mailsplitter/) {
			#Fromから始まる1つのメールの履歴から，Message-Id，In-Reply-To，From行にある名前(formName)とメールアドレス(formMail)が
			#抽出できればメールのレス関係をハッシュ変数に追加
			unless($flag == 0 || $flag == -1) {
			}
			
			#reset
			$fromMail = "";
			$fromName = "";
			$message_id = "";
			$in_reply_to = "";
			$flag = -1;
			
			next;
		}

		#Message-Id行であれば
		if ($_ =~ /^Message-Id:/i) {
			#メッセージIDを抽出
			$_ =~ s/^(.*?)\s*($mid_rexp)/$2/;
			# message-idの形式に適したデータが入っているか確認する　※Null値や形式に適さないゴミは無視
			if($2 ne ""){
				#Apache,GIMPのmessage_idの多くは < > で囲まれているため
				$_ =~ s/<//;
				$_ =~ s/>//;
				$message_id = $_;
			}
		}

		#In-Reply-To行であれば
		elsif ($_ =~ /^In-Reply-To:/i) {
			#返信元メッセージIDを抽出
			$_ =~ s/^(.*?)\s*($mid_rexp)/$2/;
			# in-reply-toの形式に適したデータが入っているか確認する　※Null値や形式に適さないゴミは無視
			if($2 ne ""){
				#Apache,GIMPのin_reply_toの多くは < > で囲まれているため
				$_ =~ s/<//;
				$_ =~ s/>//;
				$in_reply_to = $_;
			}
		}

		#From行であれば
		if ($_ =~ /^From:.+\@.+/i) {
			#メールアドレスを抽出
			#rogi algorithm(too bad)
			#$_ =~ s/^.+?($mail_rexp).*$/$1/;

			#From：の部分の除去
			$_ =~ s/^From:(\s*\t*)?//i;

			#「 at 」を「@」に変更	※特にGIMPで多く見受けられる
			$_ =~ s/ at /\@/;

			#名前＋<メールアドレス>　の形式についての処理　※主にApache？
			#標準形  "Yamamoto Taro <ytaro@aa.com>"
			if ($_ =~ /^(.+?)\s*<($mail_rexp)>/) { 
				$flag = 1;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*<($mail_rexp)>/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*<($mail_rexp)>/$2/;
			}
			#FromName の不足 "<ytaro@aa.com>"
			elsif ($_ =~ /^<($mail_rexp)>/){
				$flag = 2;
				$fromName = "";
				$fromMail = $_;
				$fromMail =~ s/^<($mail_rexp)>/$1/;
			}
			#$FromName の不足＋<>の不足 "ytaro@aa.com"
			elsif ($_ =~ /^($mail_rexp)$/) {
				$flag = 3;
				$fromName = "";
				$fromMail = $_;
				$fromMail =~ s/^($mail_rexp)$/$1/;
			}
			#mailto形式 "Yamamoto Taro [mailto:ytaro@aa.com]"
			elsif ($_ =~ /^(.+?)\s*\[mailto:\s*($mail_rexp)\]/) {
				$flag = 4;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*\[mailto:\s*($mail_rexp)\]/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*\[mailto:\s*($mail_rexp)\]/$2/;
				#原因はよく分からないけどfromName，formMailともに末に > がついてしまう(？)ので除去
				$fromName =~ s/>//;
				$fromMail =~ s/>//;
			}

			#名前＋(メールアドレス)　の形式についての処理　※主にGIMP？
			#標準形 "Yamamoto Taro (ytaro@aa.com)"
			elsif ($_ =~ /^(.+?)\s*\(($mail_rexp)\)$/) { 
				$flag = 5;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*\(($mail_rexp)\)$/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*\(($mail_rexp)\)$/$2/;
			}
			#標準形の逆パターン(アドレスが先) "ytaro@aa.com (Yamamoto Taro)"
			elsif ($_ =~ /^($mail_rexp)\s*\((.*)\)$/) { 
				$flag = 6;
				$fromName = $_;
				$fromName =~ s/^($mail_rexp)\s*\((.*)\)$/$2/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^($mail_rexp)\s*\((.*)\)$/$1/;
			}
			#mailto形式+<>表記 "Yamamoto Taro <mailto:ytaro@aa.com>"
			elsif ($_ =~ /^(.+?)\s*<mailto:\s*($mail_rexp)>/) {
				$flag = 7;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*<mailto:\s*($mail_rexp)>/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*<mailto:\s*($mail_rexp)>/$2/;
			}
			#htmlの "a class" 表記
			elsif ($_ =~ /^(.+?)\s*\[*<a class\=.* href\=mailto:($mail_rexp)>/) {
				$flag = 8;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*\[*<a class\=.* href\=mailto:($mail_rexp)>/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*\[*<a class\=.* href\=mailto:($mail_rexp)>/$2/;
			}
			#SMTP形式 "Yamamoto Taro [SMTP:ytaro@aa.com]"		※ろぎが追加した新しい条件その1
			elsif ($_ =~ /^(.+?)\s*\[SMTP:\s*($mail_rexp)\]/) {
				$flag = 9;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*\[SMTP:\s*($mail_rexp)\]/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*\[SMTP:\s*($mail_rexp)\]/$2/;
				#原因はよく分からないけどfromName，formMailともに末に > がついてしまう(？)ので除去
				$fromName =~ s/>//;
				$fromMail =~ s/>//;
			}
			#名前+<+(名前)表記  "Yamamoto Taro <ytaro@aa.com (Yamamoto Taro)"		※ろぎが追加した新しい条件その2
			#メールアドレスが< >で閉じていない場合で，かつ，再度名前が出てくる場合
			elsif ($_ =~ /^(.+?)\s*<($mail_rexp)\s*\(.+?\)$/) { 
				$flag = 10;
				$fromName = $_;
				$fromName =~ s/^(.+?)\s*<($mail_rexp)\s*\(.+?\)$/$1/;
				$fromName =~ s/\\//g;
				$fromName =~ s/\.+//g;
				$fromName =~ s/\s+/\s/g;
				$fromName =~ s/\s*$//;
				$fromMail = $_;
				$fromMail =~ s/^(.+?)\s*<($mail_rexp)\s*\(.+?\)$/$2/;
			}
			#その他のゴミ　もしくは抽出しきれなかったもの
			else {
				$flag = 0;
			}

			#後処理(この辺の正規表現はもう一度チェックしたほうがいい)
			#記号の削除
			$fromName =~ s/"|,|'//g; #need more check
			#ISO 等の文字列削除
			#↑それほど大きな問題でもないので今はスルー
			if ($fromName =~ /^\=/) { # 文字エンコード系
				$fromName =~ s/\=*\?\=$//; # 文末の ?= を削除
				$fromName =~ s/^\=.+\?//g; # コード指定を削除
				$fromName =~ s/\=\w\w//g;  # 特殊文字の削除
				$fromName =~ s/\= //g;  # 特殊文字の削除
				$fromName =~ s/\_/ /g; # アンダーバーをスペースに
				#↑これどういう場合に使われるのだろう・・・
				#連続するスペースの削除
				$fromName =~ s/\s+/ /g;
			}
			#さらに記号の削除 (ISO等の文字を削除後に残るごみを削除する)
			$fromName =~ s/\(|\)|\-|\=|\*|//g;

			# このプログラムで重要なとこ　participantsの名前とメールアドレスだけを取得するだけ
			if($flag ne 0){
				$fromName = lc($fromName);
				$fromMail = lc($fromMail);
				print $fromMail,"\t",$fromName,"\n";
			}

		}
		
	}
}

#eof