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;