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 #       if   test -f DATA/$f      then cat $f

     5 #	elif test -f DATA/$f.gz   then zcat DATA/$f.gz

     6 #       elif test -f DATA/$f.x    then openssl aes-128-cbc -d -in DATA/$f.x

     7 #	elif test -f DATA/$f.gz.x then openssl aes-128-cbc -d -in DATA/$f.gz.x | zcat

     8 #	elif test -f DATA/$f.x.gz then zcat DATA/$f.x.gz | openssl aes-128-cbs -d

     9 #	fi

    10 # done

    11 

    12 use 5.010;

    13 use strict;

    14 use warnings;

    15 use File::Basename;

    16 use autodie qw(:all);

    17 use Pod::Usage;

    18 use Getopt::Long;

    19 use Hash::Util qw(lock_keys);

    20 use Imager;

    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 use constant CIPHER => "aes-128-cbc";

    27 

    28 my %o = (pass => "stdin");

    29 lock_keys(%o);

    30 

    31 sub find_data_dir;

    32 

    33 MAIN: {

    34 

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

    36     GetOptions(

    37         "p|pass=s" => \$o{pass},

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

    39         "m|man"    => sub {

    40             pod2usage(

    41                 -verbose   => 2,

    42                 -exit      => 0,

    43                 -noperldoc => system(

    44                     "perldoc -V 1>/dev/null

    45 			  2>&1"

    46                 )

    47             );

    48         },

    49       )

    50       and @ARGV == 2

    51       or pod2usage;

    52 

    53     my $idx       = shift;

    54     my $dst       = shift;

    55     my $blocksize = undef;

    56     my $data      = find_data_dir($idx);

    57 

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

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

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

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

    62 

    63     my $out;

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

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

    66 

    67     while (<$fh>) {

    68         next if /^#/;

    69         my ($blk, undef, $path) = split;

    70         my $buffer;

    71 	Imager::get_block("$data/$path*" => \$buffer);

    72         print {$out} $buffer;

    73     }

    74     close($out);

    75     close($fh);

    76 }

    77 

    78 sub find_data_dir {

    79     for (my $dir = shift ; $dir ne "/" ; $dir = dirname $dir) {

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

    81     }

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

    83 }

    84 

    85 __END__

    86 

    87 =head1 NAME

    88 

    89     imager.restore - cats the blocks of the imager

    90 

    91 =head1 SYNOPSIS

    92 

    93     imager.restore [options] {idx} {destination}

    94 

    95 =head1 DESCRIPTION

    96 

    97 The B<imager.restore> takes all the blocks from the IDX file and

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

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

   100 

   101 =head1 OPTIONS

   102 

   103 =over

   104 

   105 =item B<-p>|B<--pass> I<pass>

   106 

   107 In case you expect encrypted data, this option takes the argument for

   108 B<openssl>'s C<-pass> option. See L<openssl(1)> for mor information.

   109 (default: stdin)

   110 

   111 =item B<-h>|B<--help>

   112 

   113 =item B<-m>|B<--man>

   114 

   115 The standard help options.

   116 

   117 =back

   118 

   119 =cut