Subversion Repositories DevTools

#! perl

########################################################################

# Copyright ( C ) 2004 ERG Limited, All rights reserved

#

# Module name   : MugFiles.pl

# Module type   : JATS Build System

# Compiler(s)   : n/a

# Environment(s): jats

#

# Description   : This is a  JATS toolset extension package

#                 The package will add seeral directives to allow the

#                 creation of MUG files.

#

#                 The package is platform independant

#

# Usage:

#

# Version   Who      Date        Description

#

#......................................................................#

require 5.6.1;

use strict;

use warnings;

use File::Basename;

use File::Path;

use File::Copy;

#

#   Global data

#

my %Tiers;                             # Hash of Tiers already seen

my $verbose = 0;

MugInit();

#-------------------------------------------------------------------------------

# Function        : MugInit

#

# Description     : Module initialisation

#                   Setup and sanity testing.

#                   This function is run automaticlly when the package is loaded

#

# Inputs          :

#

# Returns         :

#

sub MugInit

{

    #

    #   Ensure that required utilities can be located

    #

    my @not_found;

    foreach my $util ( qw(genappa.exe modcrc.exe) )

    {

        unless ( my $path = ToolExtensionProgram( $util ) )

        {

            push @not_found, $util;

        }

    }

    Error ("MugFiles: Required utility programs not found:", @not_found )

        if ( @not_found );

}

#-------------------------------------------------------------------------------

# Function        : MugFiles

#

# Description     : Collect MugFile information

#                   information

#

# Inputs          : $1  - platform(s)

#                   $*  - an argument list

#

# Returns         :

#

sub MugFiles

{

    my( $platforms, @elements ) = @_;

    my (%muginfo);

    my $tier;

    #

    #   Is this platform currently active

    #

    return if ( ! ActivePlatform($platforms) );

    DebugPush("MugFiles");

    #

    #   Process directive arguments

    #

    for (@elements)

    {

        if ( m/^--DeviceId=(.*)/ ) {

            $muginfo{'Device'} = $1;

        } elsif ( m/^--Name=(.*)/ ) {

            $muginfo{'Name'} = $1;

        } elsif ( m/^--Tier=(.*)/ ) {

            $muginfo{'Tier'} = $1;

            $tier = $1;

        } elsif ( m/^--Package=(.*)/ ) {

            my $package_name = $1;

            my @dirs = 'thx';

            if ( $package_name =~ m/(.*?),--Subdir=(.*)/ )

            {

                $package_name = $1;

                @dirs = split( ',', $2 );

            }

            my $package = LocatePackage( $package_name );

            foreach my $subdir ( @dirs )

            {

                my $dir = "$package->{'ROOT'}/$subdir";

                if ( -d $dir )

                {

                    UniquePush( \@{$muginfo{'Dirs'}}, $dir );

                }

                else

                {

                    Warning("Directory not found in package: $package_name, Subdir: $subdir")

                        unless ( $subdir eq 'thx' );

                }

            }

            UniquePush( \@{$muginfo{'Dirs'}}, "$package->{'ROOT'}" );

        } elsif ( m/^--Dir=(.*)/ ) {

            my $dir = $1;

            Error("Directory not found: $dir") unless ( -d $dir );

            UniquePush( \@{$muginfo{'Dirs'}}, $dir );

        } elsif ( m/^--Load=(.*)/ ) {

            Error("Multiple Load files specified") if ( $muginfo{'Load'} );

            $muginfo{'Load'} = $1;

        } elsif ( m/^--Exclude=(.*)/ ) {

            foreach ( split( ',', lc($1)) )

            {

                $muginfo{'Exclude'}{$_} = 0;

            }

        } elsif ( m/^--ThxDir=(.*)/ ) {

            $muginfo{'ThxCopyDir'} = $1;

        } else {

            Error("Unknown option: $_ ");

        }

    }

    #

    #   Ensure the user has provided all the parameters

    #

    Error("No Device specified") unless ( $muginfo{'Device'} );

    Error("No Name specified") unless ( $muginfo{'Name'} );

    Error("No Tierspecified") unless ( $muginfo{'Tier'} );

    Error("No Packages or directories specified") unless ( $muginfo{'Dirs'} );

    Error("Duplicated Tier: $tier") if ( exists $Tiers{$tier} );

    #

    #   Process Name

    #   It MUST be 4 characters padded with '-'

    #

    my $name = $muginfo{'Name'};

    Error( "Name too long. Must be less that 4: $name") if ( length($name) > 4 );

    $name .= '----';

    $name = substr($name,0,4);

    $muginfo{'Name'} = $name;

    $Tiers{$tier} = \%muginfo;

    DebugPop();

}

#-------------------------------------------------------------------------------

# Function        : MugGenerate

#

# Description     : Process all the collected data and generate MUG files

#

#                   Create a genappa.ini file as required for genappa.exe

#                   Create load.cmd files as required for genappa.exe

#

# Inputs          : None

#

# Returns         : Even less

#

sub MugGenerate

{

    my (@args) = @_;

    foreach ( @args )

    {

        if ( /^--Debug$/ ) {

            $verbose++;

        } elsif ( /^--Debug=(\d+)/ ) {

            $verbose = $1;

        } else {

            Warning("MugFiles: Unknown option: $_");

        }

    }

    #

    #   Set new Debug header and level

    #   These will be popped later

    #

    $verbose = DebugPush("MugGenerate", $verbose);

    Debug("Mugfiles: Set Verbosity: $verbose");

    #

    #   Determine the system version

    #   This is based on the Build Version ( XX.YY.ZZ )

    #   This is massaged into the required system version, which is required

    #   in two forms:

    #       1) As hex XX.YY

    #       2) As the decimal version of 1)

    #

    #   The version is held in two bytes so it is limited

    #

    my @versions = split( /\./, $::ScmBuildVersion );

    Error ("MugFiles: Cannot encode versions with a patch number: $::ScmBuildVersion",

            "Major: $versions[0]",

            "Minor: $versions[1]",

            "Patch: $versions[2]")

        if ( $versions[2] > 0 ) ;

    my $version_hex = $versions[0] * 100 + $versions[1];

    my $version_decimal = hex $version_hex;

    Debug ("MugSet version: $version_decimal, HEX:$version_hex");

    #

    #   Create the list of THX files to be used for each device

    #   These files are calculated by:

    #       Merging all the THX files in the specified packages

    #       Excluding the specified files

    #

    foreach my $mugref ( values %Tiers )

    {

        #

        #   If the user has specified a load file, then use it to provide

        #   the complete list of files to load

        #

        if ( $mugref->{'Load'} )

        {

            ReadLoadFile( $mugref, LocateLoadFile( $mugref, $mugref->{'Load'} ));

        }

        my %files_found;

        my @ffiles;

        foreach my $dir ( @{$mugref->{'Dirs'}} )

        {

            #

            #   Locate the THX files within the package ( directory )

            #   Exclude any user specified files

            #

            my @files = glob( "$dir/*.thx" );

            Debug("Searching for THX files in directory: $dir");

            foreach  ( @files )

            {

                my $base = lc(basename($_));

                #

                #   Include only loaded files

                #

                if ( exists $mugref->{'LoadList'} )

                {

                    next unless( exists $mugref->{'LoadList'}{$base} );

                    $mugref->{'LoadList'}{$base}++;

                }

                #

                #   Skip excluded files

                #

                if ( exists $mugref->{'Exclude'}{$base} )

                {

                    $mugref->{'Exclude'}{$base}++;

                    Debug2 ("   Excluding: $base");

                    next;

                }

                #

                #   Test for duplicated files

                #

                if ( exists($files_found{$base}) )

                {

                    Warning("Multiple instances a file ignored: $base",

                            "Using file: $files_found{$base}",

                            "Ignoring  : $_");

                    next;

                }

                $files_found{$base} = $_;

                push @ffiles, $_;

                Debug2 ("   File: $_");

            }

        }

        $mugref->{'Files'} = \@ffiles;

        #

        #   If using a Load file then reprocess the complete file list

        #   to retain only those

        #

        #   Report excluded files that were not excluded

        #

        foreach ( keys %{$mugref->{'Exclude'}} )

        {

            next if ( $mugref->{'Exclude'}{$_} );

            Warning ("Excluded THX file not encountered: $_" );

        }

        #

        #   Report loaded files that are not located

        #

        my @not_nice;

        foreach ( keys %{$mugref->{'LoadList'}} )

        {

            next if ( $mugref->{'LoadList'}{$_} );

            push @not_nice, $_;

        }

        Error ("Incomplete THX file set. Missing files", @not_nice)

            if ( $#not_nice >= 0 );

        #

        #   Generate the loadfull.ini file

        #   This file simply contains the full path names to all THXs

        #   Unique INI files will be created in the "interface" directory

        #

        my $loadname = "$::ScmRoot/$::ScmInterface/load_$mugref->{'Tier'}.ini";

        $mugref->{'IniName'} = $loadname;

        Debug("Generating loadfile: $loadname" );

        open (INI, ">$loadname" ) || Error ("Cannot create: $loadname" );

        foreach ( @{$mugref->{'Files'}} )

        {

            (my $dos_path = $_) =~ s~/~\\~g;

            print INI "e=o:$dos_path\n";

        }

        close INI;

        #

        #   Transfer THX files into the package

        #

        if ( $mugref->{'ThxCopyDir'} )

        {

            my $thxdir = "$::ScmRoot/pkg/$::ScmBuildPackage/thx/$mugref->{'ThxCopyDir'}";

            $thxdir =~ s/-$//g;

            Debug("THX files will be placed in: $thxdir" );

            mkpath( $thxdir );

            foreach ( @{$mugref->{'Files'}}, @{$mugref->{'LoadFiles'}} )

            {

                Debug2("Copy Thx: $_" );

                copy($_ ,$thxdir);

            }

        }

        DebugDumpData("Processed Mug", $mugref)

            if $verbose > 2;

    }

    #

    #   Create the master genappi.ini file

    #   This file will be created in the interface directory

    #

    my $genappa = "$::ScmRoot/$::ScmInterface/genappa.ini";

    Debug("Generating genappa control file: $genappa" );

    open (INI, ">$genappa" ) || Error ("Cannot create: $genappa" );

    #

    #   Insert the header

    #

    print INI "[Header]\n";

    print INI "SystemVer                = ",$version_hex, "\n";

    print INI "NumDevTypes              = ", scalar keys %Tiers, "\n";

    print INI "\n";

    #

    #   Insert per device information

    #   This is performed in reverse Tier order

    #

    my $device_number = 0;

    foreach my $tier ( reverse sort keys %Tiers )

    {

        $device_number++;

        my $mugref = $Tiers{$tier};

        print INI "[DeviceType$device_number]\n";

        print INI "Name                     = ", $mugref->{'Name'}, "\n";

        print INI "Id                       = ", $mugref->{'Device'}, "\n";

        print INI "Ver                      = ", $version_decimal, "\n";

        print INI "Tier                     = ", $mugref->{'Tier'}, "\n";

        print INI "ModulesPath              = ", $mugref->{'IniName'}, "\n";

        print INI "ScanMemBackupSuper       = N\n";

        print INI "ScanMemBackupUserSuper   = N\n";

        print INI "ScanMemFlashSuper        = Y\n";

        print INI "ScanMemFlashUserSuper    = Y\n";

        print INI "\n";

    }

    #

    #   Insert options

    #

    print INI "[Options]\n";

    print INI "SuppressCDHeader         = TRUE\n";

    print INI "\n";

    close INI;

    #

    #   Run the GENAPPA utility

    #   This will create a directory full of MUG files

    #   Generate the files directly into the pkg subdirectory

    #

    my $mugdir = "$::ScmRoot/pkg/$::ScmBuildPackage/mug";

    Debug("Mugfiles will be placed in: $mugdir" );

    mkpath( $mugdir );

    #

    #   Extend the PATH to include the toolset extensions

    #   to allow use to find genappa and modcrc

    #

    my $PATH = join ';', ToolExtensionPaths(), $ENV{'PATH'};

    $ENV{'PATH'} = $PATH;

    my $opts = ($verbose > 1) ? " -d" : "";

    Debug( "Running GENAPPA");

    System( "genappa $genappa$opts -o $mugdir" ) && Error( "Problem running genappa" );

    #

    #   Cleanup the debugging interface

    #

    DebugPop();

}

#-------------------------------------------------------------------------------

# Function        : LocateLoadFile

#

# Description     : Locate a specified loadfile

#

# Inputs          : $mugref         - Per device Data store

#                   $cmdfile        - The full path to the load file

#

# Returns         : Path to the load file

#                   Will not return on error

#

sub LocateLoadFile

{

    my( $mugref, $cmdfile) = @_;

    my @load_list;

    #

    #   Has the load file been sourced

    #

    Debug ("   Locate command file: $cmdfile");

    push @load_list, $::SRCS{$cmdfile}

        if ( exists $::SRCS{$cmdfile} && -f $::SRCS{$cmdfile} );

    #

    #   The load file must exist in one of the packages or directories

    #   Locate the file and warn if multiple files are found

    #

    foreach my $dir ( @{$mugref->{'Dirs'}} )

    {

        my $path = "$dir/$cmdfile";

        Debug2 ("   Locate command file. Try: $path");

        push @load_list, $path if ( -f $path );

    }

    Error ("Load file not found in any package or directory: $cmdfile")

        unless ( $#load_list >= 0 );

    Warning ("Multiple load files found. The first one will be used",

             @load_list ) if( $#load_list > 0) ;

    #

    #   Return the full path to the first loadfile located

    #

    return $load_list[0];

}

#-------------------------------------------------------------------------------

# Function        : ReadLoadFile

#

# Description     : Read and Process a load.cmd file

#                   This file will provide the complete list of files to be

#                   mugged

#

# Inputs          : $mugref         - Per device Data store

#                   $cmdfile        - The full path to the load file

#

# Returns         :

#

sub ReadLoadFile

{

    my( $mugref, @cmdfile) = @_;

    my %filelist;

    my %seen;

    while ( @cmdfile )

    {

        my $cmdfile = pop( @cmdfile );

        $cmdfile =~ tr~\\/~/~s;

        $seen{$cmdfile} = 1;

        push @{$mugref->{'LoadFiles'}}, $cmdfile;

        Debug ("Reading load file: $cmdfile");

        #

        #   Process the cmdfile and extract the names of files to transfer

        #   Extract data of the form

        #       e=o:pathname

        #       f=pathname

        #

        open (CMD, "<$cmdfile") || Error ("Cannot open command file: $cmdfile" );

        while ( <CMD> )

        {

            #

            #   Clean up whitespace and comments

            #

            chomp;

            s~^\s*~~;

            s~\*.*$~~;

            s~\s*$~~;

            next if ( length( $_) <= 0 );

            #

            #   Clean pathnames

            #

            tr~\\/~/~s;

            if ( m/e=o:(.*)/ )

            {

                    #

                    #   Ignore any path information

                    #       - Its not valid within the context of the package

                    #   Process excluded files

                    #

                    my $file = lc StripDir($1);

                    if ( exists $mugref->{'Exclude'}{$file} )

                    {

                        $mugref->{'Exclude'}{$file}++;

                        Debug2 ("   Excluding: $file");

                    }

                    else

                    {

                        Debug2 ("   Entry: $file");

                        $filelist{$file} = 0;

                    }

            } elsif ( m/f=(.*)/ )

            {

                my $file = lc StripDir($1);

                Debug2 ("   Included load file: $file");

                $file = LocateLoadFile($mugref, $file );

                Error ("Load file already processed: $file")

                    if ( exists $seen{ $file } );

                unshift @cmdfile, $file;

                $seen{$file} = 1;

            }

        }

        close( CMD );

    }

    $mugref->{'LoadList'} = \%filelist;

}

#-------------------------------------------------------------------------------

# Function        : LocatePackage

#

# Description     : Locate a package entry

#

# Inputs          : $pname          - Name of the package

#

# Returns         : Ref to package data

#

sub LocatePackage

{

    my($pname) = @_;

    #

    #   Locate the Package

    #

    my $packagebase = $::ScmBuildPkgRules{$::ScmPlatform};

    my $package;

    foreach my $pptr ( @{$packagebase} )

    {

        if ( $pptr->{'NAME'} eq $pname )

        {

            $package = $pptr;

            last;

        }

    }

    Error("Required Package cannot be located: $pname") unless ( $package );

    return $package;

}

1;