--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/imager.compress	Tue Aug 16 14:12:28 2011 +0200
@@ -0,0 +1,68 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use POSIX qw(strftime);
+use autodie qw(:all);
+use File::Basename;
+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;
+
+
+local $/ = undef;
+
+die if not @ARGV;
+
+find(sub {
+    say 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;
+
+	return if length($zbuffer)/length($buffer) < THRESHOLD;
+
+	$tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
+	print {$tmp} $buffer;
+	rename $tmp->filename => basename($_, ".gz");
+	
+    }
+    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;
+
+    close $tmp;
+    unlink $tmp, $_;
+
+    return;
+
+
+}, @ARGV);
+