#!/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;
}
