7 use autodie qw(:all); |
7 use autodie qw(:all); |
8 use File::Basename; |
8 use File::Basename; |
9 use File::Temp; |
9 use File::Temp; |
10 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy); |
10 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy); |
11 use IO::Uncompress::Gunzip qw(gunzip $GunzipError); |
11 use IO::Uncompress::Gunzip qw(gunzip $GunzipError); |
12 use Hash::Util qw(lock_keys); |
|
13 use Getopt::Long; |
12 use Getopt::Long; |
14 use Pod::Usage; |
13 use Pod::Usage; |
15 use File::Find; |
14 use File::Find; |
16 |
15 |
17 use constant THRESHOLD => 0.90; |
16 use constant THRESHOLD => 0.90; |
18 use constant LEVEL => Z_BEST_SPEED; |
17 use constant LEVEL => Z_BEST_SPEED; |
|
18 |
|
19 MAIN: { |
|
20 |
|
21 local $/ = undef; |
|
22 GetOptions( |
|
23 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
|
24 "m|man" => sub { |
|
25 pod2usage( |
|
26 -verbose => 2, |
|
27 -exit => 0, |
|
28 -noperldoc => system("perldoc -V 1>/dev/null 2>&1") |
|
29 ); |
|
30 }, |
|
31 ) |
|
32 and @ARGV |
|
33 or pod2usage; |
|
34 |
|
35 find( |
|
36 sub { |
|
37 say "dir $_" and return if -d; |
|
38 return if not -f; |
|
39 |
|
40 open(my $fh, $_); |
|
41 my ($buffer, $zbuffer); |
|
42 my ($tmp); |
|
43 |
|
44 if (/\.gz$/) { |
|
45 $zbuffer = <$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 print {$tmp} $buffer; |
|
57 rename $tmp->filename => basename($_, ".gz"); |
|
58 say "uncompressed $_"; |
|
59 |
|
60 } |
|
61 else { |
|
62 $buffer = <$fh>; |
|
63 gzip( |
|
64 \$buffer => \$zbuffer, |
|
65 -Minimal => 1, |
|
66 -Level => Z_BEST_SPEED, |
|
67 -Strategy => Z_FILTERED |
|
68 ) or die $GzipError; |
|
69 return if length($zbuffer) / length($buffer) >= THRESHOLD; |
|
70 |
|
71 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX"); |
|
72 print {$tmp} $zbuffer; |
|
73 rename $tmp->filename => "$_.gz"; |
|
74 say " compressed $_"; |
|
75 } |
|
76 |
|
77 close $tmp; |
|
78 unlink $tmp, $_; |
|
79 |
|
80 return; |
|
81 |
|
82 }, |
|
83 @ARGV |
|
84 ); |
|
85 |
|
86 } |
|
87 |
|
88 __END__ |
|
89 |
|
90 =head1 NAME |
|
91 |
|
92 imager.compress - compress or decompress the blocks |
|
93 |
|
94 =head1 SYNOPSIS |
|
95 |
|
96 imager.compress {dir} |
|
97 |
|
98 =head1 DESCRIPTION |
|
99 |
|
100 B<imager.compress> checks all files below the I<dir[s]>. |
|
101 |
|
102 If compression saves more then 10% it will save the compressed block, |
|
103 otherwise the uncompressed. |
|
104 |
|
105 =cut |
19 |
106 |
20 |
107 |
21 local $/ = undef; |
|
22 |
108 |
23 die if not @ARGV; |
109 |
24 |
|
25 find(sub { |
|
26 say "dir $_" 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 if (!length($buffer)) { |
|
39 warn "?? zero length after decompression: $_\n"; |
|
40 return; |
|
41 } |
|
42 return if length($zbuffer)/length($buffer) < THRESHOLD; |
|
43 |
|
44 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX"); |
|
45 print {$tmp} $buffer; |
|
46 rename $tmp->filename => basename($_, ".gz"); |
|
47 say "uncompressed $_"; |
|
48 |
|
49 } |
|
50 else { |
|
51 $buffer = <$fh>; |
|
52 gzip(\$buffer => \$zbuffer, |
|
53 -Minimal => 1, |
|
54 -Level => Z_BEST_SPEED, |
|
55 -Strategy => Z_FILTERED |
|
56 ) or die $GzipError; |
|
57 return if length($zbuffer)/length($buffer) >= THRESHOLD; |
|
58 |
|
59 $tmp = File::Temp->new(DIR => ".", TEMPLATE => ".tmp-XXXXXX"); |
|
60 print {$tmp} $zbuffer; |
|
61 rename $tmp->filename => "$_.gz"; |
|
62 say " compressed $_"; |
|
63 } |
|
64 |
|
65 close $tmp; |
|
66 unlink $tmp, $_; |
|
67 |
|
68 return; |
|
69 |
|
70 |
|
71 }, @ARGV); |
|
72 |
|