Subversion Repositories DevTools

########################################################################
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
#
# 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.
#
#                 Full details on the Mug File Generation process and the use of
#                 the functions provided by this extension are in:
#                       MASS-00099 Generating MUG files with JATS
#
#......................................................................#

use strict;
use warnings;
use File::Basename;
use JatsCopy;

#
#   Global data
#
my %Tiers;                              # Hash of Tiers already seen
my @ThxOnly;                            # Array of ThxOnly entries
my $verbose = 0;

MugInit();

#-------------------------------------------------------------------------------
# Function        : MugInit
#
# Description     : Module initialisation
#                   This function is run automaticlly when the package is loaded
#
# Inputs          :
#
# Returns         :
#
sub MugInit
{
}

#-------------------------------------------------------------------------------
# Function        : MugUtilities
#
# Description     : Ensure that required utilities can be located
#                   Only needs to be called if MugFiles are being created
#
# Inputs          : None
#
# Returns         : Will exit on error
#
sub MugUtilities
{
    #
    #   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) );

    #
    #   Save the current Error Reporting configuration and starta new one
    #   The state will be restored when the staved state goes out of scope
    #   at the end of the function
    #
    my $estate = ErrorReConfig ('name' => 'MugFiles');

    #
    #   Insert defaults
    #
    $muginfo{'ThxBase'} = 'thx';
    $muginfo{'SubDirList'} = [ 'thx' ];

    #
    #   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/^--SubDirs=(.*)/ ) {
            my @list = split( ',', $1 );
            $muginfo{'SubDirList'} = \@list;

        } elsif ( m/^--Package=(.*)/ ) {
            my $package_name = $1;
            my $warn = 0;
            my @dirs = @{$muginfo{'SubDirList'}};
            if ( $package_name =~ m/(.*?),--Subdir=(.*)/ )
            {
                $package_name = $1;
                @dirs = split( ',', $2 );
                $warn = 1;
            }

            my $package = GetPackageEntry( $package_name );
            Error("MugFiles: Required Package cannot be located: $package_name") unless ( $package );

            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")
                        if ( $warn );
                }
            }
            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;

        } elsif ( m{^--NoMugFiles} || m{^--ThxOnly}  ) {
            $muginfo{'NoMug'} = 1;

        } elsif ( m/^--File=(.*)/ ) {
            UniquePush( \@{$muginfo{'RawFiles'}}, $1 );

        } elsif ( m/^--ThxBase=(.*)/ ) {
            $muginfo{'ThxBase'} = $1;
            
        } else {
            Error("Unknown option: $_ ");
        }
    }

    #
    #   Ensure the user has provided all the parameters
    #
    unless ( $muginfo{'NoMug'} )
    {
        Error("No Device specified") unless ( $muginfo{'Device'} );
        Error("No Name specified") unless ( $muginfo{'Name'} );
        Error("No Tierspecified") unless ( $muginfo{'Tier'} );
        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;
    }
    else
    {
        push @ThxOnly, \%muginfo;
    }
    Error("No Packages or directories specified") unless ( $muginfo{'Dirs'} );
}

#-------------------------------------------------------------------------------
# Function        : ThxFiles
#
# Description     : Simple wrapper to create a set of THX files
#                   without mug files
#
# Inputs          : Same as for MugFiles
#
# Returns         : Same as for MugFiles
#
sub ThxFiles
{
    MugFiles     ( @_, '--NoMugFiles' );
}

#-------------------------------------------------------------------------------
# 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) = @_;
    my @versions;
    my $version_hex;
    my $version_decimal;

    foreach ( @args )
    {
        if ( /^--Debug$/ ) {
            $verbose++;

        } elsif ( /^--Debug=(\d+)/ ) {
            $verbose = $1;

        } else {
            Warning("MugFiles: Unknown option: $_");
        }
    }


    #
    #   Set new Debug header and level
    #   Save the current Error Reporting configuration and starta new one
    #   The state will be restored when the staved state goes out of scope
    #   at the end of the function
    #
    my $estate = ErrorReConfig ('name' => 'MugGenerate', 'verbose' => $verbose );

    #
    #   Enable copy operation logging
    #
    SetCopyDirDefaults ('Log' => $verbose );

    if ( keys %Tiers )
    {
        #
        #   Ensure that utilities are available
        #
        MugUtilities();
    
        #
        #   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
        #
        @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 ) ;

        $version_hex = $versions[0] * 100 + $versions[1];
        $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), @ThxOnly )
    {

        #
        #   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
        #
        unless ( $mugref->{'NoMug'} )
        {
            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;
        }

        #
        #   Expand the list namewd files
        #   Search the packages for the files.
        #
        if ( $mugref->{'RawFiles'} )
        {
            my %files_found;
            my @ffiles;
            foreach my $dir ( @{$mugref->{'Dirs'}} )
            {
                Debug("Searching for specified files in directory: $dir");
                foreach  ( @{$mugref->{'RawFiles'}} )
                {
                    my $full_path = "$dir/$_";
                    next unless ( -f $full_path );

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

                    #
                    #   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} = $full_path;
                    push @ffiles, $full_path;
                    Debug2 ("   File: $_");
                
                }
            }

            #
            #   Test for missing files
            #
            my @missing;
            foreach  ( @{$mugref->{'RawFiles'}} )
            {
                unless ( exists ($files_found{ lc($_)})  )
                {
                    push @missing, $_;
                }
            }
            Error ("The following named files could not be found", @missing )
                if ( @missing );

            $mugref->{'RawFiles'} = \@ffiles;
        }
        
        #
        #   Transfer THX files into the package
        #
        if ( $mugref->{'ThxCopyDir'} )
        {
            my $thxdir = "$::ScmRoot/pkg/$::ScmBuildPackage/$mugref->{'ThxBase'}/$mugref->{'ThxCopyDir'}";
            $thxdir =~ s/-$//g;
            $thxdir =~ s~//~/~g;
            $thxdir =~ s~/\./~/~g;
            Debug("THX files will be placed in: $thxdir" );

            CreateDir ( $thxdir );
            CopyFile ($mugref->{'Files'}        ,$thxdir );
            CopyFile ($mugref->{'LoadFiles'}    ,$thxdir );
            CopyFile ($mugref->{'RawFiles'}     ,$thxdir );
        }

        DebugDumpData("Processed Mug", $mugref)
            if $verbose > 2;
    }

    if ( keys %Tiers )
    {
        #
        #   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" );
        CreateDir( $mugdir , 'DeleteFirst' => 1);

        #
        #   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" );
    }
}

#-------------------------------------------------------------------------------
# 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;

}

1;