File Coverage

lib/Rex/Interface/Fs/Base.pm
Criterion Covered Total %
statement 86 123 69.9
branch 15 42 35.7
condition 4 12 33.3
subroutine 15 29 51.7
pod 0 21 0.0
total 120 227 52.8


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Interface::Fs::Base;
6              
7 53     53   884 use v5.12.5;
  53         319  
8 53     53   401 use warnings;
  53         205  
  53         3570  
9              
10             our $VERSION = '1.14.2.3'; # TRIAL VERSION
11              
12 53     53   583 use English qw(-no_match_vars);
  53         230  
  53         1336  
13 53     53   44498 use Rex::Interface::Exec;
  53         199  
  53         971  
14 53     53   2071 use Rex::Helper::File::Spec;
  53         208  
  53         1197  
15              
16             sub new {
17 1260     1260 0 5015 my $that = shift;
18 1260   33     12637 my $proto = ref($that) || $that;
19 1260         5103 my $self = {@_};
20              
21 1260         3668 bless( $self, $proto );
22              
23 1260         5031 return $self;
24             }
25              
26 0     0 0 0 sub ls { die("Must be implemented by Interface Class"); }
27 0     0 0 0 sub unlink { die("Must be implemented by Interface Class"); }
28 0     0 0 0 sub mkdir { die("Must be implemented by Interface Class"); }
29 0     0 0 0 sub glob { die("Must be implemented by Interface Class"); }
30 0     0 0 0 sub rename { die("Must be implemented by Interface Class"); }
31 0     0 0 0 sub stat { die("Must be implemented by Interface Class"); }
32 0     0 0 0 sub readlink { die("Must be implemented by Interface Class"); }
33 0     0 0 0 sub is_file { die("Must be implemented by Interface Class"); }
34 0     0 0 0 sub is_dir { die("Must be implemented by Interface Class"); }
35 0     0 0 0 sub is_readable { die("Must be implemented by Interface Class"); }
36 0     0 0 0 sub is_writable { die("Must be implemented by Interface Class"); }
37 0     0 0 0 sub upload { die("Must be implemented by Interface Class"); }
38 0     0 0 0 sub download { die("Must be implemented by Interface Class"); }
39              
40             sub is_symlink {
41 98     98 0 688 my ( $self, $path ) = @_;
42 98         1199 ($path) = $self->_normalize_path($path);
43              
44 98         673 $self->_exec("/bin/sh -c '[ -L \"$path\" ]'");
45 98         1444 my $ret = $?;
46              
47 98 100       2364 if ( $ret == 0 ) { return 1; }
  47         1563  
48             }
49              
50             sub ln {
51 3     3 0 58 my ( $self, $from, $to ) = @_;
52              
53 3         113 Rex::Logger::debug("Symlinking files: $to -> $from");
54 3         50 ($from) = $self->_normalize_path($from);
55 3         28 ($to) = $self->_normalize_path($to);
56              
57 3         103 my $exec = Rex::Interface::Exec->create;
58 3         37 $exec->exec("ln -snf $from $to");
59              
60 3 50       55 if ( $? == 0 ) { return 1; }
  3         62  
61              
62 0 0       0 die "Error creating symlink. ($from -> $to)" if ( Rex::Config->get_autodie );
63             }
64              
65             sub rmdir {
66 0     0 0 0 my ( $self, @dirs ) = @_;
67              
68 0         0 @dirs = $self->_normalize_path(@dirs);
69              
70 0         0 Rex::Logger::debug( "Removing directories: " . join( ", ", @dirs ) );
71 0         0 my $exec = Rex::Interface::Exec->create;
72 0         0 $exec->exec( "/bin/rm -rf " . join( " ", @dirs ) );
73              
74 0 0       0 if ( $? == 0 ) { return 1; }
  0         0  
75              
76 0 0       0 die( "Error removing directory: " . join( ", ", @dirs ) )
77             if ( Rex::Config->get_autodie );
78             }
79              
80             sub chown {
81 25     25 0 448 my ( $self, $user, $file, @opts ) = @_;
82 25         203 my $options = {@opts};
83 25         334 ($file) = $self->_normalize_path($file);
84              
85 25         290 my $recursive = "";
86 25 50 33     297 if ( exists $options->{"recursive"} && $options->{"recursive"} == 1 ) {
87 0         0 $recursive = " -R ";
88             }
89              
90 25         814 my $exec = Rex::Interface::Exec->create;
91              
92 25 50       345 if ( $exec->can_run( ['chown'] ) ) {
93 25         806 $exec->exec("chown $recursive $user $file");
94              
95 25 50       709 if ( $? == 0 ) { return 1; }
  25         800  
96              
97 0 0       0 die("Error running chown $recursive $user $file")
98             if ( Rex::Config->get_autodie );
99             }
100             else {
101 0         0 Rex::Logger::debug("Can't find `chown`.");
102 0         0 return 1; # fake success for windows
103             }
104             }
105              
106             sub chgrp {
107 25     25 0 481 my ( $self, $group, $file, @opts ) = @_;
108 25         249 my $options = {@opts};
109 25         381 ($file) = $self->_normalize_path($file);
110              
111 25         259 my $recursive = "";
112 25 50 33     208 if ( exists $options->{"recursive"} && $options->{"recursive"} == 1 ) {
113 0         0 $recursive = " -R ";
114             }
115              
116 25         781 my $exec = Rex::Interface::Exec->create;
117              
118 25 50       483 if ( $exec->can_run( ['chgrp'] ) ) {
119 25         668 $exec->exec("chgrp $recursive $group $file");
120              
121 25 50       582 if ( $? == 0 ) { return 1; }
  25         903  
122              
123 0 0       0 die("Error running chgrp $recursive $group $file")
124             if ( Rex::Config->get_autodie );
125             }
126             else {
127 0         0 Rex::Logger::debug("Can't find `chgrp`.");
128 0         0 return 1; # fake success for windows
129             }
130             }
131              
132             sub chmod {
133 33     33 0 475 my ( $self, $mode, $file, @opts ) = @_;
134 33         201 my $options = {@opts};
135 33         505 ($file) = $self->_normalize_path($file);
136              
137 33         377 my $recursive = "";
138 33 50 33     342 if ( exists $options->{"recursive"} && $options->{"recursive"} == 1 ) {
139 0         0 $recursive = " -R ";
140             }
141              
142 33         1057 my $exec = Rex::Interface::Exec->create;
143              
144 33 50       565 if ( $exec->can_run( ['chmod'] ) ) {
145 33         702 $exec->exec("chmod $recursive $mode $file");
146              
147 33 50       600 if ( $? == 0 ) { return 1; }
  33         1292  
148              
149 0 0       0 die("Error running chmod $recursive $mode $file")
150             if ( Rex::Config->get_autodie );
151             }
152             else {
153 0         0 Rex::Logger::debug("Can't find `chmod`.");
154 0         0 return 1; # fake success for windows
155             }
156             }
157              
158             sub cp {
159 3     3 0 24 my ( $self, $source, $dest ) = @_;
160 3         38 ($source) = $self->_normalize_path($source);
161 3         30 ($dest) = $self->_normalize_path($dest);
162              
163 3         65 my $exec = Rex::Interface::Exec->create;
164              
165 3 50       43 if ( $OSNAME =~ m/^MSWin/msx ) {
166 0         0 $exec->exec("copy /v /y $source $dest");
167             }
168             else {
169 3         37 $exec->exec("cp -R $source $dest");
170             }
171              
172 3 50       82 if ( $? == 0 ) { return 1; }
  3         118  
173              
174 0 0       0 die("Error copying $source -> $dest") if ( Rex::Config->get_autodie );
175             }
176              
177             sub _normalize_path {
178 272     272   2131 my ( $self, @dirs ) = @_;
179              
180 272         685 my @ret;
181 272         1654 for my $d (@dirs) {
182 272         700 my @t;
183 272 50       1225 if (Rex::is_ssh) {
184 0         0 @t = Rex::Helper::File::Spec->splitdir($d);
185             }
186             else {
187 272         8960 @t = Rex::Helper::File::Spec->splitdir($d);
188             }
189             push( @ret,
190 272         1677 Rex::Helper::File::Spec->catfile( map { $self->_quotepath($_) } @t ) );
  1114         3459  
191             }
192              
193             # for (@dirs) {
194             # s/ /\\ /g;
195             # }
196              
197 272         1360 return @ret;
198             }
199              
200             sub _quotepath {
201 1114     1114   2926 my ( $self, $p ) = @_;
202 1114         3243 $p =~ s/([\@\$\% ])/\\$1/g;
203              
204 1114         4595 return $p;
205             }
206              
207             sub _exec {
208 98     98   280 my ( $self, $cmd ) = @_;
209 98         1678 my $exec = Rex::Interface::Exec->create;
210 98         710 return $exec->exec($cmd);
211             }
212              
213             1;