|
1 # Copyright (c) 1997-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
2 # All rights reserved. |
|
3 # This component and the accompanying materials are made available |
|
4 # under the terms of "Eclipse Public License v1.0" |
|
5 # which accompanies this distribution, and is available |
|
6 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
7 # |
|
8 # Initial Contributors: |
|
9 # Nokia Corporation - initial contribution. |
|
10 # |
|
11 # Contributors: |
|
12 # |
|
13 # Description: |
|
14 # General Path and File Utility Functions for use with Makmake |
|
15 # Distinguish paths from filepaths by assuming paths end with "\" |
|
16 # therefore ensure this is the case for all paths coming into programs using this module |
|
17 # |
|
18 # |
|
19 |
|
20 package Pathutl; |
|
21 |
|
22 require Exporter; |
|
23 @ISA=qw(Exporter); |
|
24 |
|
25 @EXPORT=qw( |
|
26 Path_SetVerbose Path_Drive Path_WorkPath Path_RltToWork Path_AbsToWork |
|
27 Path_DelFiles Path_Split Path_Dirs Path_StepDirs Path_Strip |
|
28 Path_MakePathL Path_UpToRoot Path_MakeRlt Path_MakeAbs Path_Chop |
|
29 Path_MakeEAbs Path_Quote Path_MakeRltToBase Path_Norm Path_PrefixWithDrive Path_PrefixWithDriveAndQuote |
|
30 ); |
|
31 |
|
32 use Cwd; |
|
33 use File::Path; # for mkpath |
|
34 |
|
35 my %Mode=( |
|
36 Verbose=>0 |
|
37 ); |
|
38 my $Drive; |
|
39 my $WorkPath; |
|
40 my @WorkPathList; |
|
41 |
|
42 sub Path_SetVerbose () { |
|
43 $Mode{Verbose}=1; |
|
44 } |
|
45 |
|
46 sub Path_Drive () { |
|
47 # return the current drive - programs shouldn't change directory if using this module |
|
48 $Drive; |
|
49 } |
|
50 |
|
51 sub Path_WorkPath () { |
|
52 # return the current working directory - programs shouldn't change directory if using this module |
|
53 $WorkPath; |
|
54 } |
|
55 |
|
56 sub helper_MakeRlt ($@) { |
|
57 # helper function for computing relative path(s) given a base path |
|
58 my ($BaseRef,@List)=@_; |
|
59 foreach my $p (@List) { |
|
60 my $filename=&Path_Split('File',$p); |
|
61 my @plist=&Path_Dirs($p); |
|
62 my $upcount=scalar @{$BaseRef}; |
|
63 foreach (@{$BaseRef}) { |
|
64 if (uc $_ ne uc $plist[0]) { |
|
65 last; |
|
66 } |
|
67 $upcount -= 1; |
|
68 shift @plist; |
|
69 } |
|
70 $p=""; |
|
71 while ($upcount-->0) { |
|
72 $p .= "..\\"; |
|
73 } |
|
74 foreach (@plist) { |
|
75 $p .= "$_\\"; |
|
76 } |
|
77 $p=".\\" if ($p eq ""); # ensure a well-formed result if path == work |
|
78 $p .= $filename; |
|
79 } |
|
80 return wantarray ? @List : $List[0]; |
|
81 } |
|
82 |
|
83 sub Path_RltToWork (@) { |
|
84 # make a path or list of paths relative to the current working directory |
|
85 my @List=@_; |
|
86 @List=&helper_MakeRlt(\@WorkPathList,@List); |
|
87 return wantarray ? @List : $List[0]; |
|
88 } |
|
89 |
|
90 sub Path_MakeRltToBase ($@) { #args: $_[0] Base $_[1]... list of (Abs FilePath/Path) |
|
91 # make a path, or list of paths, relative to a particular directory specified by the first |
|
92 # path passed into the function |
|
93 return undef unless $_[0]=~m-(|\\$)-o; # allow for null value passed in |
|
94 my ($Base,@List)=@_; |
|
95 my @BasePathList=&Path_Dirs($Base); |
|
96 @List=&helper_MakeRlt(\@BasePathList,@List); |
|
97 return wantarray ? @List : $List[0]; |
|
98 } |
|
99 |
|
100 sub Path_AbsToWork (@) { |
|
101 # make a path or list of paths relative to the current working directory absolute |
|
102 my @List=@_; |
|
103 @List=&Path_MakeAbs($WorkPath,@List); |
|
104 return wantarray ? @List : $List[0]; |
|
105 } |
|
106 |
|
107 sub Path_DelFiles (@) { |
|
108 # delete a list of files |
|
109 my @List=@_; |
|
110 my $File; |
|
111 foreach $File (@List) { |
|
112 if (unlink $File) { |
|
113 if ($Mode{Verbose}) { |
|
114 print "Deleted File: \"$File\"\n"; |
|
115 } |
|
116 next; |
|
117 } |
|
118 if ($Mode{Verbose}) { |
|
119 print "Not Found: \"$File\"\n"; |
|
120 } |
|
121 } |
|
122 } |
|
123 |
|
124 sub Path_Split ($$) { #args: $_[0] 'Path' or 'Base' or 'Ext' $_[1] Abs/Rel FilePath/Path |
|
125 # return the section of a file path required - Path, Base, Ext or File |
|
126 my ($Sect,$P)=@_; |
|
127 |
|
128 return '' if !$P; |
|
129 |
|
130 $Sect= ucfirst lc $Sect; |
|
131 if ($Sect eq 'Path') { |
|
132 if ($P=~/^(.*\\)/o) { |
|
133 return $1; |
|
134 } |
|
135 return ''; |
|
136 } |
|
137 if ($Sect eq 'Base') { |
|
138 if ($P=~/\\?([^\\]*?)(\.[^\\\.]*)?$/o) { |
|
139 return $1; |
|
140 } |
|
141 return ''; |
|
142 } |
|
143 if ($Sect eq 'Ext') { |
|
144 if ($P=~/(\.[^\\\.]*)$/o) { |
|
145 return $1; |
|
146 } |
|
147 return ''; |
|
148 } |
|
149 if ($Sect eq 'File') { |
|
150 if ($P=~/([^\\]*)$/o) { |
|
151 return $1; |
|
152 } |
|
153 return ''; |
|
154 } |
|
155 undef; |
|
156 } |
|
157 |
|
158 sub Path_Dirs ($) { #args: $_[0] Abs FilePath/Path |
|
159 # return an ordered list of individual directories that make up a path |
|
160 return undef unless $_[0]=~m-^\\-o; |
|
161 my $P=&Path_Split('Path',$_[0]); |
|
162 return undef unless $P=~s-^(.*)\\$-$1-o; |
|
163 $P=~s-^\\(.*)-$1-o; |
|
164 split /\\/,$P; |
|
165 } |
|
166 |
|
167 sub Path_StepDirs ($) { #args: $_[0] Abs FilePath/Path |
|
168 # return an ordered list of paths - starting with the directory in the root directory from the |
|
169 # path passed into the function, each subsequent path contains the next directory from the path |
|
170 # passed into the function, and the last path is the same as the path passed into the function |
|
171 return undef unless $_[0]=~m-^\\-o; |
|
172 my $P=$_[0]; |
|
173 my @Dirs=&Path_Dirs($P); |
|
174 my @StepDirs; |
|
175 my $dir; |
|
176 my $stepDir="\\"; |
|
177 foreach $dir (@Dirs) { |
|
178 $stepDir.="$dir\\"; |
|
179 push @StepDirs, $stepDir; |
|
180 } |
|
181 @StepDirs; |
|
182 } |
|
183 |
|
184 sub Path_Strip ($) { #args: $_[0] Abs FilePath/Path |
|
185 # Remove excess occurrences of '..' and '.' from a path |
|
186 return undef unless $_[0]=~m-^\\-o; |
|
187 my $P=$_[0]; |
|
188 while ($P=~s-\\\.\\-\\-go) { } |
|
189 while ($P=~s-\\(?!\.{2}\\)[^\\]*\\\.{2}(?=\\)--go) { } |
|
190 $P; |
|
191 } |
|
192 |
|
193 sub Path_MakePathL (@) { #args: @_ list of Abs FilePath/Path |
|
194 # make a directory or list of directories |
|
195 my @Paths=@_; |
|
196 my $P; |
|
197 foreach $P (@Paths) { |
|
198 return undef unless $P=~m-^\\-o; |
|
199 $P=&Path_Split('Path',$P); |
|
200 $P=&Path_Strip($P); |
|
201 $P=~m-(.*)\\-o; |
|
202 if (-d $1) { |
|
203 if ($Mode{'Verbose'}) { |
|
204 print "Existing Path: \"$P\"\n"; |
|
205 } |
|
206 next; |
|
207 } |
|
208 mkpath[$P]; |
|
209 if ($Mode{'Verbose'}) { |
|
210 print "Created Path: \"$P\"\n"; |
|
211 } |
|
212 } |
|
213 return wantarray ? @Paths : $Paths[0]; |
|
214 } |
|
215 |
|
216 sub Path_UpToRoot ($) { #args: $_[0] Abs FilePath/Path |
|
217 # return the path that will lead from the directory the path passed into the function |
|
218 # specifies back up to the root directory |
|
219 return undef unless $_[0]=~m-^\\-o; |
|
220 my $Path=$_[0]; |
|
221 my $UpP; |
|
222 while ($Path=~m-\\-go) { |
|
223 $UpP.="..\\"; |
|
224 } |
|
225 undef $Path; |
|
226 $UpP=~s-^(.*)\.\.\\-$1-o; |
|
227 $UpP=".\\" unless $UpP; |
|
228 } |
|
229 |
|
230 sub Path_MakeRlt ($@) { #args: $_[0] Start UpPath $_[1]... list of (Abs FilePath/Path) |
|
231 # make a path, or list of paths, relative to a particular directory specified by the first |
|
232 # path passed into the function which leads upwards from a particular directory |
|
233 return undef unless $_[0]=~m-(|\\$)-o; # allow for null value passed in |
|
234 my ($UpPath,@List)=@_; |
|
235 my $p; |
|
236 foreach $p (@List) { |
|
237 return undef unless $p=~m-^\\-o; |
|
238 $p=~s-^\\(.*)$-$1-o; |
|
239 $p=$UpPath.$p; |
|
240 } |
|
241 return wantarray ? @List : $List[0]; |
|
242 } |
|
243 |
|
244 sub Path_MakeAbs ($@) { #args: $_[0] Start Abs FilePath/Path $_[1]... list of (Abs/Rel FilePath/Path) |
|
245 # make a path, or list of paths, absolute given the directory specified by the first path |
|
246 # passed into the function which the other paths passed into the function are assumed to be |
|
247 # relative to |
|
248 return undef unless $_[0]=~m-^\\-o; |
|
249 my ($Path,@List)=@_; |
|
250 my $BasePath=&Path_Split("Path",$Path); |
|
251 undef $Path; |
|
252 my $p; |
|
253 foreach $p (@List) { |
|
254 if ($p=~m-^\.{2}-o) { |
|
255 $p=&Path_Strip($BasePath.$p); |
|
256 next; |
|
257 } |
|
258 if ($p=~m-^[^\.\\]-o) { |
|
259 $p=&Path_Strip($BasePath.$p); |
|
260 next; |
|
261 } |
|
262 if ($p=~m-^\\-o) { |
|
263 $p=&Path_Strip($p); |
|
264 next; |
|
265 } |
|
266 if ($p=~m-^\.\\(.*)$-o) { |
|
267 $p=&Path_Strip($BasePath.$1); |
|
268 next; |
|
269 } |
|
270 return undef; |
|
271 } |
|
272 return wantarray ? @List : $List[0]; |
|
273 } |
|
274 |
|
275 sub Path_MakeEAbs ($@) { #args: $_[0] Start EPOCPath Abs FilePath/Path $_[1]... list of (Abs/Rel FilePath/Path) |
|
276 # Variant of MakAbs which also maps "+\\" to "${EPOCPath}" |
|
277 return undef unless $_[0]=~m-^\\-o; |
|
278 my ($EPOCPath,$Path,@List)=@_; |
|
279 my $BasePath=&Path_Split("Path",$Path); |
|
280 undef $Path; |
|
281 my $p; |
|
282 foreach $p (@List) { |
|
283 if ($p=~m-^\\epoc32\\(.*)$-io) { # change - special case for existing \\epoc32 references |
|
284 $p=$EPOCPath.$1; |
|
285 next; |
|
286 } |
|
287 if ($p=~m-^\s*\+\\(.*)$-o) { |
|
288 $p=$EPOCPath.$1; |
|
289 next; |
|
290 } |
|
291 if ($p=~m-^\.{2}-o) { |
|
292 $p=&Path_Strip($BasePath.$p); |
|
293 next; |
|
294 } |
|
295 if ($p=~m-^[^\.\\]-o) { |
|
296 $p=$BasePath.$p; |
|
297 next; |
|
298 } |
|
299 if ($p=~m-^\\-o) { |
|
300 next; |
|
301 } |
|
302 if ($p=~m-^\.\\(.*)$-o) { |
|
303 $p=&Path_Strip($BasePath.$1); |
|
304 next; |
|
305 } |
|
306 return undef; |
|
307 } |
|
308 return wantarray ? @List : $List[0]; |
|
309 } |
|
310 |
|
311 sub Path_Chop (@) { |
|
312 # remove the terminating backslash from a path, or list of paths, if there is one |
|
313 my @List=@_; |
|
314 my $Path; |
|
315 foreach $Path (@List) { |
|
316 $Path=~s-^(.*)\\$-$1-o; |
|
317 } |
|
318 return wantarray ? @List : $List[0]; |
|
319 } |
|
320 |
|
321 sub Path_Quote ($) { |
|
322 # Quote name for use in GNU makefiles |
|
323 my @List=@_; |
|
324 my $Path; |
|
325 foreach $Path (@List) { |
|
326 $Path=~s- -\\ -go if (defined($Path)); |
|
327 } |
|
328 return wantarray ? @List : $List[0]; |
|
329 } |
|
330 |
|
331 sub Path_Norm ($) { |
|
332 # Normalise source specified paths for processing |
|
333 my ($Path) = @_; |
|
334 $Path =~ s/\//\\/g; |
|
335 return $Path; |
|
336 } |
|
337 |
|
338 sub Path_PrefixWithDrive ($) { |
|
339 # Take a path, or list of paths, and prefix with drive based on CWD. |
|
340 # Relative paths are just returned. |
|
341 my @List=@_; |
|
342 my $Path; |
|
343 my $Drive=$1 if (cwd =~ /^(.:)/); |
|
344 |
|
345 foreach $Path (@List) { |
|
346 next if ($Path !~ /^\\/); |
|
347 $Path=$Drive.$Path; |
|
348 } |
|
349 |
|
350 return wantarray ? @List : $List[0]; |
|
351 } |
|
352 |
|
353 sub Path_PrefixWithDriveAndQuote ($) { |
|
354 # Take a path, or list of paths, and prefix with drive based on CWD. |
|
355 # Relative paths are just quoted. |
|
356 my @List=@_; |
|
357 my $Path; |
|
358 my $Drive=$1 if (cwd =~ /^(.:)/); |
|
359 |
|
360 foreach $Path (@List) { |
|
361 next if ($Path !~ /^\\/); |
|
362 $Path=$Drive.$Path; |
|
363 } |
|
364 |
|
365 foreach $Path (@List) { |
|
366 $Path="\"".$Path."\""; |
|
367 } |
|
368 |
|
369 return wantarray ? @List : $List[0]; |
|
370 } |
|
371 |
|
372 |
|
373 |
|
374 BEGIN { |
|
375 # get the current working directory |
|
376 $WorkPath=cwd; |
|
377 $WorkPath=~s-/-\\-go; # separator from Perl 5.005_02+ is forward slash |
|
378 $WorkPath=~s/^(.:)//o; # remove drive letter |
|
379 $Drive=$1; |
|
380 $WorkPath=~s-^(.*[^\\])$-$1\\-o; # ensure workpath ends with a backslash |
|
381 @WorkPathList=&Path_Dirs($WorkPath); |
|
382 } |
|
383 |
|
384 1; |