--- 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
--- 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);
-
+