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 19     19   301 use v5.12.5;
  19         93  
8 19     19   187 use warnings;
  19         69  
  19         1076  
9              
10             our $VERSION = '1.14.2.2'; # TRIAL VERSION
11              
12 19     19   166 use English qw(-no_match_vars);
  19         67  
  19         326  
13 19     19   11750 use Rex::Interface::Exec;
  19         45  
  19         301  
14 19     19   619 use Rex::Helper::File::Spec;
  19         55  
  19         622  
15              
16             sub new {
17 1048     1048 0 3718 my $that = shift;
18 1048   33     9501 my $proto = ref($that) || $that;
19 1048         3410 my $self = {@_};
20              
21 1048         3468 bless( $self, $proto );
22              
23 1048         3716 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 673 my ( $self, $path ) = @_;
42 98         958 ($path) = $self->_normalize_path($path);
43              
44 98         842 $self->_exec("/bin/sh -c '[ -L \"$path\" ]'");
45 98         1556 my $ret = $?;
46              
47 98 100       2588 if ( $ret == 0 ) { return 1; }
  47         1892  
48             }
49              
50             sub ln {
51 3     3 0 55 my ( $self, $from, $to ) = @_;
52              
53 3         102 Rex::Logger::debug("Symlinking files: $to -> $from");
54 3         34 ($from) = $self->_normalize_path($from);
55 3         23 ($to) = $self->_normalize_path($to);
56              
57 3         124 my $exec = Rex::Interface::Exec->create;
58 3         52 $exec->exec("ln -snf $from $to");
59              
60 3 50       57 if ( $? == 0 ) { return 1; }
  3         75  
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 413 my ( $self, $user, $file, @opts ) = @_;
82 25         137 my $options = {@opts};
83 25         359 ($file) = $self->_normalize_path($file);
84              
85 25         301 my $recursive = "";
86 25 50 33     302 if ( exists $options->{"recursive"} && $options->{"recursive"} == 1 ) {
87 0         0 $recursive = " -R ";
88             }
89              
90 25         854 my $exec = Rex::Interface::Exec->create;
91              
92 25 50       453 if ( $exec->can_run( ['chown'] ) ) {
93 25         774 $exec->exec("chown $recursive $user $file");
94              
95 25 50       707 if ( $? == 0 ) { return 1; }
  25         834  
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 426 my ( $self, $group, $file, @opts ) = @_;
108 25         156 my $options = {@opts};
109 25         278 ($file) = $self->_normalize_path($file);
110              
111 25         240 my $recursive = "";
112 25 50 33     227 if ( exists $options->{"recursive"} && $options->{"recursive"} == 1 ) {
113 0         0 $recursive = " -R ";
114             }
115              
116 25         838 my $exec = Rex::Interface::Exec->create;
117              
118 25 50       454 if ( $exec->can_run( ['chgrp'] ) ) {
119 25         727 $exec->exec("chgrp $recursive $group $file");
120              
121 25 50       668 if ( $? == 0 ) { return 1; }
  25         912  
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 550 my ( $self, $mode, $file, @opts ) = @_;
134 33         181 my $options = {@opts};
135 33         480 ($file) = $self->_normalize_path($file);
136              
137 33         557 my $recursive = "";
138 33 50 33     349 if ( exists $options->{"recursive"} && $options->{"recursive"} == 1 ) {
139 0         0 $recursive = " -R ";
140             }
141              
142 33         1000 my $exec = Rex::Interface::Exec->create;
143              
144 33 50       341 if ( $exec->can_run( ['chmod'] ) ) {
145 33         682 $exec->exec("chmod $recursive $mode $file");
146              
147 33 50       736 if ( $? == 0 ) { return 1; }
  33         1295  
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 66 my ( $self, $source, $dest ) = @_;
160 3         45 ($source) = $self->_normalize_path($source);
161 3         49 ($dest) = $self->_normalize_path($dest);
162              
163 3         115 my $exec = Rex::Interface::Exec->create;
164              
165 3 50       86 if ( $OSNAME =~ m/^MSWin/msx ) {
166 0         0 $exec->exec("copy /v /y $source $dest");
167             }
168             else {
169 3         81 $exec->exec("cp -R $source $dest");
170             }
171              
172 3 50       117 if ( $? == 0 ) { return 1; }
  3         180  
173              
174 0 0       0 die("Error copying $source -> $dest") if ( Rex::Config->get_autodie );
175             }
176              
177             sub _normalize_path {
178 272     272   1943 my ( $self, @dirs ) = @_;
179              
180 272         699 my @ret;
181 272         1628 for my $d (@dirs) {
182 272         682 my @t;
183 272 50       1563 if (Rex::is_ssh) {
184 0         0 @t = Rex::Helper::File::Spec->splitdir($d);
185             }
186             else {
187 272         9111 @t = Rex::Helper::File::Spec->splitdir($d);
188             }
189             push( @ret,
190 272         1918 Rex::Helper::File::Spec->catfile( map { $self->_quotepath($_) } @t ) );
  1114         3557  
191             }
192              
193             # for (@dirs) {
194             # s/ /\\ /g;
195             # }
196              
197 272         1417 return @ret;
198             }
199              
200             sub _quotepath {
201 1114     1114   2886 my ( $self, $p ) = @_;
202 1114         3347 $p =~ s/([\@\$\% ])/\\$1/g;
203              
204 1114         5123 return $p;
205             }
206              
207             sub _exec {
208 98     98   372 my ( $self, $cmd ) = @_;
209 98         1821 my $exec = Rex::Interface::Exec->create;
210 98         745 return $exec->exec($cmd);
211             }
212              
213             1;