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

use Strict;

#変数宣言
my %mapping_email_msgid;	#メッセージIDからメールアドレスを得るための対応ハッシュ
my %relation;				#レス関係の対応ハッシュ(2次元ハッシュ)
my $filename;				#引数に与えられたファイル名を保存する
my @allnode_orig;				#all member list
my %allnode;				#all member list
my $allnodefile = "allnode_sr.txt";		# file name of all member list
my $allnodecount = 3654;			#全ノード数
my @allnode_xyz;			#全ノードの座標軸，2次元配列

my %parentnum;				#親記事を作成した数

my $mailsplitter = '^From ';	#メールの区切りを示す正規表現


my $correspond_filename = '../email_translate.txt';		#アドレス対応関係ファイル
my %correspond;			#新旧のアドレス対応関係
my @old_list;			#元の.netファイルのリスト
my @new_list;			#新しい.netファイルのリスト
my %new_list_r;			#新しい.netファイルのリスト(ハッシュ)


#ここから
&readCorrespondence();		#関係ファイル読み込み
&remember();
&parse();					#parseする
#&listResult();				#関係一覧を表示(デバッグ用)
#&listResultForPajek();		#Pajek形式データとして出力
&listResultWithAllNodeForPajek_Sr();
exit;


################################################################################
#以下サブルーチン群

#===============================================================================
#	readCorrespondence
#		旧-新アドレス関係を読み込む
sub readCorrespondence {

	#関係ファイル読み込み
	open CORRESPOND, $correspond_filename or die "correspondence file open error : $correspond_filename.";
		while($line = <CORRESPOND>) {
			chomp $line;
			my ($old, $new) = split / /, $line;
			
			$correspond{$old} = $new;
			if($old eq $new) {
				push @new_list, $new;
				$new_list_r{$new} = $#new_list;
			}
		}
	close CORRESPOND;
}


#===============================================================================
#	remember
#		覚える
sub remember {
	open ALL, "$allnodefile" or die "allnode file open error.";
	while(<ALL>) {
		$_ =~ s/^ *(\d+) *\"(.*)\" *([\d\.]+) *([\d\.]+) *([\d\.]+)\n$/$1 $2 $3 $4 $5/g;	#"
		my ($i, $address, $x, $y, $z) = split / /;
		$allnode{"$address"} = $i;
		$allnode_orig[$i] = $address;
		$allnode_xyz[$i][0] = $x;
		$allnode_xyz[$i][1] = $y;
		$allnode_xyz[$i][2] = $z;
	}
	close ALL;
}


#===============================================================================
#	parse
#		mailboxをparseする
sub parse {
	my $from;				#差出人メールアドレス
	my $message_id;			#メッセージID
	my $in_reply_to;		#返信元メッセージID
	
	#データがファイルで与えられた場合、ファイルに出力するためファイル名を覚えておく
	if($ARGV[0]) {
		$filename = $ARGV[0];
	}
	
	while (<>) {
		#メールの区切りがあれば
		if ($_ =~ /$mailsplitter/) {
			
			#メールのレス関係をハッシュ変数に追加
			&addHash($from, $message_id, $in_reply_to);
			
			#reset
			$from = "";
			$message_id = "";
			$in_reply_to = "";
			
			next;
		}
		
		#Message-Id行であれば
		if ($_ =~ /^Message-Id:/i) {
			#メッセージIDを抽出
			$_ =~ s/^.+?([a-zA-Z0-9\.\-\_\$]+\@[a-zA-Z0-9\.\-\_]+).*$/$1/;
			$message_id = $_;
		}
		#In-Reply-To行であれば
		elsif ($_ =~ /^In-Reply-To:/i) {
			#返信元メッセージIDを抽出
			$_ =~ s/^.+?([a-zA-Z0-9\.\-\_\$]+\@[a-zA-Z0-9\.\-\_]+).*$/$1/;
			$in_reply_to = $_;
		}
		#From行であれば
		elsif ($_ =~ /^From:.+\@.+/i) {
			#メールアドレスを抽出
			$_ =~ s/^.+?([a-zA-Z0-9\.\-\_]+\@[a-zA-Z0-9\.\-\_]+).*$/$1/;
			$from = $_;
		}
		
	}
	&addHash($from, $message_id, $in_reply_to);
	
}


#===============================================================================
#	addHash
#		1つのメールのレス関係をハッシュに追加する
sub addHash {
	my ($from, $message_id, $in_reply_to) = ($_[0], $_[1], $_[2]);	#引数を変数に格納
	
	#最後の改行を取り除く
	chomp $from;
	chomp $message_id;
	chomp $in_reply_to;
	
	#Message-IDとメールアドレスをマッピングさせる
	$mapping_email_msgid{"$message_id"} = $correspond{$from};
	#print "mapped $message_id = $from\n";
	
	#レスメールの場合
	if ($in_reply_to) {
		#関係を追加
		$relation{$mapping_email_msgid{"$message_id"}}{$mapping_email_msgid{"$in_reply_to"}}++;
		#print "add ", $mapping_email_msgid{"$message_id"}, " -> ",
		#	$mapping_email_msgid{"$in_reply_to"}, "\n";
	}
	else {
		#親記事数をインクリメント
		$parentnum{$correspond{$from}}++;
	}
	
}


#===============================================================================
#	listResult
#		結果を一覧表示する
sub listResult {
	#関係一覧を表示
	#while ((my $key, my $value) = each %relation) {
	#	print "$key -> $value\n";
	#}
	foreach $firstkey (keys %relation) {
		while (my ($secondkey, $value) = each %{$relation{$firstkey}}) {
			print "$firstkey -> $secondkey : $value\n";
			#print "$firstkey\t$secondkey\t$value\n";
		}
	}
}


#===============================================================================
#	listResultForPajek
#		結果をPajek形式フォーマットで出力する
sub listResultForPajek {
	my $count;		#ノード数
	my %number;		#ノードメールアドレスとノード番号の対応
	my $fh;			#結果出力先ファイルハンドル
	my $fh_clu;		#パーティション出力用ファイルハンドル
	
	#ファイルが引数で与えられたら、そのファイル名に.netをつけて保存
	if ($filename) {
		open DATA, ">$filename.net" or die "cannot open savefile.";
		$fh = DATA;
		
		#パーティションファイル生成(引数がファイルで与えられた場合のみ)
		open CLU, ">$filename.clu" or die "cannot open partition savefile.";
		$fh_clu = CLU;
	}
	else {
		$fh = STDOUT;
	}
	
	
	#ノードデータ
	foreach (values %mapping_email_msgid) {
		#空白アドレスでなく、かつまだナンバリングしていなければ
		if ($_ ne "" && $number{"$_"} eq "") {
			#ナンバリングする
			$number{"$_"} = ++$count;
		}
	}
	print $fh "*Vertices $count\n";
	print $fh_clu "*Vertices $count\n" if ($fh_clu);
	
	#ノード番号でメールアドレスをソート
	my @vertices = sort {$number{$a} <=> $number{$b}} keys %number;
	foreach (@vertices) {
		print $fh "$number{$_} \"$_\"\n";
		if ($fh_clu) {
			if ($parentnum{$_}) {
				print $fh_clu "$parentnum{$_}\n";
			}
			else {
				print $fh_clu "0\n";
			}
		}
		#print $fh_clu "\n" if ($fh_clu);
	}
	
	#有向グラフデータ
	print $fh "*Arcs\n";
	foreach $firstkey (keys %relation) {
		while (my ($secondkey, $value) = each %{$relation{$firstkey}}) {
			if($firstkey ne "" && $secondkey ne "") {
				print $fh "$number{$firstkey} $number{$secondkey} $value\n";
			}
		}
	}
	
	if ($filename) {
		close $fh;
		print "output to $filename.net\n";
		close $fh_clu;
		print "output to $filename.clu\n";
	}
	
}


#===============================================================================
#	listResultWithAllNodeForPajek_Sr
#		結果をPajek形式フォーマットで出力する
sub listResultWithAllNodeForPajek_Sr {
	my %number;				#ノードメールアドレスとノード番号の対応
	my $fh;					#結果出力先ファイルハンドル
	my $fh_clu;				#パーティション出力用ファイルハンドル
	
	
	#ファイルが引数で与えられたら、そのファイル名に.netをつけて保存
	if ($filename) {
		open DATA, ">$filename+3_sr.net" or die "cannot open savefile.";
		$fh = DATA;
		
		#パーティションファイル生成(引数がファイルで与えられた場合のみ)
#		open CLU, ">$filename+3.clu" or die "cannot open partition savefile.";
#		$fh_clu = CLU;
	}
	else {
		$fh = STDOUT;
	}
	
	
	print $fh "*Vertices ", scalar(@new_list), "\n";
#	print $fh_clu "*Vertices $allnodecount\n" if ($fh_clu);
	
	for(my $i = 1; $i <= $#new_list + 1; $i++) {
		print $fh "$i \"", $allnode_orig[$i], "\" $allnode_xyz[$i][0] $allnode_xyz[$i][1] $allnode_xyz[$i][2]\n";
#		if ($fh_clu) {
#			if ($parentnum{$allnode_orig{$i}}) {
#				print $fh_clu "$parentnum{$allnode_orig{$i}}\n";
#			}
#			else {
#				print $fh_clu "0\n";
#			}
#		}
		#print $fh_clu "\n" if ($fh_clu);
	}
	
	
	#有向グラフデータ
	print $fh "*Arcs\n";
	foreach $firstkey (keys %relation) {
		while (my ($secondkey, $value) = each %{$relation{$firstkey}}) {
			if($firstkey ne "" && $secondkey ne "") {
				print $fh "$allnode{$firstkey} $allnode{$secondkey} $value\n";
			}
		}
	}
	
	if ($filename) {
		close $fh;
		print "output to $filename+3.net\n";
#		close $fh_clu;
#		print "output to $filename+3.clu\n";
	}
	
}

#eof