bin/imager.compress
changeset 79 4362b3ac6567
parent 76 b87d2064db02
child 124 87081e9cf3ba
equal deleted inserted replaced
78:603b47708d37 79:4362b3ac6567
    16 use constant THRESHOLD => 0.90;
    16 use constant THRESHOLD => 0.90;
    17 use constant LEVEL     => Z_BEST_SPEED;
    17 use constant LEVEL     => Z_BEST_SPEED;
    18 
    18 
    19 MAIN: {
    19 MAIN: {
    20 
    20 
    21     local $/ = undef;
       
    22     GetOptions(
    21     GetOptions(
    23         "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
    22         "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
    24         "m|man"  => sub {
    23         "m|man"  => sub {
    25             pod2usage(
    24             pod2usage(
    26                 -verbose   => 2,
    25                 -verbose   => 2,
    41             open(my $fh, $_);
    40             open(my $fh, $_);
    42             my ($buffer, $zbuffer);
    41             my ($buffer, $zbuffer);
    43             my ($tmp);
    42             my ($tmp);
    44 
    43 
    45             if (/\.gz$/) {
    44             if (/\.gz$/) {
    46                 $zbuffer = <$fh>;
    45 		sysread $fh => $zbuffer, -s $fh;
    47                 gunzip(\$zbuffer => \$buffer)
    46                 gunzip(\$zbuffer => \$buffer)
    48                   or die $GunzipError;
    47                   or die $GunzipError;
    49 
    48 
    50                 if (!length($buffer)) {
    49                 if (!length($buffer)) {
    51                     warn "?? zero length after decompression: $_\n";
    50                     warn "?? zero length after decompression: $_\n";
    52                     return;
    51                     return;
    53                 }
    52                 }
    54                 return if length($zbuffer) / length($buffer) < THRESHOLD;
    53                 return if length($zbuffer) / length($buffer) < THRESHOLD;
    55 
    54 
    56                 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
    55                 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
    57                 print {$tmp} $buffer;
    56 		syswrite $tmp => $buffer;
    58                 rename $tmp->filename => basename($_, ".gz");
    57                 rename $tmp->filename => basename($_, ".gz");
    59                 say "uncompressed $_";
    58                 say "uncompressed $_";
    60                 #print "+";
    59                 #print "+";
    61 
    60 
    62             }
    61             }
    63             else {
    62             else {
    64                 $buffer = <$fh>;
    63                 sysread $fh => $buffer, -s $fh;
    65                 gzip(
    64                 gzip(
    66                     \$buffer  => \$zbuffer,
    65                     \$buffer  => \$zbuffer,
    67                     -Minimal  => 1,
    66                     -Minimal  => 1,
    68                     -Level    => Z_BEST_SPEED,
    67                     -Level    => Z_BEST_SPEED,
    69                     -Strategy => Z_FILTERED
    68                     -Strategy => Z_FILTERED
    70                 ) or die $GzipError;
    69                 ) or die $GzipError;
    71                 return if length($zbuffer) / length($buffer) >= THRESHOLD;
    70                 return if length($zbuffer) / length($buffer) >= THRESHOLD;
    72 
    71 
    73                 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
    72                 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX");
    74                 print {$tmp} $zbuffer;
    73                 syswrite $tmp => $zbuffer;
    75                 rename $tmp->filename => "$_.gz";
    74                 rename $tmp->filename => "$_.gz";
    76                 say "  compressed $_";
    75                 say "  compressed $_";
    77 		#print STDERR "-";
    76 		#print STDERR "-";
    78             }
    77             }
    79 
    78