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