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 Getopt::Long;

    13 use Pod::Usage;

    14 use File::Find;

    15 

    16 use constant THRESHOLD => 0.90;

    17 use constant LEVEL     => Z_BEST_SPEED;

    18 

    19 MAIN: {

    20 

    21     GetOptions(

    22         "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },

    23         "m|man"  => sub {

    24             pod2usage(

    25                 -verbose   => 2,

    26                 -exit      => 0,

    27                 -noperldoc => system("perldoc -V 1>/dev/null 2>&1")

    28             );

    29         },

    30       )

    31       and @ARGV

    32       or pod2usage;

    33 

    34     find(

    35         sub {

    36             say "dir $File::Find::name" and return if -d;

    37             return if not (-f and /^[\da-f]{32}(?:\.x\.gz|\.gz)?$/);

    38 	    #print STDERR ".";

    39 

    40             open(my $fh, $_);

    41             my ($buffer, $zbuffer);

    42             my ($tmp);

    43 

    44             if (/\.gz$/) {

    45 		sysread $fh => $zbuffer, -s $fh;

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

    47                   or die $GunzipError;

    48 

    49                 if (!length($buffer)) {

    50                     warn "?? zero length after decompression: $_\n";

    51                     return;

    52                 }

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

    54 

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

    56 		syswrite $tmp => $buffer;

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

    58                 say "uncompressed $_";

    59                 #print "+";

    60 

    61             }

    62             else {

    63                 sysread $fh => $buffer, -s $fh;

    64                 gzip(

    65                     \$buffer  => \$zbuffer,

    66                     -Minimal  => 1,

    67                     -Level    => Z_BEST_SPEED,

    68                     -Strategy => Z_FILTERED

    69                 ) or die $GzipError;

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

    71 

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

    73                 syswrite $tmp => $zbuffer;

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

    75                 say "  compressed $_";

    76 		#print STDERR "-";

    77             }

    78 

    79             close $tmp;

    80             map { unlink } $tmp, $_;

    81 

    82             return 0;

    83 

    84         },

    85         @ARGV

    86     );

    87 

    88     exit 0;

    89 

    90 }

    91 

    92 __END__

    93 

    94 =head1 NAME 

    95 

    96     imager.compress - compress or decompress the blocks

    97 

    98 =head1 SYNOPSIS

    99 

   100     imager.compress {dir}

   101 

   102 =head1 DESCRIPTION

   103 

   104 B<imager.compress> checks all files below the I<dir[s]>.

   105 

   106 If compression saves more then 10% it will save the compressed block,

   107 otherwise the uncompressed.

   108 

   109 =cut

   110 

   111 

   112 

   113