File Coverage

blib/lib/Metabrik/System/File.pm
Criterion Covered Total %
statement 9 150 6.0
branch 0 102 0.0
condition 0 3 0.0
subroutine 3 25 12.0
pod 1 22 4.5
total 13 302 4.3


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