Imager.pm: get_file, 1 save/restore/compress unittest
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Wed, 17 Aug 2011 16:16:23 +0200
changeset 74 a8495233e04c
parent 73 0315e75a049d
child 75 9dd924d5a249
Imager.pm: get_file, 1 save/restore/compress unittest
bin/imager.fuse
bin/imager.restore
bin/imager.save
lib/Imager.pm
t/001-save-restore.t
--- a/bin/imager.fuse	Wed Aug 17 12:10:51 2011 +0200
+++ b/bin/imager.fuse	Wed Aug 17 16:16:23 2011 +0200
@@ -218,21 +218,7 @@
         if (not defined $cache{fn}
             or ($cache{fn} ne $fn))
         {
-            if (-e $fn) {
-		Imager::get_block($fn => \$cache{data});
-            }
-            elsif (-e "$fn.gz") {
-		Imager::get_block("$fn.gz" => \$cache{data});
-            }
-            elsif (-e "$fn.x") {
-		Imager::get_block("$fn.x" => \$cache{data});
-            }
-            elsif (-e "$fn.gz.x") {
-		Imager::get_block("$fn.gz.x" => \$cache{data});
-            }
-	    else {
-		die "Can't get file for $fn";
-	    }
+	    Imager::get_block("$fn*" => \$cache{data});
             $cache{fn} = $fn;
         }
 
--- a/bin/imager.restore	Wed Aug 17 12:10:51 2011 +0200
+++ b/bin/imager.restore	Wed Aug 17 16:16:23 2011 +0200
@@ -66,19 +66,9 @@
 
     while (<$fh>) {
         next if /^#/;
-        my ($blk, $hash, $path) = split;
+        my ($blk, undef, $path) = split;
         my $buffer;
-        if (-f "$data/$path") { Imager::get_block("$data/$path" => \$buffer) }
-        elsif (-f "$data/$path.gz") {
-            Imager::get_block("$data/$path.gz" => \$buffer);
-        }
-        elsif (-f "$data/$path.x") {
-            Imager::get_block("$data/$path.x" => \$buffer);
-        }
-        elsif (-f "$data/$path.gz.x") {
-            Imager::get_block("$data/$path.gz.x" => \$buffer);
-        }
-        else { die ME . ": Can't open $data/$path: $!\n" }
+	Imager::get_block("$data/$path*" => \$buffer);
         print {$out} $buffer;
     }
     close($out);
--- a/bin/imager.save	Wed Aug 17 12:10:51 2011 +0200
+++ b/bin/imager.save	Wed Aug 17 16:16:23 2011 +0200
@@ -14,6 +14,7 @@
 use Hash::Util qw(lock_keys);
 use Getopt::Long;
 use Pod::Usage;
+use Imager 0.1;
 
 use constant KiB      => 1024;
 use constant MiB      => 1024 * KiB;
@@ -154,14 +155,7 @@
         push @{ $index{BLOCKS} }, sprintf "%12d %s %s" => ($. - 1),
           $cs,                    $file;
 
-        if (
-            not(   -e "$data/$file"
-                or -e "$data/$file.gz"
-                or -e "$data/$file.x"
-                or -e "$data/$file.gz.x"
-                or -e "$data/$file.x.gz")
-          )
-        {
+        if (not Imager::get_file("$data/$file")) {
             mkpath dirname("$data/$file");
             my $out = File::Temp->new(
                 TEMPLATE => "tmp-XXXXXXX",
--- a/lib/Imager.pm	Wed Aug 17 12:10:51 2011 +0200
+++ b/lib/Imager.pm	Wed Aug 17 16:16:23 2011 +0200
@@ -5,11 +5,22 @@
 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
 use autodie qw(:all);
 
+our $VERSION = "0.1";
+
 use constant CIPHER => "aes-128-cbc";
 
+sub get_file {
+    my ($base) = @_;
+    foreach (map { "$base$_" } "", qw/.gz .x .gz.x/) {
+	return $_ if -f;
+    }
+}
+
 sub get_block {
     my ($file, $buffer) = @_;
 
+    $file = get_file($1) if $file =~ /(.*)\*$/;
+
     given ($file) {
         when (/\.gz\.x$/) {
             open(my $fh => "openssl @{[CIPHER]} -d -pass $::o{pass} -in $file|");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/001-save-restore.t	Wed Aug 17 16:16:23 2011 +0200
@@ -0,0 +1,39 @@
+use 5.010;
+use strict;
+use warnings;
+use autodie qw(:all);
+use Test::More;
+use Sys::Hostname;
+
+use constant SIZE => 27 * 1024 * 1024;
+
+use File::Temp;
+
+my $dir = File::Temp->newdir;
+
+open(my $out, "+>$dir/source");
+print $out rand while -s $out < SIZE;
+
+mkdir "$dir/images";
+
+system("perl -Mblib blib/script/imager.save $dir/source:source $dir/images");
+is($? => 0, "saved");
+
+system("perl -Mblib blib/script/imager.restore $dir/images/idx/@{[hostname]}/source/* $dir/source.restored");
+is($? => 0, "restored");
+
+# just as it is
+seek($out, 0, 0);
+open(my $restored, "$dir/source.restored");
+ok(<$out> ~~ <$restored>, "source === restored");
+
+# now compress and check again
+system("perl -Mblib blib/script/imager.compress $dir/images");
+system("perl -Mblib blib/script/imager.restore $dir/images/idx/@{[hostname]}/source/* $dir/source.restored");
+is($? => 0, "restored");
+seek($out, 0, 0);
+open($restored, "$dir/source.restored");
+ok(<$out> ~~ <$restored>, "compressed source === restored");
+
+
+done_testing;