1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use POSIX qw(strftime);

     7 use autodie qw(:all);

     8 use File::Basename;

     9 use File::Temp;

    10 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);

    11 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);

    12 use Hash::Util qw(lock_keys);

    13 use Getopt::Long;

    14 use Pod::Usage;

    15 use File::Find;

    16 

    17 use constant THRESHOLD => 0.90;

    18 use constant LEVEL => Z_BEST_SPEED;

    19 

    20 

    21 local $/ = undef;

    22 

    23 die if not @ARGV;

    24 

    25 find(sub {

    26     say and return if -d;

    27     return if not -f;

    28 

    29     open(my $fh, $_);

    30     my ($buffer, $zbuffer);

    31     my ($tmp);

    32 

    33     if (/\.gz$/ ) { 

    34 	$zbuffer = <$fh>;

    35 	gunzip(\$zbuffer => \$buffer)

    36 	    or die $GunzipError;

    37 

    38 	return if length($zbuffer)/length($buffer) < THRESHOLD;

    39 

    40 	$tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");

    41 	print {$tmp} $buffer;

    42 	rename $tmp->filename => basename($_, ".gz");

    43 	

    44     }

    45     else {

    46 	$buffer = <$fh>;

    47 	gzip(\$buffer => \$zbuffer,

    48 	    -Minimal => 1,

    49 	    -Level => Z_BEST_SPEED,

    50 	    -Strategy => Z_FILTERED

    51 	) or die $GzipError;

    52 	return  if length($zbuffer)/length($buffer) >= THRESHOLD;

    53 

    54 	$tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");

    55 	print {$tmp} $zbuffer;

    56 	rename $tmp->filename => "$_.gz";

    57     }

    58 

    59     say;

    60 

    61     close $tmp;

    62     unlink $tmp, $_;

    63 

    64     return;

    65 

    66 

    67 }, @ARGV);

    68