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

#

#......................................................................#

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;

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 ( defined %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.

#

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

    #

    #   User status information

    #

    Message ("Generating DPACKAGE");

    #

    #   Read in accumulated information for the creation of the DPACKAGE file

    #

    $::CurrentTime = localtime;

    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";

    unlink $fname;

    my $fh = ConfigurationFile::New( $fname );

    $fh->Header( "Auto-generated DPACKAGE",

                              "JatsDPackage (version $VERSION)" );

    $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: $mkfile\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;