#!/usr/bin/perl
# gtmetrics: GTOOL3 形式のファイルの各種大きさを表示する
# Copyright (C) TOYODA Eizi, 1999.  All rights reserved.

$VERBOSE = 0;		# -v オプションの数にしたがって増える
$IORD = undef;		# 入力のバイトオーダー: デフォルトは自動判定

require 'getopts.pl' || die 'getopts.pl not found';

&Getopts('v:exyztadq');

$SHOW_ENDIAN = $opt_e;
$SHOW_X = $opt_x;
$SHOW_Y = $opt_y;
$SHOW_Z = $opt_z;
$SHOW_T = $opt_t;
$SHOW_DIMS = $opt_d;

$ALL_UNIT = $opt_a || $opt_t;


$options = $opt_x + $opt_y + $opt_z + $opt_t + $opt_e + $opt_d;
if ($options == 0) {
	die "one of options -x -y -z -t -e -d is needed\n";
} elsif ($options > 1) {
	die "options -x -y -z -t -e -d are mutually exclusive.\n";
}


$VERBOSE = $opt_v if defined $opt_v;
$VERBOSE = 0 if defined $opt_q;

	# コマンドラインオプション解析
while ($_ = shift) {
	# 引数をファイルとみなして処理
	&processFile($_);
}
exit 0;

	# $fnam を変換する
sub processFile {
	local($fnam) = @_;

	local($rec, $ord);

	# ファイルがないか、seek できない場合は困るよね
	(-e $fnam) || die "$fnam: not exists\n";
	(-f $fnam) || die "$fnam: not a regular file\n";

	# 入力ファイル形式の決定

	open($fnam, "<$fnam") || die "$fnam: cannot open for reading";
	if ($IORD) {
		$ord = $IORD;
		print "$fnam: (", &ByteOrder($ord), " assumed)\n" if $VERBOSE;
	} else {
		$ord = &guessByteOrder($fnam) || return 1;
		print "$fnam: ", &ByteOrder($ord), "\n" if $VERBOSE;
		print "$ord ", &ByteOrder($ord), "\n" if $SHOW_ENDIAN;
	}

	$tcount = 0;

	# ヘッダを読みとる毎に
	while ($rec = &readRecord($fnam, $ord)) {
		# 必要なら個々のヘッダごとの解析をして
		&analizeHeader($rec);

		# データ部を読み捨てる
		print "data:" if $VERBOSE > 1;
		($rec = &readRecord($fnam, $ord))
			|| (warn("$fnam: broken record\n"), last);
		$tcount++;
		last unless $ALL_UNIT;
	}
	close($fnam);

	print "$tcount\n" if $SHOW_T;
	0;
}

sub analizeHeader {
	local($rec) = @_;

	if ($SHOW_DIMS) {
		local($dims, $desc);
		local($a, $b) = &gtHeaderN($rec, 30, 31);
		$dims++, $desc = 'x' if ($a != $b);
		($a, $b) = &gtHeaderN($rec, 33, 34);
		$dims++, $desc .= 'y' if ($a != $b);
		($a, $b) = &gtHeaderN($rec, 36, 37);
		$dims++, $desc .= 'z' if ($a != $b);
		print "$dims $desc\n";
	}
	if ($SHOW_X) {
		print &gtHeaderN($rec, 30);
		print ' ';
		print &gtHeaderN($rec, 31);
		print "\n";
	}
	if ($SHOW_Y) {
		print &gtHeaderN($rec, 33);
		print ' ';
		print &gtHeaderN($rec, 34);
		print "\n";
	}
	if ($SHOW_Z) {
		print &gtHeaderN($rec, 36);
		print ' ';
		print &gtHeaderN($rec, 37);
		print "\n";
	}
}

sub gtHeaderN {
	local($rec, @loc) = @_;
	local($loc, @ans);
	foreach $loc (@loc) {
		push @ans, &gtHeader($rec, $loc) + 0;
	}
	wantarray ? @ans : $ans[0];
}

sub gtHeader {
	local($rec, $loc) = @_;
	$loc--;
	substr($rec, 16 * $loc, 16);
}

	# seek できる $filehandle から Fortran の UNFORMATTED/SEQUENTIAL
	# 記録を読みとり、バイトオーダーを推測する。
sub guessByteOrder {
	local($filehandle) = @_;
	local($hdr, $body, $nrecl, $vrecl, @olist, $ord);

	# 先頭4バイトを読みとる。これが記録長のはずだ
	local($telli) = tell $filehandle;
	read($filehandle, $hdr, 4) || return undef;
	seek($filehandle, $telli, 0) || return undef;

	# Big/Little Endian それぞれに記録長と解釈してうまくいけばあたり。
	# ちょっと野蛮な判定法だ....
	print " I will guess the byte order of $filehandle:\n" if $VERBOSE > 2;
	@olist = ("N", "V");

	$nrecl = unpack("N", $hdr);
	$vrecl = unpack("V", $hdr);

	# ヒューリスティックス その1
	# 最初の記録長は 16MB より小さいから、
	# 逆順で読むと大きくなる
	# (そうでないとメモリ不足で異常終了しやすい)
	@olist = ("V", "N") if ($nrecl > $vrecl);

	# GTOOL なら最初の記録長は 1024
	if (($nrecl != 1024) && ($vrecl != 1024)) {
		warn "$filehandle: cannot find record length:",
			" is this really GTOOL3 File?\n";
		return undef;
	}

	# トライ
	foreach $ord (@olist) {
		print " try ", &ByteOrder($ord), "\n" if $VERBOSE > 2;
		if (&readRewindRecord($filehandle, $ord)) {
			return $ord;
		}
	}
	warn "No record found in <filehandle>: is this really GTOOL3 File?\n";
	undef;
}

	# バイトオーダーのなまえ
sub ByteOrder {
	($_[0] eq "N"
		? "Network/Big-Endian byte order"
		: "Vax/x86/Little-Endian byte order");
}

	# readRecord と同じだが、読みとった後もとの位置に seek する
sub readRewindRecord {
	local($filehandle, $ord) = @_;
	local($telli, $body);

	$telli = tell $filehandle;
	$body = &readRecord($filehandle, $ord);
	seek($filehandle, $telli, 0);
	return $body;
}

	# Fortran の UNFORMATTED/SEQUENTIAL 記録をひとつ $filehandle
	# から読みとる。記録長を決めるのに必要なエンディアンは $ord で
	# 与えなければならない。
	# たとえ読み捨てる場合でも seek より効率がいい :(
sub readRecord {
	local($filehandle, $ord) = @_;
	local($recl, $hdr, $body, $tlr);
	read($filehandle, $hdr, 4) || return undef;
	$recl = unpack($ord, $hdr);
	print " read $recl bytes\n" if ($VERBOSE > 1);
	if (read($filehandle, $body, $recl)) {
		# if tailer exists and matches to header, its okay.
		if (read($filehandle, $tlr, 4)) {
			($hdr eq $tlr) && return $body;
		}
	}
	warn "unexpected eof in reading record\n";
	undef;
}

	# うっとうしそうなものは同じメッセージを複数回出さないようにする
sub msg {
	local($msg) = @_;
	return if ($msg{$msg});
	$msg{$msg}++;
	warn $msg;
}
