Subversion Repositories DevTools

########################################################################
# Copyright (C) 2007 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : This package extends the JATS toolset at build time
#                 It provides additional directives to the JATS makefiles
#                 to simplify the directives.
#
#                 This directive does all its work at 'build' time
#                 It uses makefile.pl directives
#
# Operation     : This package adds the JATS directive ManifestFiles
#                 This is used to create linux manifest files
#
# Syntax        : ManifestFiles (<platforms>, Options+);
#                 See the function header for details
#
#......................................................................#

require 5.6.1;
use strict;
use warnings;

#
#   Globals
#
my @Manifests;                      # Manifest entries

#-------------------------------------------------------------------------------
# Function        : BEGIN
#
# Description     : Setup directive hooks
#                   Register a function to be called just before we start to
#                   generate makefiles. This will be used to process the data
#                   collected in all the ManifestFiles directives
#
# Inputs          : None
#
# Returns         : None
#
BEGIN
{
    RegisterMakefileGenerate (\&ManifestFiles_Generate);
}

#-------------------------------------------------------------------------------
# Function        : ManifestFiles
#
# Description     : Create a ManifestFiles entry
#
# Inputs          : Platform             - Active Platform Selector
#                   Options              - One or more options
#                       --Name=Name             - Mandatory
#                       --Tier=Name             - Mandatory
#                       --Architecture=xxxx     - Default actitecture is the current target
#                       --Product=yyyy          - Product Family
#                       --Debian=BaseName[,--Prod,--Debug,--Arch=xxxx,--Product=yyyy]
#                       --MugPackage=Package[,--Subdir=subdir[,subdir]+]
#                       --SrcFile=xxx
#
# Returns         : Nothing
#
sub ManifestFiles
{
    my( $platforms, @elements ) = @_;
    Debug2( "ManifestFiles($platforms, @elements)" );
    return if ( ! ActivePlatform($platforms) );

    my $name;
    my $tier;
    my @files;
    my $mug_dir;
    my $default_arch = $::ScmPlatform;
    my $default_prod = '';

    #
    #   Collect user options
    #
    foreach ( @elements )
    {
        if ( m~^--Name=(.+)~ ) {
            if ( $name )
            {
                ReportError ("ManifestFiles:--Name option is only allowed once");
                next;
            }
            $name = $1;

        } elsif ( m~^--Tier=(.+)~ ) {
            if ( $tier )
            {
                ReportError ("ManifestFiles:--Tier option is only allowed once");
                next;
            }
            $tier = $1;

        } elsif ( m~^--Debian=(.+)~ ) {
            push @files, LocateDebianFile($1, $default_arch, $default_prod);

        } elsif ( m~^--SrcFile=(.+)~ ) {
            push @files, LocatePreReq($1);
            
        } elsif ( m~^--MugPackage=(.+)~ ) {
            if ( $mug_dir )
            {
                ReportError ("ManifestFiles:--MugPackage option is only allowed once");
                next;
            }    
            $mug_dir = LocateMugDir($1);

        } elsif ( m/^--Arch(.*)=(.+)/ ) {
            $default_arch = $2;

        } elsif ( m/^--Product=(.+)/ ) {
            $default_prod = $1;

            
        } else {
            ReportError ("ManifestFiles: Unknown option or argument: $_");

        }
    }

    #
    #   Sanity test the user options
    #
    ReportError ("ManifestFiles: No name specified")
        unless $name;
    ReportError ("ManifestFiles: No tier specified")
        unless $tier;
    ReportError ("ManifestFiles: Cannot mix --Debian/--SrcFile with --MugPackage in one directive")
        if ( $mug_dir &&  @files );
    ReportError ("ManifestFiles: Must specify files to add to Manifest")
        unless ( $mug_dir ||  @files );
    ErrorDoExit();

    #
    #   Save information for processing at the end of the parsing phase
    #   Data collected from ALL the ManifestFiles directives will be collected
    #   and processed into one Manifest file
    #
    my %data;
    $data{tier} = $tier;
    $data{name} = $name;
    $data{files} = \@files;
    $data{mugdir} = $mug_dir;

    push @Manifests, \%data;
    return;

    #-------------------------------------------------------------------------------
    # Function        : LocateDebianFile
    #
    # Description     : Locate a debian file
    #                   Internal Function
    #
    #                   Scan packages for the Debian package specified
    #                   The user provides the base name of the package
    #                   A Debian Package name has several fields
    #                   These are:
    #                       1) Base Name - Provided by the user
    #                       2) Version - Version will be wildcarded
    #                       3) Architecture - Wildcarded. Uses bin/arch directory
    #                   
    #                   Expect to find Debian Packages in the bin/PLATFORM subdir
    #
    # Inputs          : Debian base name, complete with suboptions
    #
    # Returns         : Full path of the file
    #
    sub LocateDebianFile
    {
        my ($arg, $arch, $product) = @_;
        Verbose("LocateDebianFile: Processing: $arg");

        my @type = qw( P D );
        my @debian_file_path;
    
        #
        #   Extract sub-options
        #       --Prod[uction]
        #       --Debug
        #       --Arch[itecture]=yyy
        #
        my ($base_name, @opts) = split( ',', $arg );
        foreach ( @opts )
        {
            if ( m/^--Arch(.*)=(.+)/ ) {
                $arch=$2;
            } elsif ( m/^--Product=(.+)/ ) {
                $product=$1;
            } elsif ( m/^--Prod/ ) {
                @type = 'P';
            } elsif ( m/^--Debug/ ) {
                @type = 'D';
            }
        }

        #
        #   Create a list of products
        #   ie: PRODUCT_ARCH
        #
        my @products;
        push @products, $product . '_' . $arch if ( $product );
        push @products, $arch;

        #
        #   Scan all packages for the specified debian package
        #
        foreach my $package_dir ( getPackagePaths ('--All') )
        {
            foreach my $type ( @type )
            {
                foreach my $prd ( @products )
                {
                    foreach my $joiner ( qw(/ .) )
                    {
                        my $dir = "$package_dir/bin$joiner$prd$type";
                        Verbose("ManifestFiles: Search in $dir");
                        next unless ( -d $dir );
                        my @files = glob ( "$dir/${base_name}_*.deb" );
                        next unless ( @files );
                        push @debian_file_path, @files;
                    }
                }
            }
        }

        ReportError ("Required Debain package not found: $base_name") unless @debian_file_path;
        ReportError ("Multiple matching Debian Packages located") if ( $#debian_file_path > 0 );
        return $debian_file_path[0];
    }

    #-------------------------------------------------------------------------------
    # Function        : LocateMugDir
    #
    # Description     : Locate the directory containing the mugfiles
    #                   Internal Function
    #
    # Inputs          : Mufile package, with embedded options
    #
    # Returns         : Full path
    #
    sub LocateMugDir
    {
        my ($mug_package) = @_;

        #
        #   Locate the mugfile subdir
        #
        my $package_name = $mug_package;
        my @dirs = 'mug';
        my $mug_dir;

        #
        #   Extract sub options
        #       --Subdir=xxxx,yyyy,zzzz
        #
        if ( $package_name =~ m/(.*?),--Subdir=(.*)/ )
        {
            $package_name = $1;
            @dirs = split( ',', $2 );
        }

        my $package = GetPackageEntry( $package_name );
        unless ( $package )
        {
            ReportError ("ManifestFiles: Package not known to build: $package_name");
            return undef;
        }

        foreach my $subdir ( @dirs )
        {
            my $dir = "$package->{'ROOT'}/$subdir";
            if ( -d $dir )
            {
                Warning ("Multiple Mugfile directories located. Only the first will be used",
                         "Ignoring: $subdir" )if ( $mug_dir );
                $mug_dir = $dir;
            }
        }
        ReportError ("Mugfile directory not found in package: $package_name")
            unless $mug_dir;

        return $mug_dir;
    }
}

#-------------------------------------------------------------------------------
# Function        : ManifestFiles_Generate
#
# Description     : Internal Function
#                   Process all the collected data and create directives
#                   for the creation of the manifest
#
#                   This function will be called, just before the Makefile
#                   is created. The function will:
#                       1) Create the Manifest File
#                       2) Package the Manifest File
#                       3) Package the manifest file contents
#
#                   using (mostly) normal makefile.pl directives.
#
# Inputs          : None
#
# Returns         : Nothing
#
sub ManifestFiles_Generate
{
    Debug ("ManifestFiles_Generate");
    Message ("Generating Manifest File");
#DebugDumpData ( "Manifests", \@Manifests );

    #
    #   Create the Manifest File as we process the lists
    #   Place this in the local directory:
    #       - So that it will be deleted on clobber
    #       - So this it can be placed in a target-specific subdir
    #
    Error ("ManifestFiles: Needs local directory specified in build.pl") unless ( $::ScmLocal );

    my $manifest_dir = "$::ScmRoot/$::ScmLocal/Manifest/$::ScmPlatform";
    System( "$::GBE_BIN/mkdir -p $manifest_dir" );

    my $manifest_file = $manifest_dir . '/Manifest_' . $::ScmBuildVersion;
    Verbose ("ManifestFiles_Generate: File: $manifest_file");
    
    PackageFile ('*', $manifest_file, '--Subdir=mug', '--Strip' );

    open (MF, '>', $manifest_file ) || Error ("Cannot create the Manifest file: $manifest_file");

    print_mf ("# PackageName: $::ScmBuildPackage");
    print_mf ("# PackageVersion: $::ScmBuildVersion");
    print_mf ("# BuildDate: $::CurrentTime");
    print_mf ("#");
    print_mf ("[Version],$::ScmBuildVersion");
    print_mf ("#");

    #
    #   Process each tire in the order presented in the source file
    #
    foreach my $entry ( @Manifests )
    {
    print_mf ("#");

#DebugDumpData ( "Manifest Entry", $entry );

        my $tier = $entry->{tier};
        my $name = $entry->{name};

        #
        #   Insert all the files that have been specified
        #   The user specified order is preserved
        #
        my @files = @{ $entry->{files} };
        foreach my $file ( @files )
        {
            my $base_file = StripDir($file);
            print_mf ("$name,$tier,$base_file");
            PackageFile ('*', $file, '--Subdir=mug', '--Strip' );
        }

        #
        #   Expand out the entire MUG directory
        #   All .mug files in the MUG directory will be added to the manifest
        #   The assumption is that the MUG directory has been created by
        #   something that knows what its doing
        #
        if ( my $mugdir = $entry->{mugdir} )
        {
            foreach my $file ( glob ($mugdir . '/*.mug' ) )
            {
                next unless ( -f $file );
                my $base_file = StripDir($file);
                print_mf ("$name,$tier,$base_file");
                PackageFile ('*', $file, '--Subdir=mug', '--Strip' );
            }
        }
    }

    #
    #   Complete the creation of the Manifest File
    #
    print_mf ("#");
    print_mf ("# End of File");
    close MF;
    ErrorDoExit();
    return;

    #-------------------------------------------------------------------------------
    # Function        : print_mf
    #
    # Description     : Internal Function
    #                   Print one line to the Manifest File
    #                   Checks the length of the line being created
    #
    # Inputs          : $line
    #
    # Returns         : 
    #

    sub print_mf
    {
        foreach  ( @_ )
        {
            ReportError ( "Manifest line too long",
                    "Line: $_" ) if ( length ($_) > 79 );
            print MF $_ . "\n";
        }
    }
    
}

1;