1 #! /usr/bin/perl |
1 #! /usr/bin/perl |
2 # Eigentlich geht das selbe mit: |
2 # Eigentlich geht das selbe mit: |
3 # grep -v '^\[' IDX-File | while read x x file x; do test "$file" && cat DATA/$file; done |
3 # grep '^[[:space:]]*[[:digit:]]' IDX-file | tr -d | cut -f4 -d' ' | while read f; do |
4 # |
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 |
5 use 5.010; |
12 use 5.010; |
6 use strict; |
13 use strict; |
7 use warnings; |
14 use warnings; |
8 use File::Basename; |
15 use File::Basename; |
9 use Cwd qw(abs_path); |
16 use Cwd qw(abs_path); |
10 use autodie qw(:all); |
17 use autodie qw(:all); |
|
18 use Pod::Usage; |
|
19 use Getopt::Long; |
|
20 use IO::Uncompress::Gunzip qw(gunzip $GunzipError); |
11 |
21 |
12 use constant KiB => 1024; |
22 use constant KiB => 1024; |
13 use constant MiB => 1024 * KiB; |
23 use constant MiB => 1024 * KiB; |
14 use constant GiB => 1024 * MiB; |
24 use constant GiB => 1024 * MiB; |
|
25 use constant ME => basename $0; |
15 |
26 |
16 my $BS = 64 * MiB; |
27 sub find_data_dir; |
17 my $IDX = shift // die "Need index file\n"; |
|
18 my $DST = shift // die "Need destination for writing the image.\n"; |
|
19 my $DATA = abs_path(dirname($IDX) . "/../data"); |
|
20 |
28 |
21 open(my $idx => $IDX); |
29 MAIN: { |
22 |
30 |
23 { local $/ = ""; |
31 Getopt::Long::Configure(qw(Bundling)); |
24 scalar <$idx>; |
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); |
25 } |
79 } |
26 |
80 |
27 my $out; |
81 sub find_data_dir { |
28 if ($DST eq "-") { open($out => ">&STDOUT") } |
82 for (my $dir = shift; $dir ne "/"; $dir = abs_path("$dir/..")) { |
29 else { open($out => ">", $DST) }; |
83 return "$dir/data" if -d "$dir/data" and -d "$dir/idx"; |
|
84 } |
|
85 die ME.": no data directory found!\n"; |
|
86 } |
30 |
87 |
31 while (<$idx>) { |
88 __END__ |
32 next if /^#/; |
89 |
33 my ($blk, $hash, $path) = split; |
90 =head1 NAME |
34 open(my $in => "$DATA/$path"); |
91 |
35 { |
92 catter - cats the blocks of the imager |
36 my $buffer; |
93 |
37 local $/ = \$BS; |
94 =head1 SYNOPSIS |
38 print {$out} $buffer while defined($buffer = <$in>); |
95 |
39 } |
96 catter {idx} {destination} |
40 close($in); |
97 |
41 } |
98 =head1 DESCRIPTION |
42 close($out); |
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 |