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

Last change on this file was 947:5a412d188cb6, checked in by GomoR <gomor@…>, 3 weeks ago
  • UPDATE: network::address: use Regexp::IPv4 && Regexp::IPv6 for is_* Commands
  • update: api::onyphe: use code 429 for rate limiting
  • update: database::nvd: cvss score and other info added
  • bugfix: client::kafka: from Kafka module updates
  • bugfix: network::portscan: do not subclass from network::address, load the Brik instead
  • new: time::universal: new time format parsed (NVD)
File size: 8.6 KB
Line 
1#
2# $Id$
3#
4# system::file Brik
5#
6package Metabrik::System::File;
7use strict;
8use warnings;
9
10use base qw(Metabrik::Shell::Command);
11
12sub brik_properties {
13   return {
14      revision => '$Revision$',
15      tags => [ qw(unstable chmod chgrp cp copy move rm mv remove mkdir mkd) ],
16      author => 'GomoR <GomoR[at]metabrik.org>',
17      license => 'http://opensource.org/licenses/BSD-3-Clause',
18      attributes => {
19         overwrite => [ qw(0|1) ],
20      },
21      attributes_default => {
22         overwrite => 0,
23      },
24      commands => {
25         mkdir => [ qw(directory) ],
26         rmdir => [ qw(directory) ],
27         chmod => [ qw(file perms) ],
28         chgrp => [ qw(file) ],
29         copy => [ qw(source destination) ],
30         sudo_copy => [ qw(source destination) ],
31         move => [ qw(source destination) ],
32         remove => [ qw(file|$file_list) ],
33         rename => [ qw(source destination) ],
34         cat => [ qw(source destination) ],
35         create => [ qw(file size) ],
36         glob => [ qw(pattern) ],
37         is_relative => [ qw(path) ],
38         is_absolute => [ qw(path) ],
39         to_absolute_path => [ qw(path basepath|OPTIONAL) ],
40         basefile => [ qw(path) ],
41         basedir => [ qw(path) ],
42         link => [ qw(from to) ],
43         uniq => [ qw(input output) ],
44         count => [ qw(input) ],
45         touch => [ qw(file) ],
46      },
47      require_modules => {
48         'File::Copy' => [ qw(mv copy) ],
49         'File::Path' => [ qw(make_path) ],
50         'File::Spec' => [ ],
51      },
52      need_packages => {
53         ubuntu => [ qw(coreutils) ],
54         debian => [ qw(coreutils) ],
55      },
56      require_binaries => {
57         sort => [ ],
58         wc => [ ],
59      },
60   };
61}
62
63sub mkdir {
64   my $self = shift;
65   my ($path) = @_;
66
67   $self->brik_help_run_undef_arg('mkdir', $path) or return;
68
69   my $no_error = 1;
70   File::Path::make_path($path, { error => \my $error });
71   if ($error) {
72      for my $this (@$error) {
73         my ($file, $message) = %$this;
74         if ($file eq '') {
75            return $self->log->error("mkdir: make_path failed with error [$message]");
76         }
77         else {
78            $self->log->warning("mkdir: error creating directory [$file]: error [$error]");
79            $no_error = 0;
80         }
81      }
82   }
83
84   return $no_error;
85}
86
87sub rmdir {
88}
89
90sub chmod {
91   my $self = shift;
92   my ($file, $perms) = @_;
93
94   $self->brik_help_run_undef_arg('chmod', $file) or return;
95   my $ref = $self->brik_help_run_invalid_arg('chmod', $file, 'SCALAR', 'ARRAY')
96      or return;
97   $self->brik_help_run_undef_arg('chmod', $perms) or return;
98
99   my $r;
100   if ($ref eq 'ARRAY') {
101      $r = CORE::chmod(oct($perms), @$file);
102   }
103   else {
104      $r = CORE::chmod(oct($perms), $file);
105   }
106
107   if (! $r) {
108      return $self->log->error("chmod: failed to chmod file [$file]: $!");
109   }
110
111   return $file;
112}
113
114sub chgrp {
115}
116
117sub copy {
118   my $self = shift;
119   my ($source, $destination) = @_;
120
121   $self->brik_help_run_undef_arg('copy', $source) or return;
122   $self->brik_help_run_undef_arg('copy', $destination) or return;
123
124   my $r = File::Copy::copy($source, $destination);
125   if (! $r) {
126      return $self->log->error("copy: failed copying [$source] to [$destination]: error [$!]");
127   }
128
129   return $destination;
130}
131
132sub sudo_copy {
133   my $self = shift;
134   my ($source, $destination) = @_;
135
136   $self->brik_help_run_undef_arg('sudo_copy', $source) or return;
137   $self->brik_help_run_undef_arg('sudo_copy', $destination) or return;
138
139   return $self->sudo_execute("cp -rp $source $destination");
140}
141
142sub move {
143   my $self = shift;
144   my ($source, $destination) = @_;
145
146   $self->brik_help_run_undef_arg('move', $source) or return;
147   $self->brik_help_run_undef_arg('move', $destination) or return;
148
149   my $r = File::Copy::mv($source, $destination);
150   if (! $r) {
151      return $self->log->error("move: failed moving [$source] to [$destination]: error [$!]");
152   }
153
154   return $destination;
155}
156
157sub remove {
158   my $self = shift;
159   my ($file) = @_;
160
161   $self->brik_help_run_undef_arg('remove', $file) or return;
162   my $ref = $self->brik_help_run_invalid_arg('remove', $file, 'ARRAY', 'SCALAR')
163      or return;
164
165   if ($ref eq 'ARRAY') {
166      for my $this (@$file) {
167         unlink($this) or $self->log->warning("remove: unable to unlink file [$file]: $!");
168      }
169   }
170   else {
171      unlink($file) or return $self->log->warning("remove: unable to unlink file [$file]: $!");
172   }
173
174   return $file;
175}
176
177sub rename {
178   my $self = shift;
179   my ($source, $destination) = @_;
180
181   $self->brik_help_run_undef_arg('rename', $source) or return;
182   $self->brik_help_run_undef_arg('rename', $destination) or return;
183
184   my $r = File::Copy::mv($source, $destination);
185   if (! $r) {
186      return $self->log->error("rename: failed rename [$source] to [$destination]: error [$!]");
187   }
188
189   return $destination;
190}
191
192sub cat {
193#File::Spec->catfile(source, dest)
194}
195
196sub create {
197   my $self = shift;
198   my ($file, $size) = @_;
199
200   $self->brik_help_run_undef_arg('create', $file) or return;
201   $self->brik_help_run_undef_arg('create', $size) or return;
202
203   my $overwrite = $self->overwrite;
204   if (-f $file && ! $self->overwrite) {
205      return $self->log->error("create: file [$file] already exists, use overwrite Attribute");
206   }
207
208   if (-f $file) {
209      $self->remove($file) or return;
210   }
211
212   my $fw = Metabrik::File::Write->new_from_brik_init($self) or return;
213   $fw->overwrite(1);
214   $fw->open($file) or return;
215   if ($size > 0) {
216      $fw->write(sprintf("G"x$size));
217   }
218   else {
219      $fw->write('');
220   }
221   $fw->close;
222
223   return $file;
224}
225
226sub glob {
227   my $self = shift;
228   my ($pattern) = @_;
229
230   $self->brik_help_run_undef_arg('glob', $pattern) or return;
231
232   my @list = CORE::glob("$pattern");
233
234   return \@list;
235}
236
237sub is_relative {
238   my $self = shift;
239   my ($path) = @_;
240
241   $self->brik_help_run_undef_arg('is_relative', $path) or return;
242
243   my $r = File::Spec->file_name_is_absolute($path);
244
245   # We negate it, cause we want the opposite of this function
246   return $r ? 0 : 1;
247}
248
249sub is_absolute {
250   my $self = shift;
251   my ($path) = @_;
252
253   $self->brik_help_run_undef_arg('is_absolute', $path) or return;
254
255   # We negate it, cause we want the opposite of this function
256   return $self->is_relative($path) ? 0 : 1;
257}
258
259sub to_absolute_path {
260   my $self = shift;
261   my ($path, $base) = @_;
262
263   $self->brik_help_run_undef_arg('to_absolute_path', $path) or return;
264
265   return File::Spec->rel2abs($path, $base);
266}
267
268#
269# Returns the file part of a path (maybe be a directory)
270#
271sub basefile {
272   my $self = shift;
273   my ($path) = @_;
274
275   $self->brik_help_run_undef_arg('basename', $path) or return;
276
277   # Remove any trailing /
278   $path =~ s{/*$}{};
279
280   my ($volume, $directories, $file) = File::Spec->splitpath($path);
281
282   return $file;
283}
284
285#
286# Returns the directory part of a path
287#
288sub basedir {
289   my $self = shift;
290   my ($path) = @_;
291
292   $self->brik_help_run_undef_arg('basedir', $path) or return;
293
294   # Remove any trailing /
295   $path =~ s{/*$}{};
296
297   my ($volume, $directories, $file) = File::Spec->splitpath($path);
298
299   # Remove any trailing /
300   $directories =~ s{/*$}{};
301
302   return $directories;
303}
304
305#
306# Creates a link from a file to another name
307#
308sub link {
309   my $self = shift;
310   my ($from, $to) = @_;
311
312   $self->brik_help_run_undef_arg('link', $from) or return;
313   $self->brik_help_run_file_not_found('link', $from) or return;
314   $self->brik_help_run_undef_arg('link', $to) or return;
315
316   my $r = symlink($from, $to);
317   if (! defined($r)) {
318      return $self->log->error("link: failed with error: [$!]");
319   }
320
321   return $to;
322}
323
324#
325# Remove duplicated lines
326#
327sub uniq {
328   my $self = shift;
329   my ($input, $output) = @_;
330
331   $self->brik_help_run_undef_arg('uniq', $input) or return;
332   $self->brik_help_run_undef_arg('uniq', $output) or return;
333
334   my $cmd = "sort -u \"$input\" > \"$output\"";
335
336   $self->execute($cmd) or return;
337
338   return $self->count($output);
339}
340
341#
342# Count number of lines from a file
343#
344sub count {
345   my $self = shift;
346   my ($input) = @_;
347
348   $self->brik_help_run_undef_arg('count', $input) or return;
349
350   my $cmd = "wc -l \"$input\"";
351
352   my $r = $self->capture($cmd) or return;
353
354   if (@$r != 1) {
355      return $r;
356   }
357
358   my ($count) = $r->[0] =~ m{^(\d+)};
359
360   return $count;
361}
362
363#
364# Just create an empty file
365#
366sub touch {
367   my $self = shift;
368   my ($file) = @_;
369
370   $self->brik_help_run_undef_arg('touch', $file) or return;
371
372   return $self->create($file, 0);
373}
374
3751;
376
377__END__
378
379=head1 NAME
380
381Metabrik::System::File - system::file Brik
382
383=head1 COPYRIGHT AND LICENSE
384
385Copyright (c) 2014-2017, Patrice E<lt>GomoRE<gt> Auffret
386
387You may distribute this module under the terms of The BSD 3-Clause License.
388See LICENSE file in the source distribution archive.
389
390=head1 AUTHOR
391
392Patrice E<lt>GomoRE<gt> Auffret
393
394=cut
Note: See TracBrowser for help on using the repository browser.