Subversion Repositories DevTools

Rev

Rev 6887 | Blame | Compare with Previous | Last modification | View Log | RSS feed 

#! perl
########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Package Entry
#
#       New         Create a new package entry instance.
#
#       RuleInc     Check whether the specific 'include' path should
#                   be included within the PINCDIRS list.
#
#       RuleLib     Check whether the specific 'lib' path should
#                   be included within the PLIBDIRS list.
#
#       Cleanup     Performs any record cleanup required prior to the
#                   entry being published.
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

use DescPkg;
use JatsError;


our $BUILDNAME_PACKAGE;
our $BUILDNAME_VERSION;
our $BUILDNAME_PROJECT;
our $BUILDINTERFACE;
our @BUILDTOOLS;


package PackageEntry;

our %DescPkgCache           = ();           # Hash of known packages
our %PackageDefined         = ();           # Quick defined package test
our @PackageList            = ();           # Ordered array of packages


#-------------------------------------------------------------------------------
# Function        : EmptyEntry
#
# Description     : Create an empty class element
#                   Populated with the basic items
#
# Inputs          : None
#
# Returns         : New, empty entry
#
sub EmptyEntry
{
    my ($self) = {
            PINCDIRS        => [],
            PLIBDIRS        => [],
            LIBEXAMINED     => {},
            INCEXAMINED     => {},
            TOOLDIRS        => [],
            THXDIRS         => [],
        };
    return bless $self, __PACKAGE__;
}
#-------------------------------------------------------------------------------
# Function        : New 
#
# Description     : Create a new instance of the PackageEntry class
#
# Inputs          : $base           - Path to the package
#                   $name           - Package Name
#                   $version        - Version
#                   $type           - 'link' or 'build'
#                   $local          - Is from a local archive
#                                     No version check.
#                                     Display path to package
#                   $pkgSig         - Package Signature
#
# Returns         : 
#

sub New
{
    my ($base, $name, $version, $type, $local, $pkgSig) = @_;
    my $self = EmptyEntry();

    #   Load package description ...
    #   Note:   The results are cached within DescPkgCache
    #..
    if ( ! exists( $DescPkgCache{$base} ) )
    {
        my ($rec);
        my ($desc) = "";

        if ( -f "$base/descpkg" )
        {
            $rec = ::ReadDescpkg( "$base/descpkg", 1 );
        }
        else
        {                                       # doesn't exist
            ::Error( "Package description does not exist",
                     "Package Location: $base" )
        }

        ::Error("Cannot determine package description",
                "Package Location: $base" )
            unless ( $rec );

        ::Warning( "Package names do not match: $rec->{NAME}, $name" )
            if ( $rec->{NAME} ne $name );

        if ( $local )
        {                                       # display results
            my $logPrefix = "               ->";
            ::Log( "$logPrefix $base" );
        }
        elsif ( $rec->{VERSION_FULL} ne $version )
        {
            ::Warning( "Package versions do not match: $name : $rec->{VERSION_FULL}, $version" );
        }

        #
        #   Extend the package information to contain sufficient data
        #   for general use. Information will be retained to allow the
        #   user to extact specific package information
        #
        $version =~ m~(\d+\.\d+\.\d+)\.(\w+)~ ;
        my $vnum = $1 || $version;
        my $proj = $2 || '';

        $rec->{UNAME}    = $name;
        $rec->{UVERSION} = $version;
        $rec->{UVNUM}    = $vnum;
        $rec->{UPROJ}    = $proj;
        $rec->{type}     = $type;
        $rec->{PKGSIG}   = $pkgSig;

        $PackageDefined{$name}{$proj}{$vnum} = $base;
        push @PackageList, $base;

        $DescPkgCache{$base} = $rec;                  # cache result
    }

#   Build the package entry record
#..
    my ($descpkg) = $DescPkgCache{$base};       # descpkg details

    $self->{'base'}         = $base;

    $self->{'name'}         = $name;
    $self->{'version'}      = $version;
    $self->{'dname'}        = $descpkg->{NAME};
    $self->{'dversion'}     = $descpkg->{VERSION};
    $self->{'dproj'}        = $descpkg->{PROJ} || $descpkg->{UPROJ} || '';
    $self->{'packages'}     = $descpkg->{PACKAGES};
    $self->{'type'}         = $type;
    $self->{'sandbox'}      = $local;
    $self->{'cfgdir'}       = "/gbe" if ( -d $base."/gbe" );
#    $self->{pkgsig}         = $descpkg->{PKGSIG};

    return $self;
}

#-------------------------------------------------------------------------------
# Function        : Interface
#
# Description     : Create a specialised 'interface' entry
#
# Inputs          : $base           - Path to the Interface directory
#
# Returns         : Ref to this class
#
sub Interface
{
    my ($base) = @_;
    my $self = EmptyEntry();

    $self->{'base'}         = $base;
    $self->{'name'}         = 'INTERFACE';
    $self->{'version'}      = '0.0.0';
    $self->{'dname'}        = $self->{'name'};
    $self->{'dversion'}     = $self->{'version'};
    $self->{'dproj'}        = '';
    $self->{'packages'}     = '';
    $self->{'type'}         = 'interface';
    $self->{'cfgdir'}       = '/gbe';

    return $self;

}

sub RuleInc
{
    my( $self ) = shift;
    my( $path ) = @_;
    my( $examined ) = $self->{INCEXAMINED};
    my( $list ) = $self->{PINCDIRS};

    return if ( $$examined{$path} );
    $$examined{$path} = 1;

    push @$list, $path      if ( -d $self->{'base'}.$path );
}

#
#   Examine Path to ensure that it is a directory and that it contains files
#   Simplify Lib Path searching by removing useless paths.
#
#   If there are ANY files then the directory is useful
#   If there are no files ( only subdirectories ) then the directory is not useful
#
sub isUsefulDir
{
    my ($path) = @_;

    if ( -d $path )
    {
        opendir (USEFUL, $path) or ::Error ("Cannot open $path");
        my @dirlist = readdir USEFUL;
        closedir USEFUL;

        foreach ( @dirlist )
        {
            return 1 if ( -f "$path/$_" );
        }
    }
    return 0;
}

sub RuleLib
{
    my( $self ) = shift;
    my( $path ) = @_;
    my( $examined ) = $self->{LIBEXAMINED};
    my( $list ) = $self->{PLIBDIRS};

    return if ( $$examined{$path} );
    $$examined{$path} = 1;

    push @$list, $path."D"  if ( isUsefulDir($self->{'base'}.$path."D") );
    push @$list, $path."P"  if ( isUsefulDir($self->{'base'}.$path."P") );
    push @$list, $path      if ( isUsefulDir($self->{'base'}.$path) );
}

#-------------------------------------------------------------------------------
# Function        : ExamineToolPath
#
# Description     : Given the root of a package, locate any
#                   toolset extension paths within the tree. These will be
#                   saved and later used when user tools and scripts are
#                   invoked.
#
#   Examine:
#       - tools/bin/GBE_MACHTYPE/bin    - Hardware specfic tools
#       - tools/bin/GBE_MACHTYPE        - Hardware specfic tools
#       - tools/bin                     - Hardware independent tools - scripts
#       - tools/scripts/GBE_MACHINE     - Hardware specific scripts
#       - tools/scripts                 - Hardware independent scripts (too)
#
# Inputs          : self
#
# Returns         : Nothing
#
sub ExamineToolPath
{
    my( $self ) = shift;

    #
    #   Determine base dir
    #       LinkPkgArchive  : From the package
    #       BuildPkgArchive : From the interface directory
    #
    my $pbase_dir = $self->{'base'};                        # Package relative base directory
    my $base_dir = $self->{'base'};                         # Base directory to use
    $base_dir = "$::CwdFull/$BUILDINTERFACE"
        if ( $self->{'type'} eq 'build' );

    my @searchList;
    my $path = "/tools/bin";
    foreach my $suffix ( "/$::GBE_MACHTYPE", "/$::GBE_MACHTYPE/bin", "" ) {
        push @searchList, $path . $suffix;
    }

    $path = "/tools/scripts";
    foreach my $suffix ( "/$::GBE_MACHTYPE", "" ) {
        push @searchList, $path . $suffix;
    }

    for my $path (@searchList )
    {
        #   Test against the Package Directory
        #       So that we correctly identify packages witg tools
        #   Store the Use base directory
        #       So that BuildPkgArchive will be in the interface    

        my $dir = $base_dir . $path;
        if ( isUsefulDir( $pbase_dir . $path ) )
        {
            ::UniquePush( \@{$self->{'TOOLDIRS'}}, $dir );
            ::UniquePush( \@BUILDTOOLS, $dir );
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : ExamineThxPath
#
# Description     : Given the root of a package, locate some well known
#                   packaging directories for later use.
#
#                   Examine:
#                       /thx/$platform
#                       /thx
#
# Inputs          : self
#                   platform        - Current build platform
#
# Returns         : nothing
#
sub ExamineThxPath
{
    my( $self, $platform ) = @_;

    my $dir = $self->{'base'} . '/thx';
    if ( -d $dir )
    {
        push @{$self->{'THXDIRS'}}, "/thx/$platform" if isUsefulDir( "$dir/$platform" );
        push @{$self->{'THXDIRS'}}, "/thx" if isUsefulDir( $dir );
    }
}

sub Cleanup
{
    my ($self) = shift;

    delete $self->{LIBEXAMINED};
    delete $self->{INCEXAMINED};
}


#-------------------------------------------------------------------------------
# Function        : GetBaseDir
#
# Description     : Return the base directory of a given package
#                   Simple getter function
#
# Inputs          : self
#                   path    - Optional path within package
#
# Returns         : The base directory of the package
#
sub GetBaseDir
{
    my ($self, $path) = @_;
    my $dir = $self->{'base'};
    $dir .= '/' . $path if ( $path );
    return $dir;
}


#-------------------------------------------------------------------------------
# Function        : SanityTest
#
# Description     : Examine all the packages used in the current build.pl
#                   and all the packages used to build them. Then generate
#                   warning if there are mismatches.
#
#                   All the data has been collected and stored within
#                   $DescPkgCache. This routine processes the data and
#                   constructs a data structure to locate packages with
#                   multiple versions.
#
#                   The project name is considered to be a part of the package
#                   name. Thus aaaa_11.22.33.mass is different to aaaa_11.22.33.syd
#
# Inputs          :
#
# Returns         :
#
my %package_list;

sub AddEntry
{
    my( $root, $rver, $rproj, $name, $version ) = @_;
    my $ver;
    my $proj;

    if ($version eq "!current") {
        $ver = "current";
        $proj = "";
    } else {
        $version =~ m~(.*)\.(.*?)$~;
        $ver = $1  || 'BadVer';
        $proj = $2 || 'BadProj';
    }

    ::UniquePush( \@{$package_list{"$name$;$proj"}{$ver}},  "${root}_${rver}.${rproj}");
}

sub SanityTest
{
    foreach my $package ( keys %DescPkgCache )
    {
        my $pptr = $DescPkgCache{$package};
        my $lver = $pptr->{'VERSION'};
           $lver .= '.' . $pptr->{'PROJ'} if ( $pptr->{'PROJ'} );
        AddEntry( $BUILDNAME_PACKAGE, $BUILDNAME_VERSION, $BUILDNAME_PROJECT, $pptr->{'NAME'}, $lver );


        foreach my $subpkg ( @{$pptr->{'PACKAGES'}} )
        {
            my $name = $subpkg->{name};
            my $ver = $subpkg->{version};

            AddEntry( $pptr->{'NAME'}, $pptr->{'VERSION'}, $pptr->{'PROJ'}, $name, $ver );
        }
    }

    #::DebugDumpData("XXX", \%package_list );

    #
    #   Detect and print warnings about multiple entries
    #
    my $first_found = 0;
    foreach my $pentry ( sort keys %package_list)
    {
        my @versions = keys %{$package_list{$pentry}};

        if ( $#versions > 0 )
        {
            ::Warning("Package mismatchs detected.") unless ( $first_found++ );

            my ($pname, $pproj) = split $;, $pentry ;
            foreach my $version ( @versions )
            {
                ::Warning("Package ${pname}_${version}.${pproj} used by:", @{$package_list{$pentry}{$version}});
            }
        }

    }
}

#-------------------------------------------------------------------------------
# Function        : Exists
#
# Description     : A class function to determine if a given package is known
#                   to the PackageEntry manager. Used to detect multiple package
#                   definitions.
#
#                   The test ignores package versions
#                   It is not possible to include different versions of the
#                   same package. The test ignores the project part of the
#                   version. This allows for
#                           sysbasetypes aa.bb.cc.mas and
#                           sysbasetypes xx.yy.zz.syd
#
# Inputs          : $name           - User package name
#                   $version        - User version ( with project )
#
# Returns         : True: Package exists
#

sub Exists
{
    my ($name, $version) = @_;

    $version =~ m~(\d+\.\d+\.\d+)\.(\w+)~ ;
    my $vnum = $1 || $version;
    my $proj = $2 || '';

    return exists( $PackageDefined{$name}{$proj} );
}

#-------------------------------------------------------------------------------
# Function        : GetPackageList
#
# Description     : A class function to return a list of packages
#                   The list cannot be used directly. It is really a set of
#                   keys to an internal data structure.
#
#                   The result can be used to iterate over the list of packages
#                   using other functions.
#
# Inputs          : None
#
# Returns         : An array of package tags
#                   The array is ordered by package definition order
#
sub GetPackageList
{
    return @PackageList;
}

#-------------------------------------------------------------------------------
# Function        : GetPackageData
#
# Description     : A class function to return specific data for a given package
#
# Inputs          : $tag        - An iteration tag provided by GetPackageList()
#
# Returns         : A list of
#                       Package name
#                       Package version
#                       Package type : build or link
#
sub GetPackageData
{
    my ($tag) = @_;
    my $rec = $DescPkgCache{$tag};
    return $rec->{UNAME}, $rec->{UVERSION}, $rec->{type};
}

#-------------------------------------------------------------------------------
# Function        : GetNameVersion
#
# Description     : Return a package name and version for display purposes
#
# Inputs          : $tag        - An iteration tag provided by GetPackageList()
#
# Returns         : A list of
#                       Package name
#                       Package version
#                       Package type : build or link
#
sub GetNameVersion
{
    my ($tag) = @_;
    my $rec = $DescPkgCache{$tag};
    return join( ' ', $rec->{NAME}, $rec->{VERSION_FULL} );
}

#-------------------------------------------------------------------------------
# Function        : GetPackageVersionList
#
# Description     : A class function to return a list of package names as used
#                   to generate version strings
#
#
# Inputs          : None
#
# Returns         : An array of version list entries
#                   Each element of the form: "name (version)"
#
sub GetPackageVersionList
{
    my @list;
    foreach my $tag ( @PackageList )
    {
        my $rec = $DescPkgCache{$tag};
        push @list, "$rec->{UNAME} ($rec->{UVERSION})";
    }

    return @list;
}

#-------------------------------------------------------------------------------
# Function        : GetPackageSignature
#
# Description     : A class function to return a packages signature
#
#
# Inputs          : None
#
# Returns         : An array of version list entries
#                   Each element of the form: "name (version)"
#
sub GetPackageSignature
{
    my ($tag) = @_;
    my $rec = $DescPkgCache{$tag};
    return $rec->{PKGSIG};
}

#-------------------------------------------------------------------------------
# Function        : Dump 
#
# Description     : Internal diagnostic tool
#                   Dumps internal data structures    
#
# Inputs          : None 
#
# Returns         : Nothing 
#

sub Dump
{
    ::DebugDumpData("PackageEntry",\%DescPkgCache);
}

### End of package: PackageEntry

1;