1#!/usr/bin/perl
2#
3# Seven Kingdoms: Ancient Adversaries
4#
5# Copyright 1997,1998 Enlight Software Ltd.
6# Copyright 2017 Jesse Allen
7#
8# This program is free software: you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation, either version 2 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program.  If not, see <http://www.gnu.org/licenses/>.
20#
21#
22
23use warnings;
24use strict;
25
26use FindBin;
27use lib $FindBin::Bin;
28
29use File::Spec;
30
31use dbf;
32
33if (@ARGV < 5) {
34	print "Usage: $0 ptr.dbf file.res input_dir filename_field ptr_field file_ext\n";
35	print "Puts all files defined by dbf in res. Input_dir must have all the files.\n";
36	exit 0;
37}
38my ($dbf_file, $res_file, $input_dir, $filename_field, $ptr_field, $ext) = @ARGV;
39if (!defined($ext)) {
40	$ext = '.ICN';
41}
42my $res_fh;
43
44my $dbf = dbf->read_file($dbf_file);
45if (!$dbf) {
46	print "Error: Unable to read $dbf_file\n";
47	exit 1;
48}
49my $filename_idx = $dbf->get_field($filename_field);
50if ($filename_idx < 0) {
51	print "Error: Invalid field '$filename_field'\n";
52	exit 1;
53}
54my $ptr_idx = $dbf->get_field($ptr_field);
55if ($ptr_idx < 0) {
56	print "Error: Invalid field '$ptr_field'\n";
57	exit 1;
58}
59my $records = $dbf->get_records();
60my %file_order;
61for (my $i = 0; $i < $records; $i++) {
62	my $buf;
63	my $bytes;
64	my $len;
65	my $filename = dbf::trim($dbf->get_value($i, $filename_idx));
66	if (!defined($filename)) {
67		print "Error: Can't read record $i for $filename_field\n";
68		next;
69	}
70	my $packed_ptr = $dbf->get_value($i, $ptr_idx);
71	if (!defined($packed_ptr)) {
72		print "Error: Can't read record $i for $ptr_field\n";
73		next;
74	}
75	my $ptr = unpack('L', $packed_ptr);
76	if (!defined($ptr)) {
77		print "Error: Can't extract $ptr_field pointer for record $i\n";
78		next;
79	}
80	$file_order{$ptr} = [$i, $filename];
81}
82if (!open($res_fh, '>', $res_file)) {
83	print "Error: Unable to open $res_file\n";
84	exit 1;
85}
86my @ptrs = sort {$a <=> $b} (keys(%file_order));
87my $offset = 0;
88for (my $i = 0; $i < @ptrs; $i++) {
89	my $record;
90	my $infile;
91	my $file;
92	my $size;
93	my $buf;
94	$record = $file_order{$ptrs[$i]};
95        $infile = File::Spec->catfile($input_dir, $record->[1]) . $ext;
96	if (! -f $infile) {
97		print "Error: No such file $infile, found in record $record->[0]\n";
98		exit 1;
99	}
100	if (!open($file, '<', $infile)) {
101		print "Error: Cannot open $infile\n";
102		exit 1;
103	}
104	$size = -s $infile;
105	if (read($file, $buf, $size) != $size) {
106		print "Error: Could not read $infile\n";
107		exit 1;
108	}
109	close($file);
110	print $res_fh pack('L', $size);
111	print $res_fh $buf;
112	$dbf->set_value($record->[0], $ptr_idx, pack('L', $offset));
113	$offset += $size + 4; # includes ptr
114}
115close($res_fh);
116$dbf->write_file("$dbf_file.new");
117
118exit 0;
119