File Coverage

lib/Rex/Helper/Path.pm
Criterion Covered Total %
statement 110 145 75.8
branch 24 46 52.1
condition 6 15 40.0
subroutine 17 17 100.0
pod 0 5 0.0
total 157 228 68.8


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Helper::Path;
6              
7 93     93   252002 use v5.12.5;
  93         345  
8 93     93   545 use warnings;
  93         195  
  93         5094  
9              
10             our $VERSION = '1.14.3'; # VERSION
11              
12 93     93   1986 use Rex::Helper::File::Spec;
  93         186  
  93         2337  
13 93     93   2530 use File::Basename qw(basename dirname);
  93         1125  
  93         7575  
14             require Exporter;
15              
16 93     93   605 use base qw(Exporter);
  93         164  
  93         7295  
17 93     93   738 use vars qw(@EXPORT);
  93         220  
  93         4221  
18 93     93   578 use Cwd 'realpath';
  93         277  
  93         5232  
19              
20             require Rex;
21 93     93   2972 use Rex::Commands;
  93         281  
  93         776  
22             require Rex::Config;
23              
24 93     93   974 use Rex::Interface::Exec;
  93         228  
  93         851  
25 93     93   2643 use Rex::Interface::Fs;
  93         219  
  93         558  
26              
27             @EXPORT = qw(get_file_path get_tmp_file resolv_path parse_path resolve_symlink);
28              
29             set "path_map", {};
30              
31             #
32             # CALL: get_file_path("foo.txt", caller());
33             # RETURNS: module file
34             #
35             sub get_file_path {
36 12     12 0 81 my ( $file_name, $caller_package, $caller_file ) = @_;
37              
38 12         78 $file_name = resolv_path($file_name);
39              
40 12         42 my $ends_with_slash = 0;
41 12 50       64 if ( $file_name =~ m/\/$/ ) {
42 0         0 $ends_with_slash = 1;
43             }
44              
45 12         32 my $has_wildcard = 0;
46 12         371 my $base_name = basename($file_name);
47              
48 12 50       153 if ( $base_name =~ qr{\*} ) {
49 0         0 $has_wildcard = 1;
50 0         0 $file_name = dirname($file_name);
51             }
52              
53             my $fix_path = sub {
54 12     12   35 my ($path) = @_;
55 12         37 $path =~ s:^\./::;
56              
57 12 50       102 if ($has_wildcard) {
58 0         0 $path = Rex::Helper::File::Spec->catfile( $path, $base_name );
59             }
60              
61 12 50       52 if ($ends_with_slash) {
62 0 0       0 if ( $path !~ m/\/$/ ) {
63 0         0 return "$path/";
64             }
65             }
66              
67 12         132 return $path;
68 12         157 };
69              
70 12 50       57 if ( !$caller_package ) {
71 0         0 ( $caller_package, $caller_file ) = caller();
72             }
73              
74             # check if a file in $BASE overwrites the module file
75             # first get the absolute path to the rexfile
76              
77 12   66     94 $::rexfile ||= $0;
78              
79 12 50       51 if ( $caller_file =~ m|^/loader/[^/]+/__Rexfile__.pm$| ) {
80 0         0 $caller_file = $::rexfile;
81             }
82              
83 12         26 my @path_parts;
84 12 50 33     114 if ( $^O =~ m/^MSWin/ && !Rex::is_ssh() ) {
85 0         0 @path_parts = split( /\//, $::rexfile );
86             }
87             else {
88 12         481 @path_parts = split( /\//, realpath($::rexfile) );
89             }
90 12         51 pop @path_parts;
91              
92 12         58 my $real_path = join( '/', @path_parts );
93              
94 12         60 my $map_setting = get("path_map");
95              
96             my %path_map = (
97 12 0       45 map { ( ( substr( $_, -1 ) eq '/' ) ? $_ : "$_/" ) => $map_setting->{$_} }
  0         0  
98             keys %$map_setting
99             );
100              
101 12         73 foreach my $prefix (
102 0         0 sort { length($b) <=> length($a) }
103 0         0 grep { $file_name =~ m/^$_/ } keys %path_map
104             )
105             {
106 0         0 foreach my $pattern ( @{ $path_map{$prefix} } ) {
  0         0  
107 0         0 my $expansion =
108             Rex::Helper::File::Spec->catfile( parse_path($pattern),
109             substr( $file_name, length($prefix) ) );
110              
111 0 0       0 if ( -e $expansion ) {
112 0         0 return $fix_path->($expansion);
113             }
114              
115 0         0 $expansion = Rex::Helper::File::Spec->catfile( $real_path, $expansion );
116 0 0       0 if ( -e $expansion ) {
117 0         0 return $fix_path->($expansion);
118             }
119             }
120             }
121              
122 12 100       204 if ( -e $file_name ) {
123 8         37 return $fix_path->($file_name);
124             }
125              
126 4         34 my $cat_file_name =
127             Rex::Helper::File::Spec->catfile( $real_path, $file_name );
128 4 50       61 if ( -e $cat_file_name ) {
129 0         0 return $fix_path->($cat_file_name);
130             }
131              
132             # walk down the wire to find the file...
133 4         14 my ($old_caller_file) = $caller_file;
134 4         6 my $i = 0;
135 4   33     19 while ( $caller_package && $i <= 50 ) {
136 8         41 ( $caller_package, $caller_file ) = caller($i);
137 8 100       21 if ( !$caller_package ) {
138 4         7 last;
139             }
140              
141 4         15 my $module_path = Rex::get_module_path($caller_package);
142 4         22 $cat_file_name =
143             Rex::Helper::File::Spec->catfile( $module_path, $file_name );
144 4 50       65 if ( -e $cat_file_name ) {
145 0         0 return $fix_path->($cat_file_name);
146             }
147              
148 4         20 $i++;
149             }
150              
151             $file_name =
152 4         133 Rex::Helper::File::Spec->catfile( dirname($old_caller_file), $file_name );
153              
154 4         12 return $fix_path->($file_name);
155             }
156              
157             sub get_tmp_file {
158 915     915 0 18418 return Rex::Helper::File::Spec->join( Rex::Config->get_tmp_dir(),
159             Rex::Commands::get_random( 12, 'a' .. 'z' ) . '.tmp' );
160             }
161              
162             sub resolv_path {
163 1423     1423 0 9180 my ( $path, $local ) = @_;
164              
165 1423 100       9601 if ( $path !~ m/^~/ ) {
166              
167             # path starts not with ~ so we don't need to expand $HOME.
168             # just return it.
169 1421         5356 return $path;
170             }
171              
172 2         8 my $home_path;
173 2         28 require Rex::User;
174 2         20 my $user_o = Rex::User->get;
175              
176 2 100       19 if ($local) {
177 1 50       12 if ( $^O =~ m/^MSWin/ ) {
178              
179             # windows path:
180 0         0 $home_path = $ENV{'USERPROFILE'};
181             }
182             else {
183 1 50       12 if ( $path =~ m/^~([a-zA-Z0-9_][^\/]+)\// ) {
184 0         0 my $user_name = $1;
185 0         0 my %user_info = $user_o->get_user($user_name);
186 0         0 $home_path = $user_info{home};
187 0         0 $path =~ s/^~$user_name/$home_path/;
188             }
189             else {
190 1         5 $home_path = $ENV{'HOME'};
191 1         10 $path =~ s/^~/$home_path/;
192             }
193             }
194             }
195             else {
196 1 50       33 if ( $path =~ m/^~([a-zA-Z0-9_][^\/]+)\// ) {
197 0         0 my $user_name = $1;
198 0         0 my %user_info = $user_o->get_user($user_name);
199 0         0 $home_path = $user_info{home};
200 0         0 $path =~ s/^~$user_name/$home_path/;
201             }
202             else {
203 1         32 my $exec = Rex::Interface::Exec->create;
204 1         5 my $remote_home = $exec->exec("echo \$HOME");
205 1         21 $remote_home =~ s/[\r\n]//gms;
206 1         21 $home_path = $remote_home;
207 1         31 $path =~ s/^~/$home_path/;
208             }
209             }
210              
211 2         58 return $path;
212             }
213              
214             sub parse_path {
215 156     156 0 365 my ( $path_with_macro, $replacement_for ) = @_;
216              
217             my $replace_macros = sub {
218 156     156   336 my ( $path, $substitution_for ) = @_;
219              
220 156         280 my $macro = join q(|), keys %{$substitution_for};
  156         742  
221              
222 156         6792 ( my $substitution = $path ) =~ s/{($macro)}/$substitution_for->{$1}/gmsx;
223              
224 156         625 return $substitution;
225 156         1337 };
226              
227 156   33     1463 $replacement_for->{server} //= Rex::Commands::connection()->server;
228 156   33     1338 $replacement_for->{environment} //= Rex::Commands::environment();
229              
230 156         452 my $replacement_path =
231             $replace_macros->( $path_with_macro, $replacement_for );
232              
233 156 50       684 if ( $replacement_path =~ m/\{([^\}]+)\}/ ) {
234              
235             # if there are still some macros to replace, we need some
236             # information of the system
237              
238 0         0 require Rex::Commands::Gather;
239 0         0 my %hw = Rex::Commands::Gather::get_system_information();
240              
241 0         0 $replacement_path = $replace_macros->( $replacement_path, \%hw );
242             }
243              
244 156         1632 return $replacement_path;
245             }
246              
247             sub resolve_symlink {
248 13     13 0 1609 my $path = shift;
249 13         203 my $fs = Rex::Interface::Fs::create();
250 13         49 my $resolution;
251              
252 13 100       67 if ( $fs->is_symlink($path) ) {
253 12         291 while ( my $link = $fs->readlink($path) ) {
254 13 50       378 if ( $link !~ m/^\// ) {
255 0         0 $path = dirname($path) . "/" . $link;
256             }
257             else {
258 13         50 $path = $link;
259             }
260 13         73 $link = $fs->readlink($link);
261             }
262 12         81 $resolution = $path;
263             }
264              
265 13         474 return $resolution;
266             }
267              
268             1;