Subversion Repositories DevTools

Rev

Rev 369 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed 

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

#
#   Global data
#
our %cf_filelist;                   # Data from Makefile.cfg
our %cf_info;                       # Makefile_x.cfg data
our %cf_info2;

#
#   Local Data
#
my $cfg_file;                       # Last file read


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

    return $cfg_file;
}

#-------------------------------------------------------------------------------
# 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} = 1;
    $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 1 );

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