added compressor
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Tue, 16 Aug 2011 14:12:28 +0200
changeset 62 24b1c19790bb
parent 61 38b3bff416ba
child 63 e6b2c98df64a
added compressor
bin/imager.compress
bin/imager.save
--- /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);
+
--- a/bin/imager.save	Tue Aug 16 11:44:32 2011 +0200
+++ b/bin/imager.save	Tue Aug 16 14:12:28 2011 +0200
@@ -148,8 +148,6 @@
         my ($file, $ext, $cs);
         $file = $cs = md5_hex($buffer);
         $file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
-        $ext = "";
-        $ext .= $o{compress} ? ".gz" : "";
         $ext .= $o{pass}     ? ".x"  : "";
 
         # the extension we do not put into the index
@@ -174,15 +172,22 @@
                 open($out, "|openssl @{[CIPHER]} -pass $o{pass} -out $out");
             }
             binmode($out);
+
             if ($o{compress}) {
+		my $zbuffer;
                 gzip(
-                    \$buffer  => $out,
+                    \$buffer  => \$zbuffer,
                     -Minimal  => 1,
                     -Level    => Z_BEST_SPEED,
                     -Strategy => Z_FILTERED
                 ) or die $GzipError;
+		if (length($zbuffer)/length($buffer) < 0.9) {
+		    $buffer = $zbuffer;
+		    $ext = ".gz$ext";
+		}
             }
-            else { print {$out} $buffer }
+
+            print {$out} $buffer;
             close($out);
             rename($out => "$data/$file$ext");
             $index{BLOCKS}[$. - 1] .= " *";