#! perl ######################################################################## # Copyright ( C ) 2005 ERG Limited, All rights reserved # # Module name : jats.sh # Module type : Perl Package # Compiler(s) : n/a # Environment(s): jats # # Description : This package contains functions to manipulate # the Makefile_x configuration information # # This package uses some global variables # #......................................................................# use 5.006_001; use strict; use warnings; ################################################################################ # Global variables used by functions in this package # For historical reasons many of these variabeles are global # package JatsMakeConfig; use JatsError; use Data::Dumper; use ConfigurationFile; our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); use Exporter; $VERSION = 1.00; @ISA = qw(Exporter); # Symbols to autoexport (:DEFAULT tag) @EXPORT = qw( AllocateParsedConfig WriteParsedConfig WriteCommonInfo GetMakfilefileUid ); # # Global data # our %cf_filelist; # Data from Makefile.cfg our %cf_info; # Makefile_x.cfg data our %cf_info2; # # Local Data # my $fmtVersion = 1; # Data Format. Must match in readers: jmake.pl my $cfg_file; # Last file read my $cfg_uid; # Last file Unique Index #------------------------------------------------------------------------------- # Function : CheckGlobals # # Description : Validate assumptions on global variables # # Inputs : # # Returns : # sub CheckGlobals { Error ("JatsMakeConfig - ScmRoot not defined") unless ( $::ScmRoot ); Error ("JatsMakeConfig - ScmInterface not defined") unless ( $::ScmInterface ); Error ("JatsMakeConfig - Cwd not defined") unless ( $::Cwd ); } #------------------------------------------------------------------------------- # Function : ReadConfig # # Description : Read in a Makefile_x configuration file # # Inputs : Name of the file to read # # Returns : # sub ReadConfig { ($cfg_file) = @_; # # Clear before read # %cf_info = (); %cf_info2 = (); # # Load the existing Parsed Config File # if ( -f "$::ScmRoot/$::ScmInterface/$cfg_file" ) { require "$::ScmRoot/$::ScmInterface/$cfg_file"; } } #------------------------------------------------------------------------------- # Function : WriteConfig # # Description : Writes out the last config file read # Maintains the Makefile_x.cfg file # # Inputs : none # # Returns : # sub WriteConfig { my $fh = ConfigurationFile::New( "$::ScmRoot/$::ScmInterface/$cfg_file" ); $fh->Header( "JatsMakeConfig", "Makefile configuration file" ); #DebugDumpData ("%cf_info2", \%cf_info2); #DebugDumpData ("%cf_info", \%cf_info); $fh->Dump([\%cf_info2], [qw(*cf_info2)]); $fh->Write("\n\n"); $fh->Dump([\%cf_info], [qw(*cf_info)]); $fh->Close(); } #------------------------------------------------------------------------------- # Function : AllocateParsedConfig # # Description : Determine the Makefile_X.cfg file to be used for parsed # makefile information # # This routine will pre-allocate names # It may be called to determine the name that will be used # The name will be allocated at that point # # Maintains Makefile.cfg # This is an index file linking paths to Makefile_x.cfg # # Inputs : None # $::Cwd - Current directory # # Returns : Name of the config file # sub AllocateParsedConfig { # # Maintain a file of config file names # This process will also allocate new configuration file names # if ( -f "$::ScmRoot/$::ScmInterface/Makefile.cfg" ) { require "$::ScmRoot/$::ScmInterface/Makefile.cfg"; } my $cfg_file = $cf_filelist{$::Cwd}; unless ( defined( $cfg_file ) ) { my $num_keys = keys %cf_filelist; $cfg_file = "Makefile_" . ( $num_keys + 1 ) . ".cfg"; $cf_filelist{$::Cwd} = $cfg_file; my $fh = ConfigurationFile::New( "$::ScmRoot/$::ScmInterface/Makefile.cfg" ); $fh->Dump( [\%cf_filelist], [qw(*cf_filelist)] ); $fh->Close(); # # Have allocated a 'new' file # Ensure that it doesn't exist. May be left over from another life # unlink "$::ScmRoot/$::ScmInterface/$cfg_file"; } $cfg_file =~ m~Makefile_(.*)\.cfg~; $cfg_uid = $1; return $cfg_file; } #------------------------------------------------------------------------------- # Function : GetMakfilefileUid # # Description : Return the Makefile's Unqiue ID # # Inputs : None # # Returns : Numeric ID # sub GetMakfilefileUid { AllocateParsedConfig(); return $cfg_uid; } #------------------------------------------------------------------------------- # Function : WriteParsedConfig # # Description : Adds information to the Parsed Config File # Does not handle complex structures as a deep copy is # not used. In the current implementation this is OK. # # Inputs : # # Returns : # sub WriteParsedConfig { CheckGlobals(); Error ("ScmPlatform not defined") unless ( $::ScmPlatform ); # # Load the existing Parsed Config File # ReadConfig( AllocateParsedConfig() ); # # Remove current information before adding it. This will allow # the makefiles to be rebuilt. # $cf_info{$::ScmPlatform} = (); # # Examine the symbol table and capture most of the entries # foreach my $symname (keys %main:: ) { next if ( $symname =~ m/::/ ); # No Typeglobs next unless ( $symname =~ m/^[A-Za-z]/ ); # No system type names next if ( $symname =~ m/^SIG$/ ); # Useless next if ( $symname =~ m/^ENV$/ ); # Don't keep the user ENV next if ( $symname =~ m/^INC$/ ); # Don't keep the INC paths next if ( $symname =~ m/^DEFINES/ ); # Don't keep next if ( $symname =~ m/^TOOLSETRULES/ ); # Don't keep next if ( $symname =~ m/^RULES/ ); # Don't keep next if ( $symname =~ m/^ScmCompilerOptions/ ); # Not internal data next if ( $symname =~ m/^ScmToolsetCompilerOptions/ ); # Not internal data local *::sym = $main::{$symname}; $cf_info{$::ScmPlatform}{"\$$symname"} = $::sym if defined $::sym; $cf_info{$::ScmPlatform}{"\@$symname"} = \@::sym if @::sym; $cf_info{$::ScmPlatform}{"\%$symname"} = \%::sym if %::sym; } # # Write out the Parsed Config File with new information # WriteConfig(); } #------------------------------------------------------------------------------- # Function : WriteCommonInfo # # Description : Add information to the Makefile_x.cfg file # This routine deals with the second section of the file # One that is common to all makefiles. # # Inputs : $SUBDIRS_ref - Ref to an array of subdirs # $PLATFORMS_ref, - Ref to a hash of platform info # $noplatforms, - 1: No platforms in this dir # $rmf - 1: Root Makefile # # Returns : # sub WriteCommonInfo { my ( $SUBDIRS_ref, $PLATFORMS_ref, $noplatforms, $rmf ) = @_; CheckGlobals(); # # Load the existing Parsed Config File # ReadConfig( AllocateParsedConfig() ); # # Prepare the data # %cf_info2 = (); $cf_info2{version} = $fmtVersion; $cf_info2{subdirs} = $SUBDIRS_ref; $cf_info2{platforms} = $PLATFORMS_ref; $cf_info2{noplatforms} = 1 if ( $noplatforms ); $cf_info2{root} = 1 if ( $rmf ); # # Sanity test and cleanse data # Remove cf_info entries if the platform is not present # Remove the associated .mk file if the platform is not present # Note: Assumes that the common part is written after all others # foreach my $tgt ( keys %cf_info ) { unless ( exists ($cf_info2{platforms}{$tgt}) ) { Verbose ("WriteCommonInfo:Purge data for $tgt"); delete $cf_info{$tgt}; unlink ($tgt . '.mk'); } } # # Write out the Parsed Config File with new information # WriteConfig (); } ################################################################################ # Package to contain makefile reader operations # package JatsMakeConfigReader; use FileUtils; use JatsError; # # Global data # our %cf_filelist; # Data from Makefile.cfg #------------------------------------------------------------------------------- # Function : GetAllMakeInfo # # Description : This function will read all the Makefile_x.cfg files and # create a large data structure that contains all the # information # # Intended to be used by utiltites that want to process # all the information # # Inputs : Nothing # # Returns : MakefileInfo Class # sub GetAllMakeInfo { # # Create Class Data # my ($self) = { CFG => {}, # Config files used DIRS => [], # Array of dirs to walk IDX => {}, }; # # Read in the index file # my $fname = "$::ScmRoot/$::ScmInterface/Makefile.cfg"; Error "Cannot locate Make index file: Makefile.cfg\n" unless ( -f $fname ); delete $INC{ $fname }; require $fname; # # Validate the index file # Error ("Data in Makefile.cfg is not valid - Empty") unless ( keys(%cf_filelist) > 0 ); Error ("Data in Makefile.cfg is not valid - No Root") unless ( exists $cf_filelist{$::ScmRoot} ); # # Process all the constituent makefile data and build up a huge data structure # Order of reading isn't important. It will be sorted out later # foreach my $dir ( keys(%cf_filelist) ) { my $cfg_file = "$::ScmRoot/$::ScmInterface/$cf_filelist{$dir}"; $self->{IDX}{$dir} = JatsMakeConfigDataReader::New( $cfg_file ); } # DebugDumpData ("all", \$self ); return bless $self, __PACKAGE__; } #------------------------------------------------------------------------------- # Function : AllDirs # # Description : Return an array of paths required in order to walk the # makefiles # # The returned order is from the root directory down in the # order specified in the build and makefiles. # # Inputs : # # Returns : # sub AllDirs { my( $self ) = shift; # # Return cached result # return @{$self->{DIRS}} if ( @{$self->{DIRS}} ); # # Determine the walking order # This is based on the subdir tree # sub RecurseDown { my ($self, $dir) = @_; push @{$self->{DIRS}}, $dir; foreach my $subdir ( @{$self->{IDX}{$dir}->GetInfoItem('subdirs')} ) { RecurseDown( $self, CleanDirName( "$dir/$subdir") ); } } # # Depth first recursion through the tree # RecurseDown ( $self, $::ScmRoot ); return @{$self->{DIRS}}; } #------------------------------------------------------------------------------- # Function : GetEntry # # Description : Return a ref to the makefile data # # Inputs : # # Returns : # sub GetEntry { my( $self, $dir ) = @_; return $self->{IDX}{$dir}; } ################################################################################ # Package to contain makefile data reader operations # package JatsMakeConfigDataReader; use JatsError; # # Global data # our %cf_info; # Makefile_x.cfg data our %cf_info2; #------------------------------------------------------------------------------- # Function : New # # Description : Create an object to contain the Makefile Data # # Inputs : Name of the config file to read # # Returns : Ref # sub New { my ( $cfg_file ) = @_; # # Create Class Data # my ($self) = { INFO => {}, # Basic data FULL => {}, # Full data CFG => {}, # Config files used }; Error ("Makefile index entry missing: $cfg_file. Rebuild required") unless -f $cfg_file; %cf_info = (); %cf_info2 = (); Verbose ("Reading: $cfg_file"); delete $INC{ $cfg_file }; require $cfg_file; # # Basic sanity test # Error ("Makefile info2 not present") unless ( keys %cf_info2 ); Error ("Makefile info2 incorrect version. Rebuild required") unless ( exists $cf_info2{version} && $cf_info2{version} eq $fmtVersion ); $self->{CFG} = $cfg_file; %{$self->{INFO}} = %cf_info2; %{$self->{FULL}} = %cf_info; return bless $self, __PACKAGE__; } #------------------------------------------------------------------------------- # Function : GetPlatforms # # Description : Return an array of platforms of this makefile # # Inputs : # # Returns : # sub GetPlatforms { my( $self ) = @_; return keys %{$self->{FULL}}; } #------------------------------------------------------------------------------- # Function : GetData # # Description : Return a ref to the complete raw data # # Returns : # sub GetData { my( $self ) = @_; return $self->{FULL}; } sub GetInfo { my( $self ) = @_; return $self->{INFO}; } #------------------------------------------------------------------------------- # Function : GetDataItem # # Description : Return a data item # # Inputs : self - Object data # platform - Required platform # item - Item within the platform data # # Returns : # sub GetDataItem { my( $self, $platform, $item ) = @_; return undef unless ( exists $self->{FULL}{$platform} ); return undef unless ( exists $self->{FULL}{$platform}{$item} ); return $self->{FULL}{$platform}{$item}; } sub GetInfoItem { my( $self, $item ) = @_; return undef unless ( exists $self->{INFO}{$item} ); return $self->{INFO}{$item}; } ################################################################################ ################################################################################ # Package to contain makefile data reader operations # Simple single target reader for use at runtime # # package JatsMakeConfigLoader; use JatsError; use JatsEnv; #------------------------------------------------------------------------------- # Function : Load # # Description : Load Makefile data # Uses EnvVars setup by the build system to load the # makefile data for the current platform # # Used by some utilities that need to access definitions # and information available after the makefile has been # parsed. # # Inputs : None # # Returns : Ref to a class to allow manipulation of the data # sub Load { # # These MUST be in the environment # EnvImport ('GBE_MAKE_TYPE'); EnvImport ('GBE_MAKE_TARGET'); EnvImport ('GBE_MAKE_CFG'); my $data = JatsMakeConfigDataReader::New( $::GBE_MAKE_CFG ); # # Delete data for platforms other than the current one # Not essentail, but it will save memory and it will # make the data structure easier to debug # $data->{FULL} = $data->{FULL}{$::GBE_MAKE_TARGET}; # # Clean up a few items # A few items are a hash of items keys on platform name # Remove the extra level of indirection to simplify access # foreach ( qw (%ScmBuildPkgRules %BUILDINFO %BUILDPLATFORM_PARTS %ScmBuildProducts ) ) { $data->{FULL}{$_} = $data->{FULL}{$_}{$::GBE_MAKE_TARGET}; } # # Add a little bit more data # $data->{'PLATFORM'} = $::GBE_MAKE_TARGET; $data->{'TYPE'} = $::GBE_MAKE_TYPE; # # Bless myself # return bless $data, __PACKAGE__; } #------------------------------------------------------------------------------- # Function : GetData # # Description : Return a ref to the complete raw data # # Returns : # sub GetData { my( $self ) = @_; return $self->{FULL}; } sub GetInfo { my( $self ) = @_; return $self->{INFO}; } #------------------------------------------------------------------------------- # Function : GetDataItem # # Description : Return a data item # # Inputs : self - Object data # item - Item within the platform data # # Returns : # sub GetDataItem { my( $self, $item ) = @_; return undef unless ( exists $self->{FULL}{$item} ); return $self->{FULL}{$item}; } sub GetInfoItem { my( $self, $item ) = @_; return undef unless ( exists $self->{INFO}{$item} ); return $self->{INFO}{$item}; } 1;