#
#	メーリングリストのmboxアーカイブからレス関係を抽出するプログラム
#		author	yoji-o
#		date	2006-10-12 ~ 2006-12-07
#
#		◇入力
#			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 %parentnum;				#親記事を作成した数

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


#ここから
&parse();					#parseする
#&listResult();				#関係一覧を表示(デバッグ用)
&listResultForPajek();		#Pajek形式データとして出力
exit;


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

#===============================================================================
#	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"} = $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{"$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";
	}
	
}

#eof