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 use 5.010;

    12 use strict;

    13 use warnings;

    14 use File::Basename;

    15 use Cwd qw(abs_path);

    16 use autodie qw(:all);

    17 use Pod::Usage;

    18 use Getopt::Long;

    19 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);

    20 

    21 use constant KiB => 1024;

    22 use constant MiB => 1024 * KiB;

    23 use constant GiB => 1024 * MiB;

    24 use constant ME  => basename $0;

    25 

    26 sub find_data_dir;

    27 

    28 MAIN: {

    29 

    30     Getopt::Long::Configure(qw(Bundling));

    31     GetOptions(

    32         "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },

    33         "m|man"  => sub {

    34             pod2usage(

    35                 -verbose   => 2,

    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;

    46 

    47     my $idx       = shift;

    48     my $dst       = shift;

    49     my $blocksize = undef;

    50     my $data      = find_data_dir($idx);

    51 

    52     open(my $fh => $idx);

    53     { local $/ = ""; $_ = <$fh>; }

    54     /^format:\s*1$/m or die ME . ": expected index format 1\n";

    55     ($blocksize) = /^blocksize:\s*(\d+)/m or die ME . ": no blocksize found\n";

    56 

    57     my $out;

    58     if   ($dst eq "-") { open($out => ">&STDOUT") }

    59     else               { open($out => ">", $dst) }

    60 

    61     while (<$fh>) {

    62         next if /^#/;

    63         my ($blk, $hash, $path) = split;

    64         my ($in, $buffer);

    65 

    66         if (-f "$data/$path") {

    67             open($in => "$data/$path");

    68             binmode($in);

    69             local $/ = \$blocksize;

    70             $buffer = <$in>;

    71         }

    72         elsif (-f "$data/$path.gz") {

    73             open($in => "$data/$path.gz");

    74             binmode($in);

    75             gunzip($in => \$buffer)

    76               or die $GunzipError;

    77         }

    78         else {

    79             die ME . ": Can't open $data/$path: $!\n";

    80         }

    81         print {$out} $buffer;

    82         close($in);

    83     }

    84     close($out);

    85     close($fh);

    86 }

    87 

    88 sub find_data_dir {

    89     for (my $dir = shift ; $dir ne "/" ; $dir = abs_path("$dir/..")) {

    90         return "$dir/data" if -d "$dir/data" and -d "$dir/idx";

    91     }

    92     die ME . ": no data directory found!\n";

    93 }

    94 

    95 __END__

    96 

    97 =head1 NAME

    98 

    99     catter - cats the blocks of the imager

   100 

   101 =head1 SYNOPSIS

   102 

   103     catter {idx} {destination}

   104 

   105 =head1 DESCRIPTION

   106 

   107 The B<catter> takes all the blocks from the IDX file and

   108 cats them as one data stream. The destination can be any block device,

   109 a file name or even B<-> (STDOUT).

   110 

   111 

   112 =cut