# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1313499331 -7200
# Node ID a10f9c6a0b420e5c8c5e9d5d79e3d350415bf2f4
# Parent  42a046de4ceab2b14a6f6a4de2aa01828062ef65
added support for image.compress, wrote manpage for compress

diff -r 42a046de4cea -r a10f9c6a0b42 bin/imager
--- a/bin/imager	Tue Aug 16 14:44:45 2011 +0200
+++ b/bin/imager	Tue Aug 16 14:55:31 2011 +0200
@@ -16,7 +16,7 @@
         );
     },
   )
-  and $ARGV[0] ~~ [qw(save restore fuse check)]
+  and $ARGV[0] ~~ [qw(save restore fuse check compress)]
   or pod2usage;
 
 exec "$0." . shift() => @ARGV;
@@ -70,6 +70,11 @@
 
 Check the saved images.  See C<imager check --help> for more information.
 
+=item compress
+
+Check the compression and decompress or compress. See C<--imager
+compress --help> for more information.
+
 =back
 
 
diff -r 42a046de4cea -r a10f9c6a0b42 bin/imager.compress
--- a/bin/imager.compress	Tue Aug 16 14:44:45 2011 +0200
+++ b/bin/imager.compress	Tue Aug 16 14:55:31 2011 +0200
@@ -9,64 +9,101 @@
 use File::Temp;
 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);
 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
-use Hash::Util qw(lock_keys);
 use Getopt::Long;
 use Pod::Usage;
 use File::Find;
 
 use constant THRESHOLD => 0.90;
-use constant LEVEL => Z_BEST_SPEED;
+use constant LEVEL     => Z_BEST_SPEED;
+
+MAIN: {
+
+    local $/ = undef;
+    GetOptions(
+        "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
+        "m|man"  => sub {
+            pod2usage(
+                -verbose   => 2,
+                -exit      => 0,
+                -noperldoc => system("perldoc -V 1>/dev/null 2>&1")
+            );
+        },
+      )
+      and @ARGV
+      or pod2usage;
+
+    find(
+        sub {
+            say "dir $_" and return if -d;
+            return if not -f;
+
+            open(my $fh, $_);
+            my ($buffer, $zbuffer);
+            my ($tmp);
+
+            if (/\.gz$/) {
+                $zbuffer = <$fh>;
+                gunzip(\$zbuffer => \$buffer)
+                  or die $GunzipError;
+
+                if (!length($buffer)) {
+                    warn "?? zero length after decompression: $_\n";
+                    return;
+                }
+                return if length($zbuffer) / length($buffer) < THRESHOLD;
+
+                $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
+                print {$tmp} $buffer;
+                rename $tmp->filename => basename($_, ".gz");
+                say "uncompressed $_";
+
+            }
+            else {
+                $buffer = <$fh>;
+                gzip(
+                    \$buffer  => \$zbuffer,
+                    -Minimal  => 1,
+                    -Level    => Z_BEST_SPEED,
+                    -Strategy => Z_FILTERED
+                ) or die $GzipError;
+                return if length($zbuffer) / length($buffer) >= THRESHOLD;
+
+                $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
+                print {$tmp} $zbuffer;
+                rename $tmp->filename => "$_.gz";
+                say "  compressed $_";
+            }
+
+            close $tmp;
+            unlink $tmp, $_;
+
+            return;
+
+        },
+        @ARGV
+    );
+
+}
+
+__END__
+
+=head1 NAME 
+
+    imager.compress - compress or decompress the blocks
+
+=head1 SYNOPSIS
+
+    imager.compress {dir}
+
+=head1 DESCRIPTION
+
+B<imager.compress> checks all files below the I<dir[s]>.
+
+If compression saves more then 10% it will save the compressed block,
+otherwise the uncompressed.
+
+=cut
 
 
-local $/ = undef;
 
-die if not @ARGV;
-
-find(sub {
-    say "dir $_" and return if -d;
-    return if not -f;
-
-    open(my $fh, $_);
-    my ($buffer, $zbuffer);
-    my ($tmp);
-
-    if (/\.gz$/ ) { 
-	$zbuffer = <$fh>;
-	gunzip(\$zbuffer => \$buffer)
-	    or die $GunzipError;
-
-	if (!length($buffer)) {
-		warn "?? zero length after decompression: $_\n";
-		return;
-	}
-	return if length($zbuffer)/length($buffer) < THRESHOLD;
-
-	$tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
-	print {$tmp} $buffer;
-	rename $tmp->filename => basename($_, ".gz");
-	say "uncompressed $_";
-	
-    }
-    else {
-	$buffer = <$fh>;
-	gzip(\$buffer => \$zbuffer,
-	    -Minimal => 1,
-	    -Level => Z_BEST_SPEED,
-	    -Strategy => Z_FILTERED
-	) or die $GzipError;
-	return  if length($zbuffer)/length($buffer) >= THRESHOLD;
-
-	$tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
-	print {$tmp} $zbuffer;
-	rename $tmp->filename => "$_.gz";
-	say "  compressed $_";
-    }
-
-    close $tmp;
-    unlink $tmp, $_;
-
-    return;
-
-
-}, @ARGV);
-
+