69 lines
1.7 KiB
Perl
Executable File
69 lines
1.7 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
# SPDX-License-Identifier: MIT
|
|
#
|
|
# extract_d3pkg - extract Descent3 PKG files
|
|
# written by Jan Engelhardt, 2003-2007
|
|
|
|
use Getopt::Long;
|
|
use strict;
|
|
do (($0 =~ m{^(.*)/})[0] || ".")."/shared.pm" ||
|
|
die "Could not load shared.pm: $!\n";
|
|
|
|
my $ex_out_dir = ".";
|
|
my $ex_archive_file = "-";
|
|
my $ex_auto_lower = 0;
|
|
my $ex_verbose = 0;
|
|
|
|
Getopt::Long::Configure(qw(bundling));
|
|
GetOptions(
|
|
"C=s" => \$ex_out_dir,
|
|
"L" => \$ex_auto_lower,
|
|
"f=s" => \$ex_archive_file,
|
|
"v" => \$ex_verbose,
|
|
);
|
|
|
|
&main();
|
|
|
|
sub main ()
|
|
{
|
|
local(*IN, *OUT);
|
|
|
|
open(IN, "< $ex_archive_file") ||
|
|
die "Could not open $ex_archive_file: $!\n";
|
|
binmode IN;
|
|
if (&getcf(\*IN, 4) ne "GKPO") {
|
|
die "Not a GKPO file\n";
|
|
}
|
|
|
|
my $num_entries = unpack("V", &getcf(\*IN, 4));
|
|
if ($ex_verbose) {
|
|
print "$num_entries files in archive\n";
|
|
}
|
|
|
|
for (my $i = 0; $i < $num_entries; ++$i) {
|
|
my $dir_len = unpack("V", &getcf(\*IN, 4));
|
|
my $dir_name = unpack("Z*", &getcf(\*IN, $dir_len));
|
|
$dir_name =~ s{\\}{/}go;
|
|
my $file_name_len = unpack("V", &getcf(\*IN, 4));
|
|
my $file_name = unpack("Z*", &getcf(\*IN, $file_name_len));
|
|
my $file_size = unpack("V", &getcf(\*IN, 4));
|
|
my $u1 = unpack("V", &getcf(\*IN, 4));
|
|
my $u2 = unpack("V", &getcf(\*IN, 4));
|
|
|
|
# there seems to be always a trailing slash in the dir_name
|
|
if ($ex_verbose) {
|
|
print "$dir_name$file_name ($file_size bytes)\n";
|
|
}
|
|
|
|
my $abs_file = "$ex_out_dir/$dir_name/$file_name";
|
|
&mkdir_p_stripbase($abs_file);
|
|
# sometimes needed?
|
|
# seek(IN, $filesize, 1);
|
|
open(OUT, "> $abs_file") ||
|
|
warn "Could not write to $abs_file: $!\n";
|
|
binmode OUT;
|
|
&transfer(\*OUT, \*IN, $file_size);
|
|
close OUT;
|
|
}
|
|
}
|