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