#!/usr/local/bin/perl


if( $ARGV[0] eq '-n' ){			# デバッグオプション
    $DEBUG = 1;
    shift @ARGV;
}
( @ARGV==1 )&&( -e $ARGV[0] )||die <<'__EOF__';

NAME
     texinfo.perl -   Next,Prev,Up の指定が欠けている @node 行を
                      補完する Perl script

SYNOPSIS
     texinfo.perl [-n] file

DESCRIPTION
     Next,Prev,Up の指定が欠けている @node 行を、@menu による木構造
     を仮定して補完する Perl script
     
     Top node を含んでいる Texinfo source file を指定して実行する。
     node 間の参照関係の検出およびファイルの書き換えの記録は、標準
     エラー出力に出力される。

     -n オプションを指定すると、実際のファイル書き換えは行わず、書き
     換えた結果を標準出力に出力する。

RULE
     補完規則は次の通り。同じ優先順位の補完規則が現れた場合、先に現
     れた参照関係が優先する。
       (1) Next が欠けている場合
             a) 上位の menu で次に並んでいる node
             b) 次に検出された node
       (2) Prev が欠けている場合
             a) 上位の menu で前に並んでいる node
             b) 直前に検出された node
       (3) Up が欠けている場合
             a) 上位の node (menu の要素として参照している node)
             b) 相互参照(@xref など)によって参照している node

KNOWN BUGS
     相互参照による @node 行の補完は不適切な補完である場合が多く、
     手作業での書き換えが必要。
     file に現れた順序と、info としての構造が全く異なっている場合、
     適切な補完は不可能である。

__EOF__



push( @files,$ARGV[0] );
$current='(DIR)';
$file_prev{'Top'} = '(DIR)';
$menu_up{'Top'}   = '(DIR)';
$menu="";


# 全てのファイルを読み込み参照関係を抽出する
warn "Start analysis of references ...\n";
for $file ( @files ){
    unless( open( FILE,"< $file" ) ){
	warn "Can't open $file";
	next;
    }
    warn "Reading $file ...\n";
    my( @lines )=<FILE>;
    close FILE;
    for( @lines ){
	if( /^\@node[ \t]+(\S.*)$/ ){	# @node 行を検出
	    warn "  $_";
	    local( $this,$next,$prev,$up )=split(/[ \t]*,[ \t]*/,$1);
	    $file_next{$current} = $this;
	    $file_prev{$this}    = $current;
	    $current             = $this;
	    push( @node,$this );
	} elsif( /^\@menu/ ){		# @menu 行を検出
	    $menu = $current;
	} elsif( /^\@end[ \t]+menu/ ){	# menu の終りを検出
	    if( $menu_next{$current} ){
		$menu_next{$menu} = $menu_next{$current};
	    }else{
		warn "    Warning: Can't find next menu item for $current\n" if $current ne 'Top';
	    }
	    $menu = "";
	} elsif( $menu &&( /^\*[ \t]+([^:]+)::/ || /^\*[ \t]+[^:]+:[ \t]*([^\.]+)\./ )){
	    if(( $menu_up{$1} eq '' )||( $menu_up{$1} eq 'Top' )){
		warn "    menu item -> $1\n";
		$menu_next{$menu} = $1 if $menu ne $current;
		$menu_prev{$1}    = $menu;
		$menu_up{$1}      = $current;
	    }else{
		warn "    menu item -> $1 is found. But ignored.\n";
	    }
	    $menu = $1;
	} elsif( /\@(x|px|info)*ref\{([^\}]+)\}/ ){ # 相互参照を検出
	    warn "    reference -> $2 ($1ref)\n";
	    $xref{$2} = $current unless $xref{$2};
	} elsif( /^\@include[ \t]+(\S.*)$/ ){
	    warn "    include file = $1\n";
	    push( @files,$1 );
	}
    }
}
    


# ファイルを書き換える
warn "\nStart rewriting ...\n";
for $file ( @files ){
    unless( open( FILE,"< $file" ) ){
	warn "Can't open $file";
	next;
    }
    my( @lines )=<FILE>;
    close FILE;
    if( $DEBUG==0 ){
	( -e "$file~" )&& unlink( "$file~" ) || warn "Can't unlink old backup file : $file\n";
	( link( $file,"$file~" ) & unlink( $file ) )||warn "Can't make backup file : $file\n";
	unless( open( FILE,"> $file" ) ){
	    warn "Can't open $file";
	    next;
	}
	select FILE;
	warn "Rewrite $file ...\n";
    }
    for( @lines ){
	if( /^\@node[ \t]+(\S.*)$/ ){	# @node 行を検出
	    warn "  $_";
	    local( $this,$next,$prev,$up )=split(/[ \t]*,[ \t]*/,$1);
	    unless( $up ){
		if( $menu_up{$this} ){
		    $up = $menu_up{$this};
		    warn "    Up   = \"$up\" (menu item)\n";
		}elsif( $xref{$this} ){
		    $up = $xref{$this};
		    warn "    Up   = \"$up\" (cross reference)\n";
		}else {
		    $up = 'Top';
		    warn "    Up   = \"Top\" (forced)\n";
		}
	    }
	    unless( $next ){
		if( $menu_next{$this} ){
		    $next = $menu_next{$this};
		    warn "    Next = \"$next\" (menu item)\n";
		}elsif( $file_next{$this} ){
		    $next = $file_next{$this};
		    warn "    Next = \"$next\" (file sequence)\n";
		}elsif( $up ne 'Top' ){
		    $next = 'Top';
		    warn "    Next = \"Top\" (forced)\n";
		}else{
		    warn "    Next = nil\n";
		}
	    }
	    unless( $prev ){
		if( $menu_prev{$this} ){
		    $prev = $menu_prev{$this};
		    warn "    Prev = \"$prev\" (menu item)\n";
		}elsif( $file_prev{$this} ){
		    $prev = $file_prev{$this};
		    warn "    Prev = \"$prev\" (file sequence)\n";
		}else{
		    $prev = 'Top';
		    warn "    Prev = \"Top\" (forced)\n";
		}
	    }
	    print "\@node $this, $next, $prev, $up\n";
	} else {
	    print;
	}
    }
    if( $DEBUG==0 ){
	close FILE;
	select STDOUT;
    }
}