Subversion Repositories DevTools

#! 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;