######################################################################## # COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED. # # Module name : ToolsetFiles.pm # Module type : JATS Utility # Compiler(s) : Perl # Environment(s): jats # # Description : Provide access to the file GbeFiles.cfg # Provides methods to create, maintain and read the file # # ToolsetFiles::AddFile # ToolsetFiles::AddDir # ToolsetFiles::GetFiles # ToolsetFiles::GetBuildDirs # ToolsetFiles::GetSubTrees # ToolsetFiles::GetDataFile # # Internal Use Only # readData # writeData # rebuildSubdirList # rebuildParentDirList # #......................................................................# require 5.008_002; use strict; use warnings; #=============================================================================== package ToolsetFiles; use JatsError; use FileUtils; use ConfigurationFile; # automatically export what we need into namespace of caller. use Exporter(); our (@ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK); @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(); %EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]); # # Global variables # our %GBE_TOOLSETFiles; # Needs to be 'our'. Data store my $dataDir; # Path to the interface directory my $dataFile; # Path to GbeFiles.cfg #------------------------------------------------------------------------------- # Function : ToolsetFiles::AddFile # # Description : Maintain a data structure of files that are created # by the makefile creation process. # # Used to simplify the clobber process # All files 'added' will be deleted as a part of a clobber # # Maintains an on-disk data structure # # Inputs : fileList - Files to add to the list # # Returns : Nothing # sub AddFile { my (@fileList) = @_; Verbose2 ("ToolsetFile:", @fileList); # # Read in the existing data # readData(); # Capture the package root directory $GBE_TOOLSETFiles{Root} = FullPath($::ScmRoot) unless defined $GBE_TOOLSETFiles{Root}; # # Save to disk if # Target directory exists - creation may be delayed # We have added entries # if ( @fileList ) { # # Add files # Need to be full paths # Paths are store relative to the Root # foreach ( @fileList ) { $GBE_TOOLSETFiles{Files}{RelPath(FullPath($_), $GBE_TOOLSETFiles{Root} )} = 1; } # Save file writeData(); } } #------------------------------------------------------------------------------- # Function : GetFiles # # Description : Return an array of files from the stored data structure # # Inputs : $interface - (Optional) Path to the interface directory # $abs - (Optional) True: Return Abs paths # # Returns : An array of files # sub GetFiles { my ($interface, $abs) = @_; readData($interface) || Error ("Internal: ToolsetFiles::GetFiles - GbeFiles not found"); unless ($abs) { return keys %{$GBE_TOOLSETFiles{Files}}; } my @newList; foreach my $dir (keys %{$GBE_TOOLSETFiles{Files}} ) { push @newList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); } return @newList; } #------------------------------------------------------------------------------- # Function : GetBuildDirs # # Description : Return an array the internal directories from the stored data structure # # Inputs : $interface - (Optional) Path to the interface directory # # Returns : An array of files # sub GetBuildDirs { my ($interface) = @_; readData($interface) || Error ("Internal: ToolsetFiles::GetBuildDirs - GbeFiles not found"); my @newList; foreach my $dir (@{$GBE_TOOLSETFiles{Dirs}{Internal}} ) { push @newList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); } return @newList; } #------------------------------------------------------------------------------- # Function : ToolsetFiles::AddDir # # Description : Maintain a data structure of directories that are used # by the makefile creation process. # # Used to track directories used by the build. These are used # to calculate package signatures and fingerprints # # Maintains an on-disk data structure # # Inputs : $dir - Files to add to the list # $mode - 'Internal', Include SubDir # # $mode=Internal # directories are ignored # # $mode=Include and SubDir # Are processed to remove subdirectories # Needing a list of distinct directory trees that are a # part of the build. Used to calculate signatures. # # # Returns : Nothing # sub AddDir { my ($dir, $mode) = @_; Verbose2 ("ToolsetDir:", $dir, $mode); # # Only track directories that exist return unless -d $dir; # # Read in the existing data # readData(); # # Need to know the current directory in order to calculate the # FullPath and others # Error ("Internal: ToolsetFiles. Cwd not defined") unless ( defined $::Cwd ); # Capture the package root directory $GBE_TOOLSETFiles{Root} = FullPath($::ScmRoot) unless defined $GBE_TOOLSETFiles{Root}; # # Save to disk if # Target directory exists - creation may be delayed # We have added entries # my $dirList = ($mode =~ m/Internal/i) ? 'Internal' : 'Src'; if ( $dir ) { # # Add files - Need to be full paths # my $relDir = RelPath(FullPath($dir), $GBE_TOOLSETFiles{Root} ); # # Ignore Src directories that are a subdirectory of the current root dir # if (($relDir =~ m~^\.\.(/|$)~) || ($dirList eq 'Internal')) { # # Maintain @{$GBE_TOOLSETFiles{Dirs}} as a list of parent directories # The Root directory is assumed # # Add the new item and rebuild the list @{$GBE_TOOLSETFiles{Dirs}{$dirList}} = rebuildParentDirList($relDir, @{$GBE_TOOLSETFiles{Dirs}{$dirList}}); # Save file writeData(); } } } #------------------------------------------------------------------------------- # Function : ToolsetFiles::GetSubTrees # # Description : Return an ordered list of directory subtrees used by the build # These will be absolute paths # # This contains a list of all directories used by the build/make # as discovered when creating files. # IFF all source was below the build.pl dir, then we wouldn't need # to do this and life would be much simpler (and faster) # # Used by the 'sandbox': # To create a fingerprint over all files in a package. # Used by 'buildlib': # To create a signature of the package # # Inputs : $interface - (Optional) Path to the interface directory # # Returns : Ordered list of absolute paths of all subdirectory trees discovered # during the build phase. # # Needs to be the same order on all machines # sub GetSubTrees { my ($interface) = @_; my @dirList; # # Read in GbeFiles.cfg # It must exist # readData($interface) || Error ("Internal: ToolsetFiles::GetSubTrees - GbeFiles not found"); # # Generate a list of directories in the package # This is the root directory and all other Src directories discovered # push @dirList, $GBE_TOOLSETFiles{Root}; if (exists $GBE_TOOLSETFiles{Dirs}{Src}) { foreach my $dir ( sort {uc($a) cmp uc($b) } @{$GBE_TOOLSETFiles{Dirs}{Src}}) { push @dirList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); } } # Process the complete list to remove subdirectories # The paths are absolute @dirList = rebuildSubdirList(@dirList); #DebugDumpData("GetSubTrees", \@dirList); return @dirList; } #------------------------------------------------------------------------------- # Function : rebuildSubdirList # # Description : Internal function - not intended to be used externally # Only work when the @dirlist contains absolute paths # # Rebuild the subdirectory list # Remove items that are subdirectories of other items # We only want the parents, not children # # Inputs : @dirList - List of items to process # # Returns : Rebuild list # sub rebuildSubdirList { # Process the complete list to remove subdirectories # Process is: # Sort list. Will end up with shortest directories first, thus subdirs will follow parents # Insert each item into a new list iff it is not a subdir of something already in the list # my @newList; my @dirList = sort {uc($a) cmp uc($b)} @_; foreach my $newItem ( @dirList ) { my $match = 0; foreach my $item ( @newList ) { if (index ($newItem, $item) == 0) { $match = 1; last; } } if (! $match) { push @newList, $newItem; } } return @newList; } #------------------------------------------------------------------------------- # Function : rebuildParentDirList # # # Description : Internal function - not intended to be used externally # Only work when with relative paths # # Given: .., ../.., ../../AA Result: ../.. # Given .., ../AA, ../BB Result: .., ../AA, ../BB # # Must handle both parent and child directoires # # Rebuild the subdirectory list # Remove items that are subdirectories of other items # We only want the parents, not children # # Inputs : @dirList - List of items to process # # Returns : Rebuild list sub rebuildParentDirList { my (@dirlist) = @_; # # Convert to absolute # Use rebuildSubdirList # Convert back to relative # my @newList; foreach my $dir ( @dirlist ) { push @newList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); } # Process the complete list to remove subdirectories # The paths are now absolute @newList = rebuildSubdirList(@newList); # # Convert back to Relative # my @relList; foreach my $dir ( @newList ) { push @relList, RelPath(FullPath($dir), $GBE_TOOLSETFiles{Root} ); } return @relList; } #------------------------------------------------------------------------------- # Function : GetDataFile # # Description : Return the full path to the data file # May be used to test existence # # Inputs : $interface - Path to the interface directory (Optional) # # Returns : Path to file, or undefined # sub GetDataFile { my ($interface) = @_; # # Use the global path to the interface directory # unless specifically provided by the user # if ($interface) { $dataDir = $interface; } else { Error ("Internal: ToolsetFiles. ScmRoot or ScmInterface not defined") unless ( defined $::ScmRoot && defined $::ScmInterface ); $dataDir = "$::ScmRoot/$::ScmInterface"; } $dataFile = "$dataDir/GbeFiles.cfg"; return $dataFile if (-f $dataFile ); return undef; } #------------------------------------------------------------------------------- # Function : readData # # Description : Read the data file into memory # Data may not be present # # Inputs : $interface - Path to the interface directory (Optional) # # Returns : True - file found and read # sub readData { my ($interface) = @_; # # Use the global path to the interface directory # unless specifically provided by the user # if ($interface) { $dataDir = $interface; } else { Error ("Internal: ToolsetFiles. ScmRoot or ScmInterface not defined") unless ( defined $::ScmRoot && defined $::ScmInterface ); $dataDir = "$::ScmRoot/$::ScmInterface"; } $dataFile = "$dataDir/GbeFiles.cfg"; # # Read the file on every usage # Its used in a nested program call structure so the data may be stale # if ( -f $dataFile ) { do $dataFile; return 1 if %GBE_TOOLSETFiles; } return 0; } #------------------------------------------------------------------------------- # Function : writeData # # Description : Write the data out to the physical file # Simply rewrite the file - if the target directory exists # Its creation may be after we have started accumulating files # # # Inputs : # # Returns : # sub writeData { if ( -d $dataDir ) { my $fh = ConfigurationFile::New( $dataFile ); $fh->Header( "ToolsetFile", "Toolset Files" ); $fh->Dump( [\%GBE_TOOLSETFiles], [qw(*GBE_TOOLSETFiles)] ); $fh->Close(); } } #------------------------------------------------------------------------------ 1;