1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
#!/usr/bin/perl
#
# extract_d3pkg - extract Descent3 PKG files
# written by Jan Engelhardt, 2003-2007
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the WTF Public License version 2 or
# (at your option) any later version.
#
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;
}
}
|
