Subversion Repositories DevTools

#! perl
########################################################################
# Copyright ( C ) 2004 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : This file contains a single function
#                 A play thing at the moment.
#
#                 The use of this function does require that the "Common.pl"
#                 has been initialised.
#
#                 Include in a makefile.pl with
#                       require "$::GBE_TOOLS/LocateFiles.pl";
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

#
#   Globals used
#
#   $::ScmRoot                  - Project Root
#   $::ScmInterface             - Path to the interface directory
#   $::ScmLocal                 - Path to build (local)
#   $::ScmDebug                 - Debug control
#   $::exe                      - Allow search for exe files
#   $::a
#   $::so
#   $::ScmBuildPkgRules         - Allow searching in packages
#   $::ScmPlatform              - Allow searching in packages
#
#   @::SRCDIRS                  - Allow searching for SOURCE files
#   $::SRCS                     - Allow Src lookup
#   ::Src()                     - Extend Src



require 5.006_001;
use strict;
use warnings;

unless ( defined $::ScmWho  )
{
    die "ERROR common.pl has not been initialised\n",
        "This is required in order to include many of the structures needed\n",
        "";
}

#-------------------------------------------------------------------------------
# Function        : LocateFiles
#
# Description     : Locate one or more files within the dependancy lists
#                   of the current package.
#
# Inputs          : PlatformSelector arguments+
#                   Arguments are
#                   One or more files to locate, with embedded options
#                   Files may contain leading directories ( etc/file.ini )
#                   Options:
#                       --Dir=xxxx[,yyyy]   Limit search to xxxx type directories
#                       --Lib               Limit search for lib directories
#                                           Shorthand for --Dir=lib
#                       --Include           Limit search to include directories
#                                           Shorthand for --Dir=include,inc
#                       --Bin               Limit search to bin directories
#                                           Shorthand for --Dir=bin
#                       --Local             Search the "local" directory tree only
#                       --Interface         Search the "interface" directory only
#                       --Src               Search within the AddDir paths
#                                           This will not locate files within packages
#                                           only files within the build sandbox
#                       --Type=nnn          Where nnn is one of:
#                                               prog    -> Implies --Bin
#                                               lib     -> Implies --Lib
#                                               shared  -> Implies --Lib
#                                           This option will modify the named
#                                           file by appending the target specific
#                                           file suffix and prefix to the files.
#                       --Verbose           User level debug of the scanning process
#                       --Production        Do not search debug directories
#                       --Debug             Do not search production directories
#                       --AddToSrc          Add files to JATS Src
#
#                   When the search is limited to a directory(s) the function
#                   will try various compatibility version of the directory. ie:
#                       dir.machine[D|P|'']
#                       dir/machine[D|P|'']
#                       dir/dir.machine[D|P|'']
#                       dir[D|P|'']
#
#                   This function will locate files that are in packages
#                   specified with either the LinkPkgArchive or BuildPkgArchive
#                   directive.
#
# Notes           : A limitation of this function is that it only looks in "known"
#                   locations for files. It does not allow for random package construction
#                   although it does attempt to handle some of the older and uglier
#                   packages
#
# Returns         : An array of resolved pathnames - if user wants an array
#                   A scalar pathname of one file - if the user does not want an array
#
#                   An error will be issued if a file cannot be resolved and the
#                   function will not return.
#
# Examples        : LocateFiles ( *, --Type=shared, myDll, myDll2 );
#                   LocateFiles ( *, etc/config.ini );
#
#
our %_DirSeen;                  # Internal Cache of directories that don't exist
                                # Use "_" Prefix to prevent retention in makefile.cfg
sub LocateFiles
{
    my( $platforms, @elements ) = @_;

    Debug2( "LocateFiles($platforms, @elements)" );
    return if ( ! ActivePlatform($platforms) );

    #---------------------------------------------------------------------------
    #   Scan the user arguments and determine options and files
    #
    my @rfiles;                                         # Fully located files
    my @sfiles;                                         # Files to locate
    my @dirs;                                           # Subdir roots to scan
    my $scan_local = 0;                                 # Look in "local" only
    my $scan_interface = 0;                             # Look in "interface" only
    my $scan_src = 0;                                   # Look in users Src dirs only
    my $add_type;                                       # Process file names
    my $verbose = 0;                                    # User level debug
    my $saved_verbose = $::ScmDebug;                    # Saved debug level
    my $no_debug;                                       # Don't scan debug dirs
    my $no_prod;                                        # Don't scan prod dirs
    my $source_for_usr;                                 # Do a Src too

    foreach ( @elements )
    {
        next unless ( defined $_ );                     # Skip empty elements
        push (@sfiles, $_) && next unless ( m/^-/ );    # Extract files

        if ( m/^--Dir=(.+)/ ) {
            UniquePush( \@dirs, $1 );

        } elsif ( m/^--Lib$/ ) {
            UniquePush( \@dirs, "lib" );

        } elsif ( m/^--Bin$/ ) {
            UniquePush( \@dirs, "bin" );

        } elsif ( m/^--Include$/ ) {
            UniquePush( \@dirs, "include", "inc" );
            $no_debug = 1;
            $no_prod = 1;

        } elsif ( m/^--Local$/ ) {
            $scan_local = 1;
            Error ("LocateFiles: --Local not valid. No local directory defined") unless ( $::ScmLocal );

        } elsif ( m/^--Interface$/ ) {
            $scan_interface = 1;

        } elsif ( m/^--Src$/ ) {
            $scan_src = 1;

        } elsif ( m/^--Type=(.+)/ ) {
            Error ("LocateFiles: Multiple --Type=xxx not allowed") if ( $add_type );
            $add_type = $1;

        } elsif ( m/^--Verbose$/ ) {
            $verbose++;

        } elsif ( m/^--Verbose=(\d*)/ ) {
            $verbose = $1;
            
        } elsif ( m/^--Debug/ ) {
            $no_prod = 1;

        } elsif ( m/^--Prod/ ) {
            $no_debug = 1;

        } elsif ( m/^--AddToSrc/ ) {
            $source_for_usr = 1;

        } else
        {
            Warning ("LocateFiles: Unknown option ignored: $_");
        }
    }

    #
    #   Sanity Testing
    #
    Error ("LocateFiles: Conflicting options: --Src, --Local and --Interface are mutually exclusive")
        if ( $scan_src + $scan_local + $scan_interface > 1 );

    #
    #   Enable user level debugging for this function only
    #   System level debugging will override
    #
    $::ScmDebug = $verbose unless ( $::ScmDebug );
    Debug( "LocateFiles: ScanFor: @sfiles" );

    #---------------------------------------------------------------------------
    #   Add target specific prefix and suffix to filenames
    #
    if ( $add_type )
    {
        Debug( "LocateFiles: Adding file types: $add_type" );
        my $prefix = '';
        my $suffix = '';
        my $dolib = 1;
        if ( $add_type =~ /prog/ )
        {
            $suffix = $::exe;
            $dolib = 0;
            UniquePush( \@dirs, "bin" );

        } elsif ( $add_type =~ /lib/ )
        {
            $suffix = '.' . $::a;
            UniquePush( \@dirs, "lib" );

        } elsif ( $add_type =~ /shared/ )
        {
            $suffix = '.' . $::so;
            UniquePush( \@dirs, "lib" );

        } else
        {
            Error ("LocateFiles: Unknown type: --Type=$add_type");
        }

        #
        #   On a unix system libraries have a "lib" prepended to each library.
        #
        $prefix= "lib" if ( $dolib && $::ScmTargetHost eq "Unix" );

        #
        #   Add prefix and suffix to all the files in the list
        #
        @sfiles = map $prefix . $_ . $suffix, @sfiles;

        Debug( "LocateFiles: Adding file types: Prefix:'$prefix', Suffix:'$suffix'" );
        Debug2( "LocateFiles: Processed file list: @sfiles" );
    }

    #---------------------------------------------------------------------------
    #   Determine the list of directories to search
    #   Will search within:
    #       - User AddDir paths
    #       - Local Directory ( Not useful )
    #       - Interface Directory (BuildPkgArchive)
    #       - Interface Directory + Package directories ( Build + Link PkgArchive)
    #         This is the default
    #
    my @basedirs;
    my $simple_scan;
    if ( $scan_src )
    {
        push @basedirs, @::SRCDIRS;
        $simple_scan = 1;
    }

    if ( $scan_local )
    {
        push @basedirs, "$::ScmRoot/$::ScmLocal";
        $simple_scan = 1;
    }

    if ( $scan_interface )
    {
        push @basedirs, "$::ScmRoot/$::ScmInterface";
    }

    unless ( @basedirs )
    {
        push @basedirs, "$::ScmRoot/$::ScmInterface";
        for (@{$::ScmBuildPkgRules{$::ScmPlatform} })
        {
            push @basedirs, $_->{'ROOT'} if ($_->{'TYPE'} eq 'link');
        }
    }
    Debug( "LocateFiles: Scan: @basedirs" );

    #---------------------------------------------------------------------------
    #   If we are scanning package directories then we need to maintain
    #   backward compatability with some badly constructed directories
    #   There is also a kludge for the SOLARIS target
    #
    #   Create an extended list of directories to scan
    #
    unless ( $simple_scan )
    {
        Debug2( "LocateFiles: Platform: $::ScmPlatform" );
        Debug2( "LocateFiles: Parts   : @{$::BUILDPLATFORM_PARTS{$::ScmPlatform}}" );

        my @more_dirs;
        foreach my $dir ( @dirs )
        {
            my @parts = @{$::BUILDPLATFORM_PARTS{$::ScmPlatform}};
            push @parts, 'sparc', 'SOLARIS_sparc' if ( $::ScmPlatform eq 'SOLARIS' );
            push @parts, 'win32' if ( $::ScmPlatform eq 'WIN32' );

            foreach my $type ( 'P', 'D', '' )
            {
                next if ( $type eq 'P' && $no_prod);
                next if ( $type eq 'D' && $no_debug);
                foreach my $part ( @parts )
                {
                    UniquePush (\@more_dirs, "$dir.$part$type");
                    UniquePush (\@more_dirs, "$dir/$part$type");
                    UniquePush (\@more_dirs, "$dir/$dir.$part$type");
                }
                UniquePush (\@more_dirs, $dir . $type);
            }
        }
        Debug2( "LocateFiles: Complex: @more_dirs" );
        @dirs = @more_dirs;
    }

    #---------------------------------------------------------------------------
    #   Locate all the required files
    #
    my $tfile;
    DIR:
    foreach my $file ( @sfiles)
    {
        #
        #   Look in the list of known source files
        #   We can only handle a single instance of any given filename in the
        #   system so we should strip of any possible directory
        #
        (my $raw_file = $file) =~ s~.*/~~;
        if ( $tfile = $::SRCS{$raw_file} )
        {
            #
            #   Base file found in the source database
            #   Ensure that this is the one that the user wants
            #
            Error ("LocateFiles: File already known, but the specified directories don't match",
                    "Specified file: $file",
                    "Known file    : $tfile" ) unless ( $tfile eq $file || $tfile =~ m~/$file$~ );
            next DIR;
        }

        #
        #   Scan the complete directory list for the specified file
        #
        foreach my $root ( @basedirs )
        {
            foreach my $sdir ( @dirs, '' )
            {
                #
                #   Maintain a list of directories that we know
                #   that we have and those that we know that we do not have.
                #   This (should) speed up access
                #       undef - not tested
                #       1     - Know we have the directory
                #       2     - Know that we don;t have the directory
                #
                #
                my $dir = "$root/$sdir";
                $dir =~ s~//~/~g;
                $dir =~ s~/$~~;
                my $dirseen = $_DirSeen{$dir} || 0;
                Debug2( "LocateFiles: Look for($dirseen): $dir/$file" );
                $_DirSeen{$dir} = $dirseen = -d $dir ? 1 : 2
                    unless ( $dirseen );
                next if ( $dirseen > 1 );

                Debug( "LocateFiles: Examine: $dir/$file" );
                $tfile = "$dir/$file";
                next DIR if ( -f $tfile );
            }
        }

        #
        #   Not found
        #
        $tfile = ();
    }
    continue
    {
        #
        #   This block is executed for all iterations of the associated loop
        #   It is used for common error detection and reporting of the found
        #   file
        #
        Error ("LocateFiles: File not located: $file") unless ( $tfile );

        push @rfiles, $tfile;
        Debug( "LocateFiles: Result: $file ->$tfile" );
    }

    #
    #   Restore system debug mode
    #
    $::ScmDebug = $saved_verbose;

    #
    #   Add the files to the Src mechanism if required
    #   This will allow random files to be built directly from a package
    #
    Src( '*', @rfiles ) if ( $source_for_usr );
    
    #
    #   Return to the user what they want an array or a list
    #
    return wantarray ? @rfiles : "@rfiles";

}

1;