#! perl ######################################################################## # COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED. # # Module name : locatefiles.pl # 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 $::ComonInitDone ) { 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;