|
1 #! /usr/bin/perl |
|
2 # Eigentlich geht das selbe mit: |
|
3 # grep '^[[:space:]]*[[:digit:]]' IDX-file | tr -d | cut -f4 -d' ' | while read f; do |
|
4 # cat DATA/$f || zcat DATA/$f.gz |
|
5 # done |
|
6 # ODER |
|
7 # perl -ne '/^\s*\d/ and print "DATA/" . (split)[2] . "\n"' IDX-File | while read f; do |
|
8 # cat DATA/$f || zcat DATA/$f.gz |
|
9 # done |
|
10 |
|
11 |
|
12 use 5.010; |
|
13 use strict; |
|
14 use warnings; |
|
15 use File::Basename; |
|
16 use Cwd qw(abs_path); |
|
17 use autodie qw(:all); |
|
18 use Pod::Usage; |
|
19 use Getopt::Long; |
|
20 use IO::Uncompress::Gunzip qw(gunzip $GunzipError); |
|
21 |
|
22 use constant KiB => 1024; |
|
23 use constant MiB => 1024 * KiB; |
|
24 use constant GiB => 1024 * MiB; |
|
25 use constant ME => basename $0; |
|
26 |
|
27 sub find_data_dir; |
|
28 |
|
29 MAIN: { |
|
30 |
|
31 Getopt::Long::Configure(qw(Bundling)); |
|
32 GetOptions( |
|
33 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
|
34 "m|man" => sub { pod2usage(-verbose => 2, -exit => 0, |
|
35 -noperldoc => system("perldoc -V 1>/dev/null |
|
36 2>&1")) }, |
|
37 ) and @ARGV == 2 or pod2usage; |
|
38 |
|
39 my $idx = shift; |
|
40 my $dst = shift; |
|
41 my $blocksize = undef; |
|
42 my $data = find_data_dir($idx); |
|
43 |
|
44 open(my $fh => $idx); |
|
45 { local $/ = ""; $_ = <$fh>; } |
|
46 /^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"; |
|
48 |
|
49 |
|
50 my $out; |
|
51 if ($dst eq "-") { open($out => ">&STDOUT") } |
|
52 else { open($out => ">", $dst) }; |
|
53 |
|
54 while (<$fh>) { |
|
55 next if /^#/; |
|
56 my ($blk, $hash, $path) = split; |
|
57 my ($in, $buffer); |
|
58 |
|
59 if (-f "$data/$path") { |
|
60 open($in => "$data/$path"); |
|
61 binmode($in); |
|
62 local $/ = \$blocksize; |
|
63 $buffer = <$in>; |
|
64 } |
|
65 elsif (-f "$data/$path.gz") { |
|
66 open($in => "$data/$path.gz"); |
|
67 binmode($in); |
|
68 gunzip($in => \$buffer) |
|
69 or die $GunzipError; |
|
70 } |
|
71 else { |
|
72 die ME.": Can't open $data/$path: $!\n"; |
|
73 } |
|
74 print {$out} $buffer; |
|
75 close($in); |
|
76 } |
|
77 close($out); |
|
78 close($fh); |
|
79 } |
|
80 |
|
81 sub find_data_dir { |
|
82 for (my $dir = shift; $dir ne "/"; $dir = abs_path("$dir/..")) { |
|
83 return "$dir/data" if -d "$dir/data" and -d "$dir/idx"; |
|
84 } |
|
85 die ME.": no data directory found!\n"; |
|
86 } |
|
87 |
|
88 __END__ |
|
89 |
|
90 =head1 NAME |
|
91 |
|
92 catter - cats the blocks of the imager |
|
93 |
|
94 =head1 SYNOPSIS |
|
95 |
|
96 catter {idx} {destination} |
|
97 |
|
98 =head1 DESCRIPTION |
|
99 |
|
100 The B<catter> takes all the blocks from the IDX file and |
|
101 cats them as one data stream. The destination can be any block device, |
|
102 a file name or even B<-> (STDOUT). |
|
103 |
|
104 |
|
105 =cut |