WebSVN – DevTools – /core_devl/branches/dpurdie_3.5.10000.cr/TOOLS/LIB/ReadBuildConfig.pm

########################################################################
# Copyright ( C ) 2007 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats build system
#
# Description   : Provide access to information from the build.pl file as parsed
#                 by JATS. This is more complete than the parser in the
#                 "BuildFile.pm"
#
#                 The purpose of this module is to provide an interface
#                 between (essentially) internal data structures and user
#                 scripts that need to access the data. These are primarily
#                 deployment scripts.
#
#                 The 'All' tag is used for backward compatabilty. It simply
#                 exports all the known data structures. NOT to be used by new
#                 code.
#
#
#
# Interface     : ReadBuildConfig           - Initialise module
#                 getPlatformParts          - Get a list of Platform parts
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

#===============================================================================
package ReadBuildConfig;
use JatsError;
use JatsMakeInfo qw(:basic);
use FileUtils;

# automatically export what we need into namespace of caller.
use Exporter();
our (@ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK);
@ISA         = qw(Exporter);
@EXPORT      = qw(  ReadBuildConfig
                    getPlatformParts
                    getPackagePaths
                    getPackageList
                    getToolInfo
                );
@EXPORT_OK =  qw(   $InterfaceVersion
                    $ScmBuildMachType
                    $ScmInterfaceVersion
                    $ScmBuildName
                    $ScmBuildPackage
                    $ScmBuildVersion
                    $ScmBuildProject
                    $ScmBuildVersionFull
                    $ScmBuildPreviousVersion
                    $ScmSrcDir
                    $ScmLocal
                    $ScmDeploymentPatch
                    $ScmBuildSrc
                    $ScmExpert
                    $ScmAll
                    $ScmNoBuild
                    %ScmBuildAliases
                    %ScmBuildProducts
                    %ScmBuildPlatforms
                    %ScmBuildPkgRules
                    @BUILDPLATFORMS
                    @DEFBUILDPLATFORMS
                    @BUILDTOOLSPATH
                    %BUILDPLATFORM_PARTS
                    %BUILDINFO
                    %BUILD_KNOWNFILES
                );

%EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]);

#-------------------------------------------------------------------------------
#   Global variables
#

my $interface;
my $platform;

#
#   The $InterfaceVersion value is manually maintained
#   The integer part should be changed to indicate a incompatible change
#   to the JATS files created within the interface directory
#
#   $InterfaceVersion is treated as a float. The fractional part can be
#   used to indicate minor changes to the file format.
#
our $InterfaceVersion       = "2.0";            # Change will issue error message

#
#   The following varaibles are "read" in from the build.cfg file
#   In order to access simply access we need to declare them
#
our %BUILDINFO;
our %BUILDPLATFORM_PARTS;
our $ScmInterfaceVersion;
our %ScmBuildPkgRules;
our $ScmBuildMachType;

#-------------------------------------------------------------------------------
# Function        : ReadBuildConfig
#
# Description     : Read in the build config information
#                   Read in build.cfg
#
# Inputs          : $interface              - Path to the interface directory
#                   $platform               - Platform being processed
#
# Returns         : Nothing
#
sub ReadBuildConfig
{
    $interface = shift;
    $platform = shift;

    my $no_test;
    foreach  ( @_ )
    {
        if ( m/^--NoTest/i ) {
            $no_test = 1;
        } else {
            Warning ("ReadBuildConfig, Unknown option: $_");
        }
    }

    Debug("BuildConfig::Reading config, $interface");
    my $cfgfile = "$interface/build.cfg";
    Error ("JATS internal file missing. Rebuild required",
           "BuildConfig: Cannot find file: $cfgfile" ) unless ( -f $cfgfile );

    #
    #   Include the build.cfg data
    #
    require ( $cfgfile );

    #
    #   Ensure that the version of the interface files can be consumed
    #   The $ScmInterfaceVersion is a written copy of $InterfaceVersion
    #
    #   Allow build.cfg files that do not have a ScmInterfaceVersion
    #   Assume that these are at version 1.0.
    #
    $ScmInterfaceVersion = '1.0' unless ( $ScmInterfaceVersion );
    Debug ("ReadBuildConfig: Version: $ScmInterfaceVersion, Need: $InterfaceVersion");
    if ( int($ScmInterfaceVersion) != int($InterfaceVersion)  )
    {
        Error ("JATS interface files are not compatible with this version of JATS",
               "Rebuild required.",
               "Current Interface Version: $ScmInterfaceVersion",
               "JATS Interface Version   : $InterfaceVersion" );
    }

    #
    #   Ensure that this config file is designed for this machine type
    #   At make-time this test may not be valid. It should have been
    #   validated before make-time.
    #
    TestMachType ($ScmBuildMachType, "build.cfg") unless $no_test;
    
    #
    #   Remove some unused data
    #   Reduces the size of Makefile.cfg. Speeds up writting
    #
    if ( $platform )
    {
        for (keys %::ScmBuildPlatforms)
        {
            next if ($_ eq $platform );
            delete ($::BUILDPLATFORM_PARTS{$_} );
            delete ($::BUILDINFO{$_} );
            delete ($::ScmBuildPkgRules{$_} );
        }
    }

    #   dump
    #
    Debug( "Aliases:" );
    if ( ! (%::ScmBuildAliases) ) {
        Debug( "  undefined" );

    } else {
        foreach my $key (keys %::ScmBuildAliases) {
            my( @value ) = split( ' ', $::ScmBuildAliases{ $key } );
            Debug( " $key\t= @value" );
        }
    }

    Debug( "Products:" );
    if ( ! (%::ScmBuildProducts) ) {
        Debug( "  undefined" );

    } else {
        foreach my $key (keys %::ScmBuildProducts) {
            my( @value ) = split( ',', $::ScmBuildProducts{ $key } );
            Debug( " $key\t= @value" );
        }
    }

    Debug( "Platforms:" );
    if ( ! (%::ScmBuildPlatforms) ) {
        Debug( "  undefined" );

    } else {
        foreach my $key (keys %::ScmBuildPlatforms) {
            my( @args ) = split( /$;/, $::ScmBuildPlatforms{ $key } );
            Debug( " $key\t= @args" );
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : getPlatformParts
#
# Description     : return a list of platform parts
#
# Inputs          : None
#
# Returns         : A list of platform parts to search in the interface
#                   directory, local directory or other
#
sub getPlatformParts
{
    Error ("BuildConfig. Not initialised") unless ( $platform );
    return @{$BUILDINFO{$platform}{PARTS}};
}

#-------------------------------------------------------------------------------
# Function        : getPackagePaths
#
# Description     : Return a list of all packages
#                   LinkPkgarchive packages will be provided as is
#                   BuildPkgArchive packages will be provided as a single
#                   reference to the interface directory
#
# Inputs          : Options
#                       --Interface=xxxx            Path to the interface dir
#                                                   If provided, then the path
#                                                   will be used for the first
#                                                   BuildPkgArchive
#                       --All                       All paths
#                       --Tools                     All Tools Paths
#                       --Gbe                       All Gbe paths
#
# Returns         : An array of paths
#
sub getPackagePaths
{
    Error ("BuildConfig. Not initialised") unless ( $platform );

    my $interface;
    my $all;
    my $need;
    my @result;

    #
    #   Parse Options
    #
    foreach ( @_ )
    {
        if ( m~^--Interface=(.+)~ ) {
            $interface = $1;
        } elsif ( m~^--All~ ) {
            $all = 1;
        } elsif ( m~^--Tools~ ) {
            $need = 'TOOLDIRS';
        } elsif ( m~^--Gbe~ ) {
            $need = 'CFGDIR';
        } else {
            Error ("BuildConfig. Unknown Option: $_");
        }
    }

    #
    #   Locate required entries
    #
    for my $entry (@{$ScmBuildPkgRules{$platform} })
    {
        #
        #   Do we need this entry
        #   Select tools and gbe entries
        #
        my @subdirs = '/';
        if ( $need )
        {
            next unless ( exists ($entry->{$need} ) );
            my $subdir = $entry->{$need};
            if ( ref($subdir) eq 'ARRAY' ) {
                @subdirs = @{$subdir};
            } else {
                @subdirs = $subdir;
            }
        }

        #
        #   Skip the Pseudo INTERFACE package if we are processing all packages
        #   Skip BuildPkgArchives if we aren't processing all
        #
        next if ( ($entry->{'TYPE'} eq 'interface') && $all );
        next if ( ($entry->{'TYPE'} eq 'build') && !$all );

        #
        #   Select appropriate root
        #       Use provided interface path - not too sure why
        #       Should be able to simplify this
        #
        my $dir = $entry->{'ROOT'};
        $dir = $interface if ( $entry->{'TYPE'} eq 'interface' );

        foreach my $subdir ( @subdirs )
        {
            my $dir = $entry->{'ROOT'} . $subdir;
            $dir =~ s~/+~/~g;
            $dir =~ s~/+$~~g;
            push @result, $dir;
        }
    }

    return @result;
}

#-------------------------------------------------------------------------------
# Function        : getPackageList
#
# Description     : Returns a list of package entries
#                   Only real use of the returned values is to iterate over it
#                   and pass the values into other functions within this
#                   class.
#
# Inputs          : Nothing
#
# Returns         : A list of refs to package data
#
sub getPackageList
{
    Error ("BuildConfig. Not initialised") unless ( $platform );
    my @result;

    foreach ( @ {$ScmBuildPkgRules{$platform} } )
    {
#        my %self;
#        $self{DATA} = $_;
        push @result, bless $_, "PackageEntry";
    }
    return ( @result );
}

#-------------------------------------------------------------------------------
# Function        : getToolInfo 
#
# Description     : Locate and load the tool information for the named tool
#
# Inputs          : $toolname           - tool to locate
#                   ...                 - Optional,Names of fields to expect in the package
#                                         If any of the required fields ar missing an error
#                                         will be reported
#
# Returns         : A hash of Tool info
#
sub getToolInfo
{
    my ($toolname, @fnames) = @_;
    my $toolroot;
    my $toolinfo;
    my $pentry;
    my %data;
    my @searchPath;

    foreach my $entry ( getPackageList() )
    {
        my $path = $entry->getBase(2);
        Verbose("getToolInfo: $path");
        #   Generic
        $toolinfo = catdir($path, 'gbe', 'INFO', 'info.' . $toolname . '.generic');
        push @searchPath, $toolinfo;
        if ( -f $toolinfo )
        {
            $toolroot = $path;
            $pentry = $entry;
            last;
        }
        #   Machine specific
        $toolinfo = catdir($path, 'gbe', 'INFO', 'info.' . $toolname . '.'. $ENV{GBE_HOSTMACH});
        push @searchPath, $toolinfo;
        if ( -f $toolinfo )
        {
            $toolroot = $path;
            $pentry = $entry;
            last;
        }
    }
    if (defined $toolroot)
    {
        open (my $DATA, '<', $toolinfo ) || Error("Cannot open tool info file. $!", "File: $toolinfo");
        while ( <$DATA> )
        {
            $_ =~ s~\s+$~~;
            next if ( m~^#~ );
            next if length($_) < 1;
            m~(.*?)\s*=\s*(.*)~;
            $data{$1} = $2;
        }
        close $DATA;
        $data{PKGBASE} = $toolroot;
        $data{PKGENTRY} = $pentry;
#DebugDumpData("Data", \%data);

        #
        #   Ensure that the required fields are in the info file
        #   These will be a mix of mandatory and user fields
        #
        my @missing;
        for my $fname ('TOOLNAME','TOOLROOT', @fnames)
        {
            next if defined $data{$fname};
            push @missing, $fname;
        }
        if (@missing)
        {
            Error("Tool Package '$toolname' is missing required fields:", @missing);
        }
        return \%data;
    }

    #   Didn't find the required tool
    Error ("Cannot find required tool in any package: $toolname", "Search Path:", @searchPath);
}


################################################################################
#   PackageEntry
################################################################################
#
#   A class to access the data embedded into $ScmBuildPkgRules
#   Use a class interface to abstract the data
#
package PackageEntry;

#-------------------------------------------------------------------------------
# Function        : dump
#
# Description     : Diagnostic Dump of the body of the package entry
#
# Inputs          : None
#
# Returns         : None
#
sub dump
{
    my $self = shift;
    ::DebugDumpData("PackageEntry", $self );
}

#-------------------------------------------------------------------------------
# Function        : getBase
#
# Description     : Determine the base directory of the package
#
# Inputs          : $self                   - Class Ref
#                   $type                   - 0: Empty
#                                             1: abs dpkg_archive
#                                             2: May be in the interface
#                                             3: Interface, LinkPkgs
#
# Returns         : As above
#
sub getBase
{
    my ($self, $type ) = @_;

    if ( $type == 1 ) {
        return $self->{ROOT};
    } elsif ( $type == 2 ) {
        if ( $self->{'TYPE'} eq 'build' ) {
            return $interface;
        } else {
            return $self->{ROOT};
        }
    } elsif ( $type == 3 ) {
        return if ( $self->{'TYPE'} eq 'build' );
        return $self->{ROOT};
    } else  {
        return '';
    }
}

#-------------------------------------------------------------------------------
# Function        : getLibDirs
#
# Description     : Return an array of library directories
#
# Inputs          : $self                   - Class ref
#                   $type                   - 0 : Relative to base of the package
#                                             1 : abs to the dpkg_archive package
#                                             2 : abs to the interface
#                                             3: Interface, LinkPkgs
#
# Returns         : An array
#
sub getLibDirs
{
    my ($self, $type ) = @_;
    my @result;
    my $prefix = getBase( $self, $type );

    foreach ( @{$self->{PLIBDIRS}} )
    {
        push @result, $prefix . $_;
    }
    return @result;
}

#-------------------------------------------------------------------------------
# Function        : getIncDirs
#
# Description     : Return an array of include directories
#
# Inputs          : $self                   - Class ref
#                   $type                   - 0 : Relative to base of the package
#                                             1 : abs to the dpkg_archive package
#                                             2 : abs to the interface
#                                             3: Interface, LinkPkgs
#
# Returns         : An array
#
sub getIncDirs
{
    my ($self, $type ) = @_;
    my @result;
    my $prefix = getBase( $self, $type );

    foreach ( @{$self->{PINCDIRS}} )
    {
        push @result, $prefix . $_;
    }
    return @result;
}

#------------------------------------------------------------------------------
1;
Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_3.5.10000.cr/TOOLS/LIB/ReadBuildConfig.pm – Rev 4836
