source: repository/lib/Metabrik/File/Compress.pm

Last change on this file was 992:6bd6acfc81d5, checked in by GomoR <gomor@…>, 2 weeks ago
  • update: copyright notice
  • new: support for Kali Linux operating system
  • remove: api::onyphe is no more included, it use handled in its own repository
File size: 5.7 KB
Line 
1#
2# $Id$
3#
4# file::compress brik
5#
6package Metabrik::File::Compress;
7use strict;
8use warnings;
9
10use base qw(Metabrik::Shell::Command Metabrik::System::Package);
11
12sub brik_properties {
13   return {
14      revision => '$Revision$',
15      tags => [ qw(unstable gzip unzip gunzip uncompress) ],
16      author => 'GomoR <GomoR[at]metabrik.org>',
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
54sub unzip {
55   my $self = shift;
56   my ($input, $datadir) = @_;
57
58   $input ||= $self->input;
59   $datadir ||= $self->datadir;
60   $self->brik_help_run_undef_arg('unzip', $input) or return;
61
62   my $cmd = "unzip -o $input -d $datadir/";
63
64   my $lines = $self->capture($cmd) or return;
65
66   my @files = ();
67   for (@$lines) {
68      if (m{^\s*inflating:\s*([^\s]+)\s*$}) {
69         push @files, $1;
70      }
71   }
72
73   return \@files;
74}
75
76sub gunzip {
77   my $self = shift;
78   my ($input, $output, $datadir) = @_;
79
80   $input ||= $self->input;
81   $output ||= $self->output;
82   $datadir ||= $self->datadir;
83   $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   if (! defined($output)) {
87      ($output = $input) =~ s/.gz$//;
88   }
89
90   my $gz = Compress::Zlib::gzopen($input, "rb");
91   if (! $gz) {
92      return $self->log->error("gunzip: gzopen file [$input]: [$Compress::Zlib::gzerrno]");
93   }
94
95   my $fw = Metabrik::File::Write->new_from_brik_init($self) or return;
96   $fw->append(0);
97   $fw->encoding('ascii');
98   $fw->overwrite(1);
99
100   if ($output !~ m{^/}) {  # Concatenare with $datadir only when not full path
101      $output = $datadir.'/'.$output;
102   }
103
104   my $fd = $fw->open($output) or return;
105
106   my $no_error = 1;
107   my $buffer = '';
108   while ($gz->gzread($buffer) > 0) {
109      $self->log->debug("gunzip: gzread ".length($buffer));
110      my $r = $fw->write($buffer);
111      $buffer = '';
112      if (! defined($r)) {
113         $self->log->warning("gunzip: write failed");
114         $no_error = 0;
115         next;
116      }
117   }
118
119   if (! $no_error) {
120      $self->log->warning("gunzip: had some errors during gunzipping");
121   }
122
123   $fw->close;
124
125   return [ $output ];
126}
127
128sub uncompress {
129   my $self = shift;
130   my ($input, $output, $datadir) = @_;
131
132   $input ||= $self->input;
133   $datadir ||= $self->datadir;
134   $self->brik_help_run_undef_arg('uncompress', $input) or return;
135   $self->brik_help_run_file_not_found('uncompress', $input) or return;
136
137   my $ft = Metabrik::File::Type->new_from_brik_init($self) or return;
138   my $type = $ft->get_mime_type($input) or return;
139
140   if ($type eq 'application/gzip'
141   ||  $type eq 'application/x-gzip') {
142      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      return $self->unzip($input, $datadir);
148   }
149   elsif ($type eq 'application/x-bzip2') {
150      return $self->bunzip2($input, $output, $datadir);
151   }
152
153   return $self->log->error("uncompress: don't know how to uncompress file [$input] with MIME type [$type]");
154}
155
156sub gzip {
157   my $self = shift;
158   my ($input) = @_;
159
160   $self->brik_help_run_undef_arg('gzip', $input) or return;
161   $self->brik_help_run_file_not_found('gzip', $input) or return;
162
163   my $cmd = "gzip \"$input\"";
164
165   $self->execute($cmd) or return;
166
167   return "$input.gz";
168}
169
170sub bzip2 {
171   my $self = shift;
172   my ($input, $output, $datadir) = @_;
173
174   $input ||= $self->input;
175   $output ||= $self->output;
176   $datadir ||= $self->datadir;
177   $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   if (! defined($output)) {
181      ($output = $input) =~ s/$/.bz2/;
182   }
183
184   my $cmd = "bzip2 $input";
185
186   my $lines = $self->capture($cmd) or return;
187
188   return [ $output ];
189}
190
191sub bunzip2 {
192   my $self = shift;
193   my ($input, $output, $datadir) = @_;
194
195   $input ||= $self->input;
196   $output ||= $self->output;
197   $datadir ||= $self->datadir;
198   $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   if (! defined($output)) {
202      ($output = $input) =~ s/.bz2$//;
203   }
204
205   my $cmd = "bunzip2 $input";
206
207   my $lines = $self->capture($cmd) or return;
208
209   return [ $output ];
210}
211
2121;
213
214__END__
215
216=head1 NAME
217
218Metabrik::File::Compress - file::compress Brik
219
220=head1 COPYRIGHT AND LICENSE
221
222Copyright (c) 2014-2019, Patrice E<lt>GomoRE<gt> Auffret
223
224You may distribute this module under the terms of The BSD 3-Clause License.
225See LICENSE file in the source distribution archive.
226
227=head1 AUTHOR
228
229Patrice E<lt>GomoRE<gt> Auffret
230
231=cut
Note: See TracBrowser for help on using the repository browser.