source: repository/lib/Metabrik/System/File.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: 8.7 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         kali => [ qw(coreutils) ],
56      },
57      require_binaries => {
58         sort => [ ],
59         wc => [ ],
60      },
61   };
62}
63
64sub mkdir {
65   my $self = shift;
66   my ($path) = @_;
67
68   $self->brik_help_run_undef_arg('mkdir', $path) or return;
69
70   my $no_error = 1;
71   File::Path::make_path($path, { error => \my $error });
72   if ($error) {
73      for my $this (@$error) {
74         my ($file, $message) = %$this;
75         if ($file eq '') {
76            return $self->log->error("mkdir: make_path failed with error [$message]");
77         }
78         else {
79            $self->log->warning("mkdir: error creating directory [$file]: error [$error]");
80            $no_error = 0;
81         }
82      }
83   }
84
85   return $no_error;
86}
87
88sub rmdir {
89}
90
91sub chmod {
92   my $self = shift;
93   my ($file, $perms) = @_;
94
95   $self->brik_help_run_undef_arg('chmod', $file) or return;
96   my $ref = $self->brik_help_run_invalid_arg('chmod', $file, 'SCALAR', 'ARRAY')
97      or return;
98   $self->brik_help_run_undef_arg('chmod', $perms) or return;
99
100   my $r;
101   if ($ref eq 'ARRAY') {
102      $r = CORE::chmod(oct($perms), @$file);
103   }
104   else {
105      $r = CORE::chmod(oct($perms), $file);
106   }
107
108   if (! $r) {
109      return $self->log->error("chmod: failed to chmod file [$file]: $!");
110   }
111
112   return $file;
113}
114
115sub chgrp {
116}
117
118sub copy {
119   my $self = shift;
120   my ($source, $destination) = @_;
121
122   $self->brik_help_run_undef_arg('copy', $source) or return;
123   $self->brik_help_run_undef_arg('copy', $destination) or return;
124
125   my $r = File::Copy::copy($source, $destination);
126   if (! $r) {
127      return $self->log->error("copy: failed copying [$source] to [$destination]: error [$!]");
128   }
129
130   return $destination;
131}
132
133sub sudo_copy {
134   my $self = shift;
135   my ($source, $destination) = @_;
136
137   $self->brik_help_run_undef_arg('sudo_copy', $source) or return;
138   $self->brik_help_run_undef_arg('sudo_copy', $destination) or return;
139
140   return $self->sudo_execute("cp -rp $source $destination");
141}
142
143sub move {
144   my $self = shift;
145   my ($source, $destination) = @_;
146
147   $self->brik_help_run_undef_arg('move', $source) or return;
148   $self->brik_help_run_undef_arg('move', $destination) or return;
149
150   my $r = File::Copy::mv($source, $destination);
151   if (! $r) {
152      return $self->log->error("move: failed moving [$source] to [$destination]: error [$!]");
153   }
154
155   return $destination;
156}
157
158sub remove {
159   my $self = shift;
160   my ($file) = @_;
161
162   $self->brik_help_run_undef_arg('remove', $file) or return;
163   my $ref = $self->brik_help_run_invalid_arg('remove', $file, 'ARRAY', 'SCALAR')
164      or return;
165
166   if ($ref eq 'ARRAY') {
167      for my $this (@$file) {
168         unlink($this) or $self->log->warning("remove: unable to unlink file [$file]: $!");
169      }
170   }
171   else {
172      unlink($file) or return $self->log->warning("remove: unable to unlink file [$file]: $!");
173   }
174
175   return $file;
176}
177
178sub rename {
179   my $self = shift;
180   my ($source, $destination) = @_;
181
182   $self->brik_help_run_undef_arg('rename', $source) or return;
183   $self->brik_help_run_undef_arg('rename', $destination) or return;
184
185   my $r = File::Copy::mv($source, $destination);
186   if (! $r) {
187      return $self->log->error("rename: failed rename [$source] to [$destination]: error [$!]");
188   }
189
190   return $destination;
191}
192
193sub cat {
194#File::Spec->catfile(source, dest)
195}
196
197sub create {
198   my $self = shift;
199   my ($file, $size) = @_;
200
201   $self->brik_help_run_undef_arg('create', $file) or return;
202   $self->brik_help_run_undef_arg('create', $size) or return;
203
204   my $overwrite = $self->overwrite;
205   if (-f $file && ! $self->overwrite) {
206      return $self->log->error("create: file [$file] already exists, use overwrite Attribute");
207   }
208
209   if (-f $file) {
210      $self->remove($file) or return;
211   }
212
213   my $fw = Metabrik::File::Write->new_from_brik_init($self) or return;
214   $fw->overwrite(1);
215   $fw->open($file) or return;
216   if ($size > 0) {
217      $fw->write(sprintf("G"x$size));
218   }
219   else {
220      $fw->write('');
221   }
222   $fw->close;
223
224   return $file;
225}
226
227sub glob {
228   my $self = shift;
229   my ($pattern) = @_;
230
231   $self->brik_help_run_undef_arg('glob', $pattern) or return;
232
233   my @list = CORE::glob("$pattern");
234
235   return \@list;
236}
237
238sub is_relative {
239   my $self = shift;
240   my ($path) = @_;
241
242   $self->brik_help_run_undef_arg('is_relative', $path) or return;
243
244   my $r = File::Spec->file_name_is_absolute($path);
245
246   # We negate it, cause we want the opposite of this function
247   return $r ? 0 : 1;
248}
249
250sub is_absolute {
251   my $self = shift;
252   my ($path) = @_;
253
254   $self->brik_help_run_undef_arg('is_absolute', $path) or return;
255
256   # We negate it, cause we want the opposite of this function
257   return $self->is_relative($path) ? 0 : 1;
258}
259
260sub to_absolute_path {
261   my $self = shift;
262   my ($path, $base) = @_;
263
264   $self->brik_help_run_undef_arg('to_absolute_path', $path) or return;
265
266   return File::Spec->rel2abs($path, $base);
267}
268
269#
270# Returns the file part of a path (maybe be a directory)
271#
272sub basefile {
273   my $self = shift;
274   my ($path) = @_;
275
276   $self->brik_help_run_undef_arg('basename', $path) or return;
277
278   # Remove any trailing /
279   $path =~ s{/*$}{};
280
281   my ($volume, $directories, $file) = File::Spec->splitpath($path);
282
283   return $file;
284}
285
286#
287# Returns the directory part of a path
288#
289sub basedir {
290   my $self = shift;
291   my ($path) = @_;
292
293   $self->brik_help_run_undef_arg('basedir', $path) or return;
294
295   # Remove any trailing /
296   $path =~ s{/*$}{};
297
298   my ($volume, $directories, $file) = File::Spec->splitpath($path);
299
300   # Remove any trailing /
301   $directories =~ s{/*$}{};
302
303   return $directories;
304}
305
306#
307# Creates a link from a file to another name
308#
309sub link {
310   my $self = shift;
311   my ($from, $to) = @_;
312
313   $self->brik_help_run_undef_arg('link', $from) or return;
314   $self->brik_help_run_file_not_found('link', $from) or return;
315   $self->brik_help_run_undef_arg('link', $to) or return;
316
317   my $r = symlink($from, $to);
318   if (! defined($r)) {
319      return $self->log->error("link: failed with error: [$!]");
320   }
321
322   return $to;
323}
324
325#
326# Remove duplicated lines
327#
328sub uniq {
329   my $self = shift;
330   my ($input, $output) = @_;
331
332   $self->brik_help_run_undef_arg('uniq', $input) or return;
333   $self->brik_help_run_undef_arg('uniq', $output) or return;
334
335   my $cmd = "sort -u \"$input\" > \"$output\"";
336
337   $self->execute($cmd) or return;
338
339   return $self->count($output);
340}
341
342#
343# Count number of lines from a file
344#
345sub count {
346   my $self = shift;
347   my ($input) = @_;
348
349   $self->brik_help_run_undef_arg('count', $input) or return;
350
351   my $cmd = "wc -l \"$input\"";
352
353   my $r = $self->capture($cmd) or return;
354
355   if (@$r != 1) {
356      return $r;
357   }
358
359   my ($count) = $r->[0] =~ m{^(\d+)};
360
361   return $count;
362}
363
364#
365# Just create an empty file
366#
367sub touch {
368   my $self = shift;
369   my ($file) = @_;
370
371   $self->brik_help_run_undef_arg('touch', $file) or return;
372
373   return $self->create($file, 0);
374}
375
3761;
377
378__END__
379
380=head1 NAME
381
382Metabrik::System::File - system::file Brik
383
384=head1 COPYRIGHT AND LICENSE
385
386Copyright (c) 2014-2019, Patrice E<lt>GomoRE<gt> Auffret
387
388You may distribute this module under the terms of The BSD 3-Clause License.
389See LICENSE file in the source distribution archive.
390
391=head1 AUTHOR
392
393Patrice E<lt>GomoRE<gt> Auffret
394
395=cut
Note: See TracBrowser for help on using the repository browser.