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