#!/usr/local/bin/perl -w 
# -*- perl -*-
######################################################################
# trntest.pl -- Simple program to test trn encode/decode
# Copyright (c) 2007 Tero Kivinen
# All Rights Reserved.
######################################################################
#         Program: trntest.pl
#	  $Source: /u/samba/nwn/bin/RCS/trntest.pl,v $
#	  Author : $Author: kivinen $
#
#	  (C) Tero Kivinen 2007 <kivinen@iki.fi>
#
#	  Creation          : 16:38 May 28 2007 kivinen
#	  Last Modification : 16:41 May 30 2007 kivinen
#	  Last check in     : $Date: 2007/05/30 15:20:08 $
#	  Revision number   : $Revision: 1.1 $
#	  State             : $State: Exp $
#	  Version	    : 1.43
#	  Edit time	    : 52 min
#
#	  Description       : Simple program to test trn encode/decode
#
#	  $Log: trntest.pl,v $
#	  Revision 1.1  2007/05/30 15:20:08  kivinen
#	  	Created.
#
#	  $EndLog$
#
#
#
######################################################################
# initialization

require 5.6.0;
package TrnTest;
use strict;
use Getopt::Long;
use File::Glob ':glob';
use Trn;
use TrnRead;
use TrnWrite;
use Time::HiRes qw(time);
use Pod::Usage;

$Opt::verbose = 0;

######################################################################
# Get version information

open(PROGRAM, "<$0") || die "Cannot open myself from $0 : $!";
undef $/;
$Prog::program = <PROGRAM>;
$/ = "\n";
close(PROGRAM);
if ($Prog::program =~ /\$revision:\s*([\d.]*)\s*\$/i) {
    $Prog::revision = $1;
} else {
    $Prog::revision = "?.?";
}

if ($Prog::program =~ /version\s*:\s*([\d.]*\.)*([\d]*)\s/mi) {
    $Prog::save_version = $2;
} else {
    $Prog::save_version = "??";
}

if ($Prog::program =~ /edit\s*time\s*:\s*([\d]*)\s*min\s*$/mi) {
    $Prog::edit_time = $1;
} else {
    $Prog::edit_time = "??";
}

$Prog::version = "$Prog::revision.$Prog::save_version.$Prog::edit_time";
$Prog::progname = $0;
$Prog::progname =~ s/^.*[\/\\]//g;

$| = 1;

######################################################################
# Read rc-file

if (defined($ENV{'HOME'})) {
    read_rc_file("$ENV{'HOME'}/.trntestrc");
}

######################################################################
# Option handling

Getopt::Long::Configure("no_ignore_case");

if (!GetOptions("config=s" => \$Opt::config,
		"verbose|v+" => \$Opt::verbose,
		"help|h" => \$Opt::help,
		"version|V" => \$Opt::version) || defined($Opt::help)) {
    usage();
}

if (defined($Opt::version)) {
    print("\u$Prog::progname version $Prog::version by Tero Kivinen.\n");
    exit(0);
}

while (defined($Opt::config)) {
    my($tmp);
    $tmp = $Opt::config;
    undef $Opt::config;
    if (-f $tmp) {
	read_rc_file($tmp);
    } else {
	die "Config file $Opt::config not found: $!";
    }
}

######################################################################
# Main loop

$| = 1;

my($i);

if (join(";", @ARGV) =~ /[*?]/) {
    my(@argv);
    foreach $i (@ARGV) {
	push(@argv, bsd_glob($i));
    }
    @ARGV = @argv;
}

foreach $i (@ARGV) {
    my($data, $t0);

    $t0 = time();
    if ($Opt::verbose) {
	print("Reading file $i...\n");
    }
    undef $/;
    open(FILE, "<$i") || die "Cannot open $i : $!";
    binmode(FILE);
    $data = <FILE>;
    close(FILE);
    if ($Opt::verbose) {
	printf("Read done, %g seconds\n", time() - $t0);
    }
    $t0 = time();
    if (substr($data, 0, 4) eq "NWN2") {
	# This is trn, trx or mdb file, unpack it
	my($trn, $j);

	$trn = TrnRead::read('data' => $data);
	printf("File $i, type = %s, version = %d.%02d\n",
	       $trn->file_type, $trn->version_major, $trn->version_minor)
	    if ($Opt::verbose > 1);
	printf("Resource count = %d\n", $trn->resource_count)
	    if ($Opt::verbose > 1);
	for($j = 0; $j < $trn->resource_count; $j++) {
	    printf("Filename = %04d.%s, type = %s, size = %d\n",
		   $j,
		   lc($trn->resource_type($j)),
		   $trn->resource_type($j),
		   $trn->resource_size($j))
		if ($Opt::verbose > 2);
	    check_resource($i . "[" . $j . "]." .
			   $trn->resource_type($j), 
			   $trn->resource_data($j));
	}
    } else {
	check_resource($i, $data);
    }
    if ($Opt::verbose) {
	printf("Test done, %g seconds\n", time() - $t0);
    }
}

exit 0;

######################################################################
# check_resource($name, $data)

sub check_resource {
    my($name, $data) = @_;
    my($res, $newdata, $newres, $type);

    $type = $name;
    $type =~ s/.*\.//g;
    $type = uc($type);
    $res = Trn::decode_resource($data);
    $newdata = Trn::encode_resource($res, $type);
    if (0) {
	open(FILE, ">dump.$type") || die "Cannot open dump.$type: $!";
	binmode(FILE);
	print(FILE $newdata);
	close(FILE);
    }
    $newres = Trn::decode_resource($newdata);
    delete $$res{'Compressed Length'};
    delete $$newres{'Compressed Length'};
    cmp_trn($name . ":", $res, $newres);
}

######################################################################
# cmp_trn($prefix, \%trn1, \%trn2);

sub cmp_trn {
    my($prefix, $trn1, $trn2) = @_;
    my($i);
    
    if (UNIVERSAL::isa($trn1, 'ARRAY') && UNIVERSAL::isa($trn2, 'ARRAY')) {
	if ($#$trn1 != $#$trn2) {
	    die "$prefix: array index numbers differ $#$trn1 vs $#$trn2";
	}
	for($i = 0; $i <= $#$trn1; $i++) {
	    cmp_trn($prefix . "[" . $i . "]", $$trn1[$i], $$trn2[$i]);
	    $i++;
	}
    } elsif (UNIVERSAL::isa($trn1, 'HASH') && UNIVERSAL::isa($trn2, 'HASH')) {
	my(%keys);
	foreach $i (keys %{$trn1}) {
	    $keys{$i} = 1;
	}
	foreach $i (keys %{$trn2}) {
	    if (!defined($keys{$i})) {
		die $prefix . "{$i}: trn1 does not have key $i";
	    }
	    $keys{$i}++;
	}
	foreach $i (keys %{$trn1}) {
	    if ($keys{$i} != 2) {
		die $prefix . "{$i}: trn2 does not have key $i";
	    }
	}
	foreach $i (sort keys %{$trn1}) {
	    cmp_trn($prefix . "/" . $i, $$trn1{$i}, $$trn2{$i});
	}
    } elsif (UNIVERSAL::isa($trn1, 'ARRAY') ||
	     UNIVERSAL::isa($trn2, 'ARRAY') ||
	     UNIVERSAL::isa($trn1, 'HASH') ||
	     UNIVERSAL::isa($trn2, 'HASH')) {
	die "$prefix: Trn1 and trn2 do not have same type: " .
	    "trn1 array = " . UNIVERSAL::isa($trn1, 'ARRAY') .
	    "trn2 array = " . UNIVERSAL::isa($trn2, 'ARRAY') .
	    "trn1 hash = " . UNIVERSAL::isa($trn1, 'HASH') .
	    "trn2 hash = " . UNIVERSAL::isa($trn2, 'HASH');
    } else {
	if (defined($trn1) && defined($trn2)) {
	    if ($trn1 ne $trn2) {
		if ($trn1 =~ /^[ -~]*$/ &&
		    $trn2 =~ /^[ -~]*$/) {
		    die "$prefix: Values does not match $trn1 vs $trn2";
		} else {
		    die "$prefix: Values does not match " .
			substr(unpack("H*", $trn1), 0, 1000) .  " vs " .
			substr(unpack("H*", $trn2), 0, 1000);
		}
	    }
	} elsif (defined($trn1) && !defined($trn2)) {
	    die "$prefix: Value in trn1 is defined, but trn2 is not";
	} elsif (!defined($trn1) && defined($trn2)) {
	    die "$prefix: Value in trn2 is defined, but trn1 is not";
	}
    }
}


######################################################################
# Read rc file

sub read_rc_file {
    my($file) = @_;
    my($next, $space);
    
    if (open(RCFILE, "<$file")) {
	while (<RCFILE>) {
	    chomp;
	    while (/\\$/) {
		$space = 0;
		if (/\s+\\$/) {
		    $space = 1;
		}
		s/\s*\\$//g;
		$next = <RCFILE>;
		chomp $next;
		if ($next =~ s/^\s+//g) {
		    $space = 1;
		}
		if ($space) {
		    $_ .= " " . $next;
		} else {
		    $_ .= $next;
		}
	    }
	    if (/^\s*([a-zA-Z0-9_]+)\s*$/) {
		eval('$Opt::' . lc($1) . ' = 1;');
	    } elsif (/^\s*([a-zA-Z0-9_]+)\s*=\s*\"([^\"]*)\"\s*$/) {
		my($key, $value) = ($1, $2);
		$value =~ s/\\n/\n/g;
		$value =~ s/\\t/\t/g;
		eval('$Opt::' . lc($key) . ' = $value;');
	    } elsif (/^\s*([a-zA-Z0-9_]+)\s*=\s*(.*)\s*$/) {
		my($key, $value) = ($1, $2);
		$value =~ s/\\n/\n/g;
		$value =~ s/\\t/\t/g;
		eval('$Opt::' . lc($key) . ' = $value;');
	    }
	}
	close(RCFILE);
    }
}


######################################################################
# Usage

sub usage {
    Pod::Usage::pod2usage(0);
}

=head1 NAME

trntest - Test trn encode decode

=head1 SYNOPSIS

trntest [B<--help>|B<-h>] [B<--version>|B<-V>] [B<--verbose>|B<-v>]
    [B<--config> I<config-file>]
    I<filename> ...

trntest B<--help>

=head1 DESCRIPTION

B<trntest> reads trn/trx/mdb etc file in, goes through each resource,
and decodes it to perl hash, and then reencodes it back to binary and
verifies we get same result we read in. 

=head1 OPTIONS

=over 4

=item B<--help> B<-h>

Prints out the usage information.

=item B<--version> B<-V>

Prints out the version information. 

=item B<--verbose> B<-v>

Enables the verbose prints. This option can be given multiple times,
and each time it enables more verbose prints. 

=item B<--config> I<config-file>

All options given by the command line can also be given in the
configuration file. This option is used to read another configuration
file in addition to the default configuration file. 

=back

=head1 EXAMPLES

    trntest 0000.trwh
    trntest *.trn *.trx *.mdb

=head1 FILES

=over 6

=item ~/.trntestrc

Default configuration file.

=back

=head1 SEE ALSO

trnprint(1), Trn(3), TrnWrite(3), and TrnRead(3).

=head1 AUTHOR

Tero Kivinen <kivinen@iki.fi>.

=head1 HISTORY

Sample program used while reverse engineering some of the resource
fields and making sure my routines can write back resources in same
format.