#!/usr/bin/perl

=pod

=head1 NAME

log2actor_new - Extract Actor ID from Amida''s log.

=head1 SYNOPSIS

    perl log2actor_new.pl [-mocp] [-t threadfile ]  amida.log

=head1 DESCRIPTION

Amidaのログファイル（非圧縮）を読み込み，
B<(index, caller_id, callee_id, callstack_depth, Filepointer)>を1行に空白区切りで標準出力へ出力する．
ファイル末尾２行にコメントアウトで要素数とイベント数をそれぞれ出力する．

# ATTENSION: 
#     object ID '0' is reserved for static method calls, and
#     object ID '-1' is reserved for root method of this execution trace.

=head1 OPTIONS

=item -t threadfile
 スレッド宣言文を別ファイルに書き出す（オリジナルの実行履歴そのものは操作しない）

=item -m

メソッド単位でIDを振る

=item -o

オブジェクト単位でIDを振る
デフォルトでこの単位である

=item -c

クラス単位でIDを振る

=item -p

パッケージ単位でIDを振る

=cut

use strict;
use Getopt::Std;

my $in_file;                 ## ファイル名
my @callstack = ();        ## コールスタック（要素はオブジェクトID）
##  トップに現在見ているオブジェクト（呼び出されクラス）のID，以下呼び出し元が底まで並ぶ．

my $objects = {};          ## ログ中の実際のオブジェクトIDと出力するIDのマップ
##  無名ハッシュへのリファレンス
##  $$objects{オブジェクトID} = 対応する出力ID
keys(%$objects) = 5000;    ## マップハッシュは5000要素まで
$$objects{"0"}=0;          ## static method calls

$callstack[0]=-1;          ## reserved for root method of this execution trace
my $line = 0;              ##index
my $linecounter = 0;

# コマンドラインオプション
my %options;
getopts('mocpt:', \%options);

if($options{"m"}){ delete $$objects{"0"};}
elsif($options{"o"}){}
elsif($options{"c"}){delete $$objects{"0"};}
elsif($options{"p"}){}

my $threadfile ="";
if($options{'t'}){ 
	$threadfile = $options{'t'};
	open( THREAD, ">$threadfile" ) or die "can't create threadfile : $!\n";
}

$in_file = shift(@ARGV);

# 引数不正
if (@ARGV >= 2) {
	exit(1);
}

## ファイルオープン
open(IN, "$in_file") or die "$in_file: $!";

##解析＆出力
my $currentFilepointer = tell(IN);
while (<IN>) {

##amida2.0 - 行頭削除:行番号取得
	if( /^\@/ ){
## (a) スレッド宣言文
		if( /^\@thread/ ){ 
			if($threadfile) { print THREAD "$_"; }
			next; 
		}  

		$_ =~ s/^\@\d+\s//;
		if( $_ =~ s/^(\d+)\sFrom\:\d+\s// ) {$line = $1 - 1; }  # ??
		if( $_ =~ s/^(\d+)\s// ) {$line = $1 - 1; }  # "@X NNN void jp.co.xxxx.class(XX).method(YY){" is NNNth
	}

## (b) オブジェクト終了行の場合
##      { オブジェクト終了は必ず行頭の「}」  
	if (/^}/) {
		pop @callstack;   ## 通常はスタックからオブジェクトIDを１つPOP
		$currentFilepointer = tell (IN);
## (c) 通常行＝関数呼び出しの場合
	} else {
## 出力準備
		my $id;
		my $orgID;
		$linecounter++;
		$line++;                        ## 出力index更新
		if($options{"m"}){
			/^[^\s]+ ([^\(]+)\(\d+\).([^\(]+)/; ## 呼出されるクラス名を$1,メソッド名を$2へ格納
			$orgID = $1 ."." . $2;                  ## クラス名.メソッド名
		}
		elsif($options{"c"}){
			/^[^\s]+ ([^\(]+)\(\d+\)/;    ## 呼出されるクラス名を$1へ格納
			$orgID = $1;
		}
		elsif($options{"p"}){
			/^[^\s]+ ([^\(]*)\.[^\(^.]+\(\d+\)/;    ## 呼出されるパッケージ名を$1へ格納
			if ( $1 eq "" ){$orgID = 0 }
			else {$orgID = $1;}
		}
		else{
			/^[^\s]+ [^\(]+\((\d+)\)/;      ## 行頭から半角スペース以外のものが１つ以上続いて，（型）
			## 半角スペースの後に括弧じゃないものが１つ以上続いて，（呼び出し先）
			## 「(」の後ろに数字が１つ以上続いて「)」で閉じてある．（オブジェクトID）
			## この括弧でくくられた数字を\1へ格納
			$orgID = $1;
		}

		if (exists $$objects{"$orgID"}) {   ## 既出のオブジェクトなら出力IDを取り出す
			$id = $$objects{"$orgID"};
		} else {                        ## 新出のオブジェクトなら出力IDを新規設定
			$id = scalar(keys %$objects);# + 1;
			$$objects{"$orgID"} = $id;
		}

##出力
		my $num = @callstack;
		print "$line $callstack[@callstack-1] $id $num $currentFilepointer\n";

		## このブロックオブジェクトをスタックへプッシュ
		push @callstack, $id;
	}
}
## 要素数を出力
my $amount = scalar(keys %$objects);
print "#Objects=$amount\n#MethodCalls=$linecounter\n";
close(IN);
if($threadfile){ close(THREAD); }

exit(0);
