20 use IO::Uncompress::Gunzip qw(gunzip $GunzipError); |
19 use IO::Uncompress::Gunzip qw(gunzip $GunzipError); |
21 |
20 |
22 use constant KiB => 1024; |
21 use constant KiB => 1024; |
23 use constant MiB => 1024 * KiB; |
22 use constant MiB => 1024 * KiB; |
24 use constant GiB => 1024 * MiB; |
23 use constant GiB => 1024 * MiB; |
25 use constant ME => basename $0; |
24 use constant ME => basename $0; |
26 |
25 |
27 sub find_data_dir; |
26 sub find_data_dir; |
28 |
27 |
29 MAIN: { |
28 MAIN: { |
30 |
29 |
31 Getopt::Long::Configure(qw(Bundling)); |
30 Getopt::Long::Configure(qw(Bundling)); |
32 GetOptions( |
31 GetOptions( |
33 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
32 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
34 "m|man" => sub { pod2usage(-verbose => 2, -exit => 0, |
33 "m|man" => sub { |
35 -noperldoc => system("perldoc -V 1>/dev/null |
34 pod2usage( |
36 2>&1")) }, |
35 -verbose => 2, |
37 ) and @ARGV == 2 or pod2usage; |
36 -exit => 0, |
|
37 -noperldoc => system( |
|
38 "perldoc -V 1>/dev/null |
|
39 2>&1" |
|
40 ) |
|
41 ); |
|
42 }, |
|
43 ) |
|
44 and @ARGV == 2 |
|
45 or pod2usage; |
38 |
46 |
39 my $idx = shift; |
47 my $idx = shift; |
40 my $dst = shift; |
48 my $dst = shift; |
41 my $blocksize = undef; |
49 my $blocksize = undef; |
42 my $data = find_data_dir($idx); |
50 my $data = find_data_dir($idx); |
43 |
51 |
44 open(my $fh => $idx); |
52 open(my $fh => $idx); |
45 { local $/ = ""; $_ = <$fh>; } |
53 { local $/ = ""; $_ = <$fh>; } |
46 /^format:\s*1$/m or die ME.": expected index format 1\n"; |
54 /^format:\s*1$/m or die ME . ": expected index format 1\n"; |
47 ($blocksize) = /^blocksize:\s*(\d+)/m or die ME.": no blocksize found\n"; |
55 ($blocksize) = /^blocksize:\s*(\d+)/m or die ME . ": no blocksize found\n"; |
48 |
|
49 |
56 |
50 my $out; |
57 my $out; |
51 if ($dst eq "-") { open($out => ">&STDOUT") } |
58 if ($dst eq "-") { open($out => ">&STDOUT") } |
52 else { open($out => ">", $dst) }; |
59 else { open($out => ">", $dst) } |
53 |
60 |
54 while (<$fh>) { |
61 while (<$fh>) { |
55 next if /^#/; |
62 next if /^#/; |
56 my ($blk, $hash, $path) = split; |
63 my ($blk, $hash, $path) = split; |
57 my ($in, $buffer); |
64 my ($in, $buffer); |
58 |
65 |
59 if (-f "$data/$path") { |
66 if (-f "$data/$path") { |
60 open($in => "$data/$path"); |
67 open($in => "$data/$path"); |
61 binmode($in); |
68 binmode($in); |
62 local $/ = \$blocksize; |
69 local $/ = \$blocksize; |
63 $buffer = <$in>; |
70 $buffer = <$in>; |
64 } |
71 } |
65 elsif (-f "$data/$path.gz") { |
72 elsif (-f "$data/$path.gz") { |
66 open($in => "$data/$path.gz"); |
73 open($in => "$data/$path.gz"); |
67 binmode($in); |
74 binmode($in); |
68 gunzip($in => \$buffer) |
75 gunzip($in => \$buffer) |
69 or die $GunzipError; |
76 or die $GunzipError; |
70 } |
77 } |
71 else { |
78 else { |
72 die ME.": Can't open $data/$path: $!\n"; |
79 die ME . ": Can't open $data/$path: $!\n"; |
73 } |
80 } |
74 print {$out} $buffer; |
81 print {$out} $buffer; |
75 close($in); |
82 close($in); |
76 } |
83 } |
77 close($out); |
84 close($out); |
78 close($fh); |
85 close($fh); |
79 } |
86 } |
80 |
87 |
81 sub find_data_dir { |
88 sub find_data_dir { |
82 for (my $dir = shift; $dir ne "/"; $dir = abs_path("$dir/..")) { |
89 for (my $dir = shift ; $dir ne "/" ; $dir = abs_path("$dir/..")) { |
83 return "$dir/data" if -d "$dir/data" and -d "$dir/idx"; |
90 return "$dir/data" if -d "$dir/data" and -d "$dir/idx"; |
84 } |
91 } |
85 die ME.": no data directory found!\n"; |
92 die ME . ": no data directory found!\n"; |
86 } |
93 } |
87 |
94 |
88 __END__ |
95 __END__ |
89 |
96 |
90 =head1 NAME |
97 =head1 NAME |