599
|
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;
|