Subversion Repositories DevTools

Rev

Rev 6198 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 6198 Rev 6276
Line 151... Line 151...
151 
sub ConfigLoad
 151 
sub ConfigLoad
152 
{
 152 
{
153 
   ReadBuildConfig("$::ScmRoot/$::ScmInterface", $::ScmPlatform );
 153 
   ReadBuildConfig("$::ScmRoot/$::ScmInterface", $::ScmPlatform );
154 
}
 154 
}
155 
 
 155 
 
- 
 
 156 
#-------------------------------------------------------------------------------
- 
 
 157 
# Function        : ExpandPlatforms
156 
 
 158 
#
- 
 
 159 
# Description     : Expand a user provided platform list and resolve aliases
- 
 
 160 
#                   Note: Need to avoid recusion
- 
 
 161 
#                         ie: Alias AAA -> BBB, CCC, AAA is allowed
- 
 
 162 
#                         because alias have already been expanded
157 
#   ExpandPlatforms ---
 163 
#
- 
 
 164 
#                         Use. The SOLARIS alias expands to several alias including SOLARIS
- 
 
 165 
#                              The expanded SOLARIS is actually a PLATFORM
- 
 
 166 
#                              I know it sucks - backward compatability always does
- 
 
 167 
#
- 
 
 168 
#                   Alias information will come from one of two places
- 
 
 169 
#
158 
#       Expand a platform list applying aliases.
 170 
# Inputs          : A list of platforms, aliases and options
- 
 
 171 
#
- 
 
 172 
# Returns         : A list of platforms
159 
#..
 173 
#
160 
 
 174 
 
161 
sub ExpandPlatforms
 175 
sub ExpandPlatforms
162 
{
 176 
{
163 
    our( @_expandarg ) = @_;
 177 
    our( @_expandarg ) = @_;
164 
    our( @_expandresult, $_expandnest );
 178 
    our @_expandresult = ();
- 
 
 179 
    our $_expandnest = 0;
165 
 
 180 
 
- 
 
 181 
    #
166 
    @_expandresult = ();
 182 
    #   Use one of
167 
    $_expandnest = 0;
 183 
    #       BUILDALIAS - as setup by buildfile.pl
- 
 
 184 
    #       ScmBuildAliases - makelib.pl and makelib.pl2
- 
 
 185 
    #
- 
 
 186 
    our %_Aliases = %::ScmBuildAliases ? %::ScmBuildAliases : %::BUILDALIAS;
168 
 
 187 
 
169 
    Debug3( "ExpandPlatforms(@_)" );
 188 
    Debug3( "ExpandPlatforms(@_)" );
- 
 
 189 
#    DebugTraceBack( "ExpandPlatforms(@_)" );
- 
 
 190 
#    DebugDumpData("Aliases",\%_Aliases);
170 
 
 191 
 
171 
    sub ExpandPlatform
 192 
    sub ExpandPlatform
172 
    {
 193 
    {
173 
        sub ExpandAlias
 194 
        sub ExpandAlias
174 
        {
 195 
        {
175 
            my( $key ) = @_;
 196 
            my( $key ) = @_;
176 
 
 197 
 
177 
            if (%::BUILDALIAS)         # buildlib.pl
 - 
 
178 
            {
 - 
 
179 
                return ExpandPlatform( split( ' ', $::BUILDALIAS{ $key } ) )
 - 
 
180 
                    if ( $key !~ /^--/ && $::BUILDALIAS{ $key } );
 - 
 
181 
            }
 - 
 
182 
            else
 - 
 
183 
            {
 - 
 
184 
                return $key                     # argument || no aliases
 - 
 
185 
                    if ( $key =~ /^--/ || !(%::ScmBuildAliases) );
 - 
 
186 
 
 198 
 
- 
 
 199 
            return $key                     # argument || no aliases
- 
 
 200 
                if ( $key =~ /^--/ || !(%_Aliases) );
- 
 
 201 
 
187 
                return ExpandPlatform( split( ' ', $::ScmBuildAliases{ $key } ) )
 202 
            return ExpandPlatform( split( ' ', $_Aliases{ $key } ) )
188 
                    if ( $::ScmBuildAliases{ $key } );
 203 
                if ( exists $_Aliases{ $key } );
189 
            }
 - 
 
190 
 
 204 
 
191 
            return $key;
 205 
            return $key;
192 
        }
 206 
        }
193 
 
 207 
 
194 
        sub ExpandPush
 208 
        sub ExpandPush
Line 243... Line 257...
243 
    foreach (@_expandarg) {                      # break out embedded args
 257 
    foreach (@_expandarg) {                      # break out embedded args
244 
        if ( /^--/ ) {
 258 
        if ( /^--/ ) {
245 
            push @_expandresult, $_;
 259 
            push @_expandresult, $_;
246 
 
 260 
 
247 
        } else {
 261 
        } else {
248
- 
 
249 
            push @_expandresult, split( ',', $_ );
 262 
            push @_expandresult, split( ',', $_ );
250 
        }
 263 
        }
251 
    }
 264 
    }
252 
 
 265 
 
253 
    @_expandresult = ExpandPlatform( @_expandresult );
 266 
    @_expandresult = ExpandPlatform( @_expandresult );
Line 279... Line 292...
279 
#
 292 
#
280 
#       a)  Exists( "/mypath", "Myfile", "stuff" );
 293 
#       a)  Exists( "/mypath", "Myfile", "stuff" );
281 
#
 294 
#
282 
#           Resolve the name of the file called "myfile" within the
 295 
#           Resolve the name of the file called "myfile" within the
283 
#           directory "/mypath", using the following matching order
 296 
#           directory "/mypath", using the following matching order
284 
#
 297 
#
285 
#               1.  "/mypath/Myfile".       As supplied.
 298 
#               1.  "/mypath/Myfile". As supplied.
286 
#               2.  "/mypath/myfile".       then Lower case
 299 
#               2.  Scan "/mypath" for all files and perform a case
287 
#               3.  "/mypath/MYFILE".       and finally upper case.
 300 
#                   insensitive comparison for MYFILE.
288 
#
 301 
#
289 
#           Upon being not found displays the message
 302 
#           Upon being not found displays the message
290 
#
 303 
#
291 
#               "stuff (/mypath/Myfile) not found".
 304 
#               "stuff (/mypath/Myfile) not found".
292 
#
 305 
#
Line 296... Line 309...
296 
#           Resolve the name of the file called "Myfile" within the
 309 
#           Resolve the name of the file called "Myfile" within the
297 
#           set of directories "/dir1/cfg/" and "/dir2/cfg/", using
 310 
#           set of directories "/dir1/cfg/" and "/dir2/cfg/", using
298 
#           the following matching order:
 311 
#           the following matching order:
299 
#
 312 
#
300 
#               1.  "/dir1/cfg/Myfile".
 313 
#               1.  "/dir1/cfg/Myfile".
301 
#               2.  "/dir1/cfg/myfile".
 - 
 
302 
#               3.  "/dir1/cfg/MYFILE".
 314 
#               2.  "/dir1/cfg/<Scan for MYFILE>".
303 
#               4.  "/dir2/cfg/Myfile".
 315 
#               3.  "/dir2/cfg/Myfile".
304 
#               5.  "/dir2/cfg/myfile".
 - 
 
305 
#               6.  "/dir2/cfg/MYFILE".
 316 
#               4.  "/dir2/cfg/<Scan for MYFILE>".
306 
#
 317 
#
307 
#           Upon being not found displays the message
 318 
#           Upon being not found displays the message
308 
#
 319 
#
309 
#               "stuff (cfg/Myfile) not found".
 320 
#               "stuff (cfg/Myfile) not found".
310 
#
 321 
#
- 
 
 322 
my %ExistsDirCache;
311 
sub Exists
 323 
sub Exists
312 
{
 324 
{
313 
    my( $path, $name, $msg, @paths ) = @_;
 325 
    my( $path, $name, $msg, @paths ) = @_;
- 
 
 326 
    my $file;
314 
    my( $dir, $file, $lc_name, $uc_name );
 327 
    my $ucName = uc($name);
315 
 
 - 
 
316 
    Debug2 "Searching for $path/$name (" . ($msg || '') . ")";
 328 
    Debug2 "Searching for $path/$name (" . ($msg || '') . ")";
317 
    Debug2 " using @paths" if ( @paths );
 329 
    Debug2 " using @paths" if ( @paths );
318 
 
 330 
 
- 
 
 331 
    #
319 
    if ( scalar( @paths ) > 0 ) {
 332 
    #   Convert the two call methods into a common method
320 
        $dir = pop( @paths );                   # search path
 333 
    #   Convert path with empty @paths into an array of paths with an empty 'path'
- 
 
 334 
    #
321 
    } else {
 335 
    unless (@paths) {
322 
        $dir = "";                              # path is absolute
 336 
        push @paths, $path;
- 
 
 337 
        $path = '';
323 
    }
 338 
    }
324 
 
 339 
 
325 
    $lc_name = lc( $name );
 - 
 
326 
    $uc_name = uc( $name );
 - 
 
327 
    do {
 340 
    SCANPATHS:
328 
        $dir .= "/"                             # directory delimitor
 - 
 
329 
            if ( $dir ne "" );
 341 
    foreach my $thisPath ( @paths) {
330 
 
 342 
 
331 
        $file = "$dir$path/$name";              # quoted, can be mixed case
 343 
        my $curPath = $thisPath . '/' . $path . '/';
- 
 
 344 
        $curPath =~ s~//$~/~;
332 
 
 345 
 
- 
 
 346 
        #
- 
 
 347 
        #   Try exact file name first - should work most of the time
- 
 
 348 
        #
- 
 
 349 
        $file = $curPath . $name;
333 
        Debug2 " -> $file";
 350 
        Debug2 " -> $file";
- 
 
 351 
        last SCANPATHS if ( -f $file );
334 
 
 352 
 
- 
 
 353 
        #
- 
 
 354 
        #   Scan all files in the directory for the first
- 
 
 355 
        #   case insensitive match
- 
 
 356 
        #
335 
        if ( ! -f $file )
 357 
        $file = '';
- 
 
 358 
 
- 
 
 359 
        #
- 
 
 360 
        #   Read directory and cache the results for reuse
- 
 
 361 
        #
- 
 
 362 
        unless (exists $ExistsDirCache{$curPath})
336 
        {
 363 
        {
337 
            $file = "$dir$path/$lc_name";       # lower case
 - 
 
338 
            if ( ! -f $file )
 364 
            if (opendir my $dh, $curPath ) {
339 
            {
 - 
 
340 
                $file = "$dir$path/$uc_name";   # upper case
 365 
                @{$ExistsDirCache{$curPath}} = readdir $dh;
341 
                $file = ""                      # NO MATCH
 - 
 
342 
                    if ( ! -f $file );
 366 
                closedir $dh;
343 
            }
 367 
            }
344 
        }
 368 
        }
- 
 
 369 
 
- 
 
 370 
        #
- 
 
 371 
        #   Scan for first matching filename
- 
 
 372 
        #
- 
 
 373 
        foreach my $item (@{$ExistsDirCache{$curPath}}) {
345 
    } while ( ($file eq "") &&
 374 
            if (uc($item) eq $ucName) {
- 
 
 375 
                $file = $curPath . $item;
346 
                ($dir ne "") && ($dir = pop( @paths )) );
 376 
                last SCANPATHS if ( -f $file );
- 
 
 377 
                $file = '';
- 
 
 378 
            }
- 
 
 379 
        }
- 
 
 380 
    }
347 
 
 381 
 
348 
    #
 382 
    #
349 
    #   If the user has defined an error message and the file does not
 383 
    #   If the user has defined an error message and the file does not
350 
    #   exist, then generate an error message
 384 
    #   exist, then generate an error message
351 
    #
 385 
    #
352 
    Error("$msg","File: $path/$name not found.")
 386 
    Error("$msg","File: $path/$name not found.")
353 
        if ($msg && $file eq "");
 387 
        if ($msg && $file eq "");
354 
 
 388 
 
355 
    Debug2 " == $file";
 - 
 
356 
 
 - 
 
357 
    Debug( "Exists:     = $file" );
 389 
    Debug2( "Exists:     = $file" );
358 
    return $file;
 390 
    return $file;
359 
}
 391 
}
360 
 
 392 
 
361 
 
 393 
 
362 
#-------------------------------------------------------------------------------
 394 
#-------------------------------------------------------------------------------