#!/usr/bin/perl
# gtfixendian: GTOOL3 形式のファイルのバイトオーダーを変換する
# Copyright (C) TOYODA Eizi, 1999.  All rights reserved.

$VERBOSE = 1;		# -v オプションの数にしたがって増える
$IORD = undef;		# 入力のバイトオーダー: デフォルトは自動判定
$OORD = "L";		# 出力のバイトオーダー: デフォルトは現在の機械の形式

	# コマンドラインオプション解析
while ($_ = shift) {
	/^-v/ && ($VERBOSE++, next);
	/^-q/ && ($VERBOSE--, next);
	/^-i[bn]/ && ($IORD = "N", next);
	/^-i[lv]/ && ($IORD = "V", next);
	/^-o[bn]/ && ($OORD = "N", next);
	/^-o[lv]/ && ($OORD = "V", next);

	# 引数をファイルとみなして処理
	&convfile($_);
}
exit 0;

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

	local($rec, $ord);

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

	# 入力ファイル形式の決定
	if ($IORD) {
		$ord = $IORD;
		print "$fnam: (", &ByteOrder($ord), " assumed)\n" if $VERBOSE;
	} else {
		open($fnam, "<$fnam") || die "$fnam: cannot open for reading";
		$ord = &guessByteOrder($fnam);
		print "$fnam: ", &ByteOrder($ord), "\n" if $VERBOSE;
		close($fnam);
	}

	open($fnam, "+<$fnam") || die "$fnam: cannot open for writing";
	# ヘッダを読みとる毎に
	while ($rec = &readRewindRecord($fnam, $ord)) {
		# ヘッダはテキストなので変換の必要はなく書き出す
		&putRecord($fnam, $rec);
		# データ部の形式を判定
		$dfmt = &gtHeaderDFMT($rec);
		# データ部を読み、バイトオーダーを変換して書き出す
		($rec = &readRewindRecord($fnam, $ord))
			|| (warn("$fnam: broken record\n"), last);
		$xrec = &convRecord($rec, $ord, $dfmt);
		&putRecord($fnam, $xrec);
	}
	close($fnam);
}

sub gtHeaderDFMT {
	local($rec) = @_;
	substr($rec, 37 * 16, 16);
}

sub convRecord {
	local($rec, $iord, $dfmt) = @_;
	local($ifmt, $ofmt, @rec, $xrec);
	if ($dfmt !~ /^ *UR[48] *$/) {
		&msg("unknown data format `$dfmt': conversion skipped.\n");
		$xrec;
	}
	$ifmt = $ofmt = "L*";
	$ifmt =~ s/L/$iord/g;
	$ofmt =~ s/L/$OORD/g;
	&msg(" # conv dfmt=$dfmt, ifmt=$ifmt, ofmt=$ofmt:\n") if ($VERBOSE > 2);
	if ($dfmt =~ /UR4/) {
		@rec = unpack($ifmt, $rec);
		$xrec = pack($ofmt, @rec);
	} else {
		local($hi, $lo);
		@rec = unpack($ifmt, $rec);
		for ($i = 0; $i < @rec; $i += 2) {
			($rec[$i], $rec[$i + 1]) = ($rec[$i + 1], $rec[$i]);
		}
		$xrec = pack($ofmt, @rec);
	}
}

	# 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 (&readRecord($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 で
	# 与えなければならない。
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;
}

	# Fortran の UNFORMATTED/SEQUENTIAL 記録 $body をひとつ
	# $filehandle に書き出す。記録長のエンディアンは $OORD で決まる
sub putRecord {
	local($filehandle, $body) = @_;
	local($header, $telli);
	$header = pack("$OORD", length($body));
	$telli = tell $filehandle;
	print " write ", length($body), " bytes\n" if ($VERBOSE > 1);
	print $filehandle  ($header . $body . $header);
	seek($filehandle, 0, 1);
	($telli == tell $filehandle) && &msg("print does not advance fh");
}

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