sbsv1/abld/genutil/pathutl.pm
changeset 599 fa7a3cc6effd
equal deleted inserted replaced
596:9f25be3da657 599:fa7a3cc6effd
       
     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;