#!/usr/local/bin/perl

##################################################################
# 96/02/14 堀之内武
# 
# タグファイル（デフォルトは./TAGS）を使ってフォートランのプログラ
# ムのツリー構造を解析する。タグファイルに記述されているファイルを
# 再帰的に調べる
#
# 引数＝調べたいプログラムのあるファイル名。これを省略して標準入力
# から読み込むこともできるので、ファイル中の二番め以降の副プログラ
# ムを調べたい場合は tail + を使って標準入力から流し込め。
# あるサブルーチンを調べるには標準入力で call hogehoge(RET)とする
#
# CALL された副プログラムを再帰的に調べて表示する。呼出しの深さを
# 行頭に表示しインデントをつける。
##################################################################

# コマンド名取得

($progname) = ($0 =~ m#([^/]+)$#);    # コマンド名

# デフォルト指定

$tagfile = "TAGS";
$fukasa  = 0;

# オプション解析

require 'getopts.pl';   # オプション解析ライブラリ
if(! &Getopts('vt:e:f:n:')){
    select(STDERR);
    print " Usage: $progname [-v] [-t tag_file] [-e pattern] [-f file] [Fortranfile]  \n";
    exit(0);
}

$tagfile = $opt_t if $opt_t;  # TAGファイル
$exclude = $opt_e if $opt_e;  # ここで指定した副プログラムはトレースしない
                              # perlの正規表現 ∴ -e"^sg|msgdmp"などとできる
$excludefile = $opt_f if $opt_f; # 無視する副プログラムのリストをファイルで与
                     # える。スペースまたは改行で区切る。例: ^sg msgdmp ^rewn
$fukasa  = $opt_n if $opt_n;  # 呼び出しの深さ(直接には指定する必要なし。
                    	      # プログラム内での再帰呼出し時に使われる)
$verbose = $opt_v;            # verbose

# 準備

$| = 1; # バッファリングしない

$fukasa  = $fukasa + 1; # (再帰)呼出しの深さ
for ( $i = 1 ; $i < $fukasa ; $i++ ) {
    $head =~ s/^/  /;
}

$opts = "-t $tagfile" ; # 再帰呼出しに渡すオプション(-n以外)
$opts = "$opts -v" if $verbose;
$opts = "$opts -e \'$exclude\'" if $exclude;
$opts = "$opts -f $excludefile" if $excludefile;

if ($excludefile){ # 無視する副プログラムのリストを読み込み$excludeに加える
    $exclude =~ s/$/\|/ if $exclude;
    open (EXCL,"<$excludefile");
    while($line = <EXCL>) {
	if ( !($line =~ s/^\s+$//) ){
	    $line =~ s/^\s+(.*)\n/$1/;
	    $line =~ s/\s*$/\|/;
	    $line =~ s/\s+/\|/g;
	    $exclude =~ s/$/$line/;
	}
    }
    $exclude =~ s/\|$//;
}

$exclude =~ s/\^/ /g; # 副プログラム名の先頭はスペースで認識する

# メインループ

$returncalled = 0;

while(<>) {
    if (/^ *CALL\s+(\w+)/i && ( !$exclude || !/$exclude/i ) ) {
	$subprogram = $1;
	s/^ */      /;
	if ($fukasa == 1) {print "\n";}
	print "$fukasa$head$_";
	open (TAGS,"<$tagfile");
	$mitukatta  = 0;
	while($line = <TAGS>){
	    $line =~ s/,/  /;
	    $file = $1 if $line =~ /^(\S+)/;  #ファイル名は行頭にスペースなし
	    if ($line =~ /\s+$subprogram/i){
		$mitukatta = 1;
	        $line =~ s/^.*$subprogram//i ;
		$line =~ /(\d+)[^\d]+/;
		print "$fukasa$head        $file:\n" if $verbose;
 		open (RECURSIVE,"tail +$1 $file | $progname $opts -n $fukasa |");
		while(<RECURSIVE>){ print $_; }
		last;
	    }
	}
	if ( $verbose && !$mitukatta ) { print "$fukasa$head      \* $subprogram not found\n";}
    }
    elsif (/^ *END$/i || $returncalled && /^ *ENTRY/i) {
	exit(0); # END文、またはRETURN文の後のENTRY文があらわれたら終わり
    }
    elsif (/^ *PROGRAM|^ *SUBROUTINE|^ *ENTRY/i) {
	print "$fukasa$head$_";
    }
    if (/^ *RETURN$/i) { $returncalled = 1; }
}