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   281192 use v5.12.5;
  93         444  
8 93     93   552 use warnings;
  93         213  
  93         4035  
9              
10             our $VERSION = '1.14.2.2'; # TRIAL VERSION
11              
12 93     93   3350 use Rex::Helper::File::Spec;
  93         186  
  93         2277  
13 93     93   2607 use File::Basename qw(basename dirname);
  93         222  
  93         7682  
14             require Exporter;
15              
16 93     93   699 use base qw(Exporter);
  93         380  
  93         7693  
17 93     93   619 use vars qw(@EXPORT);
  93         217  
  93         4323  
18 93     93   614 use Cwd 'realpath';
  93         424  
  93         5733  
19              
20             require Rex;
21 93     93   3024 use Rex::Commands;
  93         224  
  93         2087  
22             require Rex::Config;
23              
24 93     93   1003 use Rex::Interface::Exec;
  93         235  
  93         903  
25 93     93   2742 use Rex::Interface::Fs;
  93         1519  
  93         607  
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 118 my ( $file_name, $caller_package, $caller_file ) = @_;
37              
38 12         98 $file_name = resolv_path($file_name);
39              
40 12         47 my $ends_with_slash = 0;
41 12 50       85 if ( $file_name =~ m/\/$/ ) {
42 0         0 $ends_with_slash = 1;
43             }
44              
45 12         29 my $has_wildcard = 0;
46 12         494 my $base_name = basename($file_name);
47              
48 12 50       217 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   51 my ($path) = @_;
55 12         44 $path =~ s:^\./::;
56              
57 12 50       42 if ($has_wildcard) {
58 0         0 $path = Rex::Helper::File::Spec->catfile( $path, $base_name );
59             }
60              
61 12 50       50 if ($ends_with_slash) {
62 0 0       0 if ( $path !~ m/\/$/ ) {
63 0         0 return "$path/";
64             }
65             }
66              
67 12         164 return $path;
68 12         196 };
69              
70 12 50       70 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     121 $::rexfile ||= $0;
78              
79 12 50       70 if ( $caller_file =~ m|^/loader/[^/]+/__Rexfile__.pm$| ) {
80 0         0 $caller_file = $::rexfile;
81             }
82              
83 12         38 my @path_parts;
84 12 50 33     81 if ( $^O =~ m/^MSWin/ && !Rex::is_ssh() ) {
85 0         0 @path_parts = split( /\//, $::rexfile );
86             }
87             else {
88 12         562 @path_parts = split( /\//, realpath($::rexfile) );
89             }
90 12         116 pop @path_parts;
91              
92 12         95 my $real_path = join( '/', @path_parts );
93              
94 12         92 my $map_setting = get("path_map");
95              
96             my %path_map = (
97 12 0       52 map { ( ( substr( $_, -1 ) eq '/' ) ? $_ : "$_/" ) => $map_setting->{$_} }
  0         0  
98             keys %$map_setting
99             );
100              
101 12         90 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       305 if ( -e $file_name ) {
123 8         51 return $fix_path->($file_name);
124             }
125              
126 4         36 my $cat_file_name =
127             Rex::Helper::File::Spec->catfile( $real_path, $file_name );
128 4 50       73 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         15 my ($old_caller_file) = $caller_file;
134 4         7 my $i = 0;
135 4   33     22 while ( $caller_package && $i <= 50 ) {
136 8         46 ( $caller_package, $caller_file ) = caller($i);
137 8 100       20 if ( !$caller_package ) {
138 4         9 last;
139             }
140              
141 4         13 my $module_path = Rex::get_module_path($caller_package);
142 4         21 $cat_file_name =
143             Rex::Helper::File::Spec->catfile( $module_path, $file_name );
144 4 50       131 if ( -e $cat_file_name ) {
145 0         0 return $fix_path->($cat_file_name);
146             }
147              
148 4         22 $i++;
149             }
150              
151             $file_name =
152 4         134 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 916     916 0 22925 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 1211     1211 0 8456 my ( $path, $local ) = @_;
164              
165 1211 100       8110 if ( $path !~ m/^~/ ) {
166              
167             # path starts not with ~ so we don't need to expand $HOME.
168             # just return it.
169 1209         4714 return $path;
170             }
171              
172 2         6 my $home_path;
173 2         32 require Rex::User;
174 2         25 my $user_o = Rex::User->get;
175              
176 2 100       16 if ($local) {
177 1 50       5 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         5 $path =~ s/^~/$home_path/;
192             }
193             }
194             }
195             else {
196 1 50       21 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         23 my $exec = Rex::Interface::Exec->create;
204 1         10 my $remote_home = $exec->exec("echo \$HOME");
205 1         28 $remote_home =~ s/[\r\n]//gms;
206 1         13 $home_path = $remote_home;
207 1         23 $path =~ s/^~/$home_path/;
208             }
209             }
210              
211 2         56 return $path;
212             }
213              
214             sub parse_path {
215 156     156 0 374 my ( $path_with_macro, $replacement_for ) = @_;
216              
217             my $replace_macros = sub {
218 156     156   327 my ( $path, $substitution_for ) = @_;
219              
220 156         250 my $macro = join q(|), keys %{$substitution_for};
  156         776  
221              
222 156         7293 ( my $substitution = $path ) =~ s/{($macro)}/$substitution_for->{$1}/gmsx;
223              
224 156         686 return $substitution;
225 156         1308 };
226              
227 156   33     1390 $replacement_for->{server} //= Rex::Commands::connection()->server;
228 156   33     1467 $replacement_for->{environment} //= Rex::Commands::environment();
229              
230 156         451 my $replacement_path =
231             $replace_macros->( $path_with_macro, $replacement_for );
232              
233 156 50       703 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         1780 return $replacement_path;
245             }
246              
247             sub resolve_symlink {
248 13     13 0 2061 my $path = shift;
249 13         238 my $fs = Rex::Interface::Fs::create();
250 13         81 my $resolution;
251              
252 13 100       70 if ( $fs->is_symlink($path) ) {
253 12         536 while ( my $link = $fs->readlink($path) ) {
254 13 50       407 if ( $link !~ m/^\// ) {
255 0         0 $path = dirname($path) . "/" . $link;
256             }
257             else {
258 13         69 $path = $link;
259             }
260 13         68 $link = $fs->readlink($link);
261             }
262 12         80 $resolution = $path;
263             }
264              
265 13         525 return $resolution;
266             }
267              
268             1;