File Coverage

blib/lib/Metabrik/File/Compress.pm
Criterion Covered Total %
statement 9 96 9.3
branch 0 54 0.0
condition 0 48 0.0
subroutine 3 10 30.0
pod 1 7 14.2
total 13 215 6.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::compress brik
5             #
6             package Metabrik::File::Compress;
7 1     1   563 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         28  
9              
10 1     1   5 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         3  
  1         463  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable gzip unzip gunzip uncompress) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(directory) ],
20             input => [ qw(file) ],
21             output => [ qw(file) ],
22             },
23             attributes_default => {
24             datadir => '.', # Uncompress in current directory by default
25             },
26             commands => {
27             install => [ ], # Inherited
28             unzip => [ qw(input|OPTIONAL datadir|OPTIONAL) ],
29             gunzip => [ qw(input|OPTIONAL output|OPTIONAL datadir|OPTIONAL) ],
30             uncompress => [ qw(input|OPTIONAL output|OPTIONAL datadir|OPTIONAL) ],
31             gzip => [ qw(input) ],
32             bunzip2 => [ qw(input output|OPTIONAL datadir|OPTIONAL) ],
33             bzip2 => [ qw(input) ],
34             },
35             require_modules => {
36             'Compress::Zlib' => [ ],
37             'Metabrik::File::Type' => [ ],
38             'Metabrik::File::Write' => [ ],
39             },
40             require_binaries => {
41             unzip => [ ],
42             gzip => [ ],
43             bunzip2 => [ ],
44             bzip2 => [ ],
45             },
46             need_packages => {
47             ubuntu => [ qw(unzip gzip bzip2) ],
48             debian => [ qw(unzip gzip bzip2) ],
49             kali => [ qw(unzip gzip bzip2) ],
50             },
51             };
52             }
53              
54             sub unzip {
55 0     0 0   my $self = shift;
56 0           my ($input, $datadir) = @_;
57              
58 0   0       $input ||= $self->input;
59 0   0       $datadir ||= $self->datadir;
60 0 0         $self->brik_help_run_undef_arg('unzip', $input) or return;
61              
62 0           my $cmd = "unzip -o $input -d $datadir/";
63              
64 0 0         my $lines = $self->capture($cmd) or return;
65              
66 0           my @files = ();
67 0           for (@$lines) {
68 0 0         if (m{^\s*(?:inflating|extracting):\s*([^\s]+)\s*$}) {
69 0           push @files, $1;
70             }
71             }
72              
73 0           return \@files;
74             }
75              
76             sub gunzip {
77 0     0 0   my $self = shift;
78 0           my ($input, $output, $datadir) = @_;
79              
80 0   0       $input ||= $self->input;
81 0   0       $output ||= $self->output;
82 0   0       $datadir ||= $self->datadir;
83 0 0         $self->brik_help_run_undef_arg('gunzip', $input) or return;
84              
85             # If no output given, we use the input file name by removing .gz like gunzip command
86 0 0         if (! defined($output)) {
87 0           ($output = $input) =~ s/.gz$//;
88             }
89              
90 0           my $gz = Compress::Zlib::gzopen($input, "rb");
91 0 0         if (! $gz) {
92 0           return $self->log->error("gunzip: gzopen file [$input]: [$Compress::Zlib::gzerrno]");
93             }
94              
95 0 0         my $fw = Metabrik::File::Write->new_from_brik_init($self) or return;
96 0           $fw->append(0);
97 0           $fw->encoding('ascii');
98 0           $fw->overwrite(1);
99              
100 0 0         if ($output !~ m{^/}) { # Concatenare with $datadir only when not full path
101 0           $output = $datadir.'/'.$output;
102             }
103              
104 0 0         my $fd = $fw->open($output) or return;
105              
106 0           my $no_error = 1;
107 0           my $buffer = '';
108 0           while ($gz->gzread($buffer) > 0) {
109 0           $self->log->debug("gunzip: gzread ".length($buffer));
110 0           my $r = $fw->write($buffer);
111 0           $buffer = '';
112 0 0         if (! defined($r)) {
113 0           $self->log->warning("gunzip: write failed");
114 0           $no_error = 0;
115 0           next;
116             }
117             }
118              
119 0 0         if (! $no_error) {
120 0           $self->log->warning("gunzip: had some errors during gunzipping");
121             }
122              
123 0           $fw->close;
124              
125 0           return [ $output ];
126             }
127              
128             sub uncompress {
129 0     0 0   my $self = shift;
130 0           my ($input, $output, $datadir) = @_;
131              
132 0   0       $input ||= $self->input;
133 0   0       $datadir ||= $self->datadir;
134 0 0         $self->brik_help_run_undef_arg('uncompress', $input) or return;
135 0 0         $self->brik_help_run_file_not_found('uncompress', $input) or return;
136              
137 0 0         my $ft = Metabrik::File::Type->new_from_brik_init($self) or return;
138 0 0         my $type = $ft->get_mime_type($input) or return;
139              
140 0 0 0       if ($type eq 'application/gzip'
    0 0        
    0 0        
141             || $type eq 'application/x-gzip') {
142 0           return $self->gunzip($input, $output, $datadir);
143             }
144             elsif ($type eq 'application/zip'
145             || $type eq 'application/vnd.oasis.opendocument.text'
146             || $type eq 'application/java-archive') {
147 0           return $self->unzip($input, $datadir);
148             }
149             elsif ($type eq 'application/x-bzip2') {
150 0           return $self->bunzip2($input, $output, $datadir);
151             }
152              
153 0           return $self->log->error("uncompress: don't know how to uncompress file [$input] with MIME type [$type]");
154             }
155              
156             sub gzip {
157 0     0 0   my $self = shift;
158 0           my ($input) = @_;
159              
160 0 0         $self->brik_help_run_undef_arg('gzip', $input) or return;
161 0 0         $self->brik_help_run_file_not_found('gzip', $input) or return;
162              
163 0           my $cmd = "gzip -f \"$input\"";
164              
165 0 0         $self->execute($cmd) or return;
166              
167 0           return "$input.gz";
168             }
169              
170             sub bzip2 {
171 0     0 0   my $self = shift;
172 0           my ($input, $output, $datadir) = @_;
173              
174 0   0       $input ||= $self->input;
175 0   0       $output ||= $self->output;
176 0   0       $datadir ||= $self->datadir;
177 0 0         $self->brik_help_run_undef_arg('bzip2', $input) or return;
178              
179             # If no output given, we use the input file name by adding .bz2 like bzip2 command
180 0 0         if (! defined($output)) {
181 0           ($output = $input) =~ s/$/.bz2/;
182             }
183              
184 0           my $cmd = "bzip2 $input";
185              
186 0 0         my $lines = $self->capture($cmd) or return;
187              
188 0           return [ $output ];
189             }
190              
191             sub bunzip2 {
192 0     0 0   my $self = shift;
193 0           my ($input, $output, $datadir) = @_;
194              
195 0   0       $input ||= $self->input;
196 0   0       $output ||= $self->output;
197 0   0       $datadir ||= $self->datadir;
198 0 0         $self->brik_help_run_undef_arg('bunzip2', $input) or return;
199              
200             # If no output given, we use the input file name by removing .bz2 like bunzip2 command
201 0 0         if (! defined($output)) {
202 0           ($output = $input) =~ s/.bz2$//;
203             }
204              
205 0           my $cmd = "bunzip2 $input";
206              
207 0 0         my $lines = $self->capture($cmd) or return;
208              
209 0           return [ $output ];
210             }
211              
212             1;
213              
214             __END__