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

Last change on this file was 866:f6ad8c136b19, checked in by GomoR <gomor@…>, 10 months ago
  • update: copyright 2017
File size: 8.2 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}
179
180sub cat {
181#File::Spec->catfile(source, dest)
182}
183
184sub create {
185   my $self = shift;
186   my ($file, $size) = @_;
187
188   $self->brik_help_run_undef_arg('create', $file) or return;
189   $self->brik_help_run_undef_arg('create', $size) or return;
190
191   my $overwrite = $self->overwrite;
192   if (-f $file && ! $self->overwrite) {
193      return $self->log->error("create: file [$file] already exists, use overwrite Attribute");
194   }
195
196   if (-f $file) {
197      $self->remove($file) or return;
198   }
199
200   my $fw = Metabrik::File::Write->new_from_brik_init($self) or return;
201   $fw->overwrite(1);
202   $fw->open($file) or return;
203   if ($size > 0) {
204      $fw->write(sprintf("G"x$size));
205   }
206   else {
207      $fw->write('');
208   }
209   $fw->close;
210
211   return $file;
212}
213
214sub glob {
215   my $self = shift;
216   my ($pattern) = @_;
217
218   my @list = CORE::glob("$pattern");
219
220   return \@list;
221}
222
223sub is_relative {
224   my $self = shift;
225   my ($path) = @_;
226
227   $self->brik_help_run_undef_arg('is_relative', $path) or return;
228
229   my $r = File::Spec->file_name_is_absolute($path);
230
231   # We negate it, cause we want the opposite of this function
232   return $r ? 0 : 1;
233}
234
235sub is_absolute {
236   my $self = shift;
237   my ($path) = @_;
238
239   $self->brik_help_run_undef_arg('is_absolute', $path) or return;
240
241   # We negate it, cause we want the opposite of this function
242   return $self->is_relative($path) ? 0 : 1;
243}
244
245sub to_absolute_path {
246   my $self = shift;
247   my ($path, $base) = @_;
248
249   $self->brik_help_run_undef_arg('to_absolute_path', $path) or return;
250
251   return File::Spec->rel2abs($path, $base);
252}
253
254#
255# Returns the file part of a path (maybe be a directory)
256#
257sub basefile {
258   my $self = shift;
259   my ($path) = @_;
260
261   $self->brik_help_run_undef_arg('basename', $path) or return;
262
263   # Remove any trailing /
264   $path =~ s{/*$}{};
265
266   my ($volume, $directories, $file) = File::Spec->splitpath($path);
267
268   return $file;
269}
270
271#
272# Returns the directory part of a path
273#
274sub basedir {
275   my $self = shift;
276   my ($path) = @_;
277
278   $self->brik_help_run_undef_arg('basedir', $path) or return;
279
280   # Remove any trailing /
281   $path =~ s{/*$}{};
282
283   my ($volume, $directories, $file) = File::Spec->splitpath($path);
284
285   # Remove any trailing /
286   $directories =~ s{/*$}{};
287
288   return $directories;
289}
290
291#
292# Creates a link from a file to another name
293#
294sub link {
295   my $self = shift;
296   my ($from, $to) = @_;
297
298   $self->brik_help_run_undef_arg('link', $from) or return;
299   $self->brik_help_run_file_not_found('link', $from) or return;
300   $self->brik_help_run_undef_arg('link', $to) or return;
301
302   my $r = symlink($from, $to);
303   if (! defined($r)) {
304      return $self->log->error("link: failed with error: [$!]");
305   }
306
307   return $to;
308}
309
310#
311# Remove duplicated lines
312#
313sub uniq {
314   my $self = shift;
315   my ($input, $output) = @_;
316
317   $self->brik_help_run_undef_arg('uniq', $input) or return;
318   $self->brik_help_run_undef_arg('uniq', $output) or return;
319
320   my $cmd = "sort -u \"$input\" > \"$output\"";
321
322   $self->execute($cmd) or return;
323
324   return $self->count($output);
325}
326
327#
328# Count number of lines from a file
329#
330sub count {
331   my $self = shift;
332   my ($input) = @_;
333
334   $self->brik_help_run_undef_arg('count', $input) or return;
335
336   my $cmd = "wc -l \"$input\"";
337
338   my $r = $self->capture($cmd) or return;
339
340   if (@$r != 1) {
341      return $r;
342   }
343
344   my ($count) = $r->[0] =~ m{^(\d+)};
345
346   return $count;
347}
348
349#
350# Just create an empty file
351#
352sub touch {
353   my $self = shift;
354   my ($file) = @_;
355
356   $self->brik_help_run_undef_arg('touch', $file) or return;
357
358   return $self->create($file, 0);
359}
360
3611;
362
363__END__
364
365=head1 NAME
366
367Metabrik::System::File - system::file Brik
368
369=head1 COPYRIGHT AND LICENSE
370
371Copyright (c) 2014-2017, Patrice E<lt>GomoRE<gt> Auffret
372
373You may distribute this module under the terms of The BSD 3-Clause License.
374See LICENSE file in the source distribution archive.
375
376=head1 AUTHOR
377
378Patrice E<lt>GomoRE<gt> Auffret
379
380=cut
Note: See TracBrowser for help on using the repository browser.