#! 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 information required to create a DPACKAGE file # # The true name of the DPACKAGE file has a GBE_MACHTYPE # appended to allow multi-machine builds. # #......................................................................# 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 JatsDPackage; use JatsError; use Data::Dumper; use ConfigurationFile; use FileUtils; use JatsEnv; our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); use Exporter; $VERSION = 1.00; @ISA = qw(Exporter); # Symbols to autoexport (:DEFAULT tag) @EXPORT = qw( DPackageAdd DPackageSave DPackageGenerate ); # # Global data # our %DPackageLibraryData; our %DPackageLibraryDataStore; # # Local Data # my $data_added; my $cwd; #------------------------------------------------------------------------------- # Function : DPackageAdd # # Description : Called to insert new information into the data store # # Inputs : platform - This does not need to be an active platform # it is simply passed to the DPACKAGE builder # # using - The "using" target # # ... - Arguments for the Library directive # # Returns : # sub DPackageAdd { my ($platform, $using, @args ) = @_; push @{$DPackageLibraryData{$using}{$platform}}, @args; $data_added = 1; $cwd = $::Cwd; } #------------------------------------------------------------------------------- # Function : DPackageSave # # Description : Merge collected DPackageLibraryData with data stored # within the interface directory from other makefiles # # This function is called to save the data # is written and before the DPACKAGE file is written # # Inputs : # # Returns : # sub DPackageSave { my $must_save; # # Do not save if there is nothing to save and nothing has ever been saved # Must update if there is anything previously saved # return unless ( $data_added ); Debug("DPackageSave"); # # Read in any existing data # It will be held in %DPackageLibraryDataStore # Then replace any data from this makefile with new information # Require ( "$::ScmRoot/$::ScmInterface", "Dpackage.cfg", "JATS internal file missing. Rebuild required" ) if ( -f "$::ScmRoot/$::ScmInterface/Dpackage.cfg" ); # DebugDumpData("%DPackageLibraryDataStore",\%DPackageLibraryDataStore ); if ( %DPackageLibraryData ) # Add this makefile.pl data { # # Detect changes in the data # Serialise the stored element and the element we wish to store # If they are the same we don't need to write out new data. # my $list1 = Dumper($DPackageLibraryDataStore{$cwd}); my $list2 = Dumper(\%DPackageLibraryData); if ( $list1 ne $list2 ) { Debug("DPackageSave: Add DPACKAGE data"); $DPackageLibraryDataStore{$cwd} = {%DPackageLibraryData}; $must_save = 1; } else { Debug("DPackageSave: Add DPACKAGE data - no change"); } } elsif ( $DPackageLibraryDataStore{$cwd} ) # Data has gone. Remove entry { Debug("DPackageSave: Remove DPACKAGE data"); delete $DPackageLibraryDataStore{$cwd}; $must_save = 1; } # DebugDumpData("%DPackageLibraryDataStore",\%DPackageLibraryDataStore ); # # Write it out now that it has been merged # if ( $must_save ) { Debug("DPackageSave: Save Data"); my $fh = ConfigurationFile::New( "$::ScmRoot/$::ScmInterface/Dpackage.cfg" ); $fh->Dump([\%DPackageLibraryDataStore], [qw(*DPackageLibraryDataStore)]); $fh->Close(); } } #------------------------------------------------------------------------------- # Function : DPackageGenerate # # Description : Create a simple DPACKAGE file based on collected information # # This function must be called after all the makefiles # have been rebuilt. It is only at this time that all the # information has been collected. # # Notes : This file may be created on multiple build machines # at slightly different times. Take care to make the # file build machine independent. # # Inputs : None # # Returns : Nothing # sub DPackageGenerate { my ($ScmRoot, $ScmInterface ) = @_; # # Do not generate DPACKAGE unless there is a Dpackage.cfg file # DPACKAGE will be created in a user directory and thus we don't # want to delete it unless we have created it # return unless ( -f "$ScmRoot/$ScmInterface/Dpackage.cfg" ); # # Validate globals # Error ("ScmSrcDir not present") unless ( $::ScmSrcDir ); EnvImport('GBE_MACHTYPE'); # # User status information # Message ("Generating DPACKAGE ($::GBE_MACHTYPE)"); # # Read in accumulated information for the creation of the DPACKAGE file # Require ( "$ScmRoot/$ScmInterface", "Dpackage.cfg", "JATS internal file missing. Rebuild required" ); # DebugDumpData("%::DPackageLibraryData",\%DPackageLibraryDataStore ); # # Delete and then re-create the the DPACKAGE file # my $fname = "$ScmRoot/$::ScmSrcDir/DPACKAGE.$::GBE_MACHTYPE"; unlink $fname; my $fh = ConfigurationFile::New( $fname, '--NoTime' ); $fh->Header( "Auto-generated DPACKAGE", "JatsDPackage (version $VERSION) ( machine $::GBE_MACHTYPE )" ); $fh->Write( "\n", "Version( 1, 0 ); # Interface version\n\n" ); # # Process each "Using" entry # Within each entry process the "platform" targets # and generate Libraries directives. # foreach my $mkfile (keys %DPackageLibraryDataStore ) { my $pmkfile = $DPackageLibraryDataStore{$mkfile}; $fh->Write( "\n#\n" ); $fh->Write( "# Defined in ScmRoot : ", RelPath($mkfile,$ScmRoot ), "\n" ); $fh->Write( "#\n" ); foreach my $using ( keys %{$pmkfile} ) { my $uentry = $pmkfile->{$using}; $fh->Write( "Using( '$using' ); # Usage name\n" ); foreach my $platform ( keys %{$uentry} ) { my $pentry = $uentry->{$platform}; $fh->Write( "\nLibraries('$platform',\n" ); foreach my $entry ( @{$pentry} ) { $fh->Write( " '$entry',\n" ), } $fh->Write( " );\n" ), } } } $fh->Close(); } #------------------------------------------------------------------------------- # Function : Require # # Description : Internal implementation # # Inputs : $path # $file # ... # # Returns : # sub Require { my ($path, $file) = @_; $path .= "/$file"; require $path; } 1;