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 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 defined @::sym;

        $cf_info{$::ScmPlatform}{"\%$symname"} = \%::sym if defined %::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) )

    {

        $self->{IDX}{$dir} = JatsMakeConfigDataReader::New( $cf_filelist{$dir} );

    }

#    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 conatin 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

        };

    $cfg_file = "$::ScmRoot/$::ScmInterface/$cfg_file";

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

}

1;