Subversion Repositories DevTools

################################################################################
# Copyright (C) 2008 ERG Limited, All rights reserved
#
# Module name   : cabwiz
# Module type   : JATS Plugin
# Compiler(s)   : PERL
# Environment(s): JATS
#
# Description   : This program is a wrapper around the real CABWIZ
#                 binary. It hides, from the user, a number of issues
#                 with the CABWIZ program
#
#                 Intended to be invoked at "make-time"
#
#                 Will process INF file and locate required files and regenerate
#                 the users INF file to access the files required
#
# --- Help ---------------------------------------------------------------------
# Windows CE CAB Wizard
# Usage:  inf_file [/dest dest_dir]
#                  [/err err_file]
#                  [/cpu cpu_type [cpu_type]]
#                  [/platform platform_name]
#
# inf_file                INF source file to use
# dest_dir                absolute dest dir for CAB files
# err_file                error file
# cpu_type                cpu types to support in the INF file
# platform_name           the name of the platform to support in the INF file
#
#
# Usage:
#
#..............................................................................#

require 5.008_002;
use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;

use JatsError qw( :name=CABWIZ );
use JatsSystem;
use FileUtils;

#
#   Globals
#
my $VERSION = "1.0.0";
my $opt_help = 0;
my $opt_verbose = 0;
my $opt_clean;
my $opt_inf;
my $opt_outdir;
my $opt_outfile;
my @opt_cpu;
my $opt_platform;
my $opt_interface;
my $opt_local;
my $opt_type;
my $opt_target;

my $base_file;
my $tmp_inf;
my $tmp_err;
my $gen_cab;

#
#   Configuration options
#
my $result = GetOptions (
                "help:+"        => \$opt_help,              # flag, multiple use allowed
                "manual:3"      => \$opt_help,              # flag
                "verbose:+"     => \$opt_verbose,           # flag
                "interfacedir=s"=> \$opt_interface,
                "LocalDir=s"    => \$opt_local,
                "platform=s"    => \$opt_target,
                "type=s"        => \$opt_type,

                "clean"             => \$opt_clean,
                "information=s"     => \$opt_inf,
                "output=s"          => \$opt_outfile,
                "cpu=s"             => \@opt_cpu,
                "platform_name=s"   => \$opt_platform,

                #
                #   Update documentation at the end of the file
                #
                );

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
pod2usage(-verbose => 1)  if ( $opt_help == 2 );
pod2usage(-verbose => 2)  if ( $opt_help > 2 );

#
#   Configure error reporting system
#
ErrorConfig( 'verbose' => $opt_verbose );

#
#   Configure File Utils
#   Setup the CWD
#
InitFileUtils();

#
#   Sanity check
#
Error ("No INF file") unless ( $opt_inf );
Error ("INF File not found: $opt_inf") unless ( -f $opt_inf );
Error ("No Output specified" ) unless ( $opt_outfile );
Error ("No Interface directory" ) unless ( $opt_interface );
Error ("No Local directory" ) unless ( $opt_local );
Error ("No Target Platform" ) unless ( $opt_target );
Error ("No Build Type" ) unless ( $opt_type );

#
#   Use the INF filename as a base
#   Determine the output directory
#       Do this early so that we can clean up
#
$base_file = StripDirExt( $opt_inf );
$opt_outdir = StripFileExt( $opt_outfile ) || '.';

$tmp_inf = $opt_outdir . '/' . $base_file . '.inf';
$tmp_err = $opt_outdir . '/' . $base_file . '.err';

#   The underlying utility generates a .CAB file
#   The EXT is in upper case
#   Make is case-sensitive
#
$gen_cab = $opt_outdir . '/' . $base_file . '.CAB';

#
#   Perform Clean up
#   Invoked during "make clean" or "make clobber"
#
if ( $opt_clean )
{
    if ( -d $opt_outdir )
    {
        unlink ( "$opt_outdir/$base_file.DAT");
        unlink ( $gen_cab);
        unlink ( $tmp_inf );
        unlink ( $tmp_err );
        unlink ( $opt_outfile );
    }
    exit 0;
}

#
#   Determine the absolute path to the executable
#   This is required as CABWIZ uses its own path to locate other
#   files that it needs.
#
my $cabwiz_path = LocateProgInPath( 'cabwiz.exe' );
Error ("CabWiz program cannot be found") unless ( $cabwiz_path );

#
#   Ensure the output directory is present
#
Error ("Output Path not found: $opt_outdir") unless ( -d $opt_outdir );

#
#   Rewrite the INF file
#   Transfer it to the output directory in the process
#
process_inf_file($opt_inf, $tmp_inf);

#
#   Create an array that will be the CabWiz command
#       Convert paths to Absolute Windoes form
#       Always use an error file: Prevents the app from creating pop-ups
#
my @cmd = (WinAbs($cabwiz_path), WinAbs($tmp_inf));
push @cmd, '/dest', WinAbs($opt_outdir);
push @cmd, '/err', WinAbs($tmp_err);
push @cmd, '/cpu', @opt_cpu, if ( @opt_cpu );
push @cmd, '/platform', $opt_platform if ( $opt_platform );

#
#   Execute the command
#   Handle errors my self
#
unlink ( $tmp_err );
my $rv = System ('--NoExit',@cmd);

#
#   Display any warnings/errors from the CabWiz util
#
System ('cat', $tmp_err ) if ( -f $tmp_err );

#
#   Do we have a CAB file
#
Error ("CabWiz reported an error") if ( $rv );
Error ("Genereted CAB file not found",$gen_cab) unless ( -f $gen_cab );

#
#   Fix case/name of the output file
#   Note: Both are in Non-Windows format so we can do a direct comparison
#
Verbose ("Generated File : $gen_cab");
Verbose ("User Named File: $opt_outfile");
unless ( $opt_outfile eq $gen_cab )
{
    Verbose ("Renaming output CAB file");
    rename $gen_cab,$opt_outfile ;
}

exit 0;


#-------------------------------------------------------------------------------
# Function        : WinAbs
#
# Description     : Convert a relative file name into an absolute
#                   widnows Sytle file name
#
# Inputs          : $_[0]               - Name to convert
#
# Returns         : Absolute file name with windows \
#
sub WinAbs
{
    my $file = FullPath( $_[0] );
    $file =~ tr~/~\\~s;
    return $file;
}

#-------------------------------------------------------------------------------
# Function        : process_inf_file
#
# Description     : Rewrite the INF file
#                   Modify 'SourceDisksNames' and 'SourceDisksFiles'
#                   to address files found within the scope of the package
#
# Inputs          : $src            - Source INF file
#                   $outfile        - Output filename
#
# Returns         : Nothing
#

sub process_inf_file
{
    my ($src, $outfile) = @_;
    my $section = '';                           # Initial Unknown section
    my @sections;                               # Order of the sections
    my %info;                                   # Hash of arrays
    my @data;                                   # Accumulate data
    my %dirs;                                   # Dirs for files
    my $dirs_index;                             # Dirs index


    Error ("Source INF not found: $src") unless ( -f $src );

    #
    #   Open the INF file
    #   Read it in
    #       Break it into sections
    #       Retain comment blocks
    #
    open (PF, "<$src") || Error ("Cannot open file: $src", "Reason: $!");
    while ( <PF> )
    {
        s~\s+$~~ ;                          # Strip trailing white space + eol(s)
        if ( m~^\[(.+)\]~ )                 # Detect start of a new section
        {
            #
            #   Save data from current section
            #
            $info{$section} = [@data];      # Section data
            push @sections, $section;       # Retain section ordering
            @data = ();

            $section = $1;
            next;
        }
        push @data, $_;
    }
    $info{$section} = [@data];              # Last section
    push @sections, $section;               # Last section
    close PF;

    #
    #   Scan entries in the "SourceDisksFiles"
    #   Locate the files that have been named
    #   Allow user to place path into in filename
    #
    #   Format:
    #       <filename> = <source ID>
    #       <filename> is the source filename (enclose in doublequotes for long filenames)
    #       <source ID> is the ID used in [SourceDisksNames] to specify the source directory
    #
    @data = ();
    $section = 'SourceDisksFiles';
    foreach  ( @{$info{$section}} )
    {
        #
        #   Keep coments
        #
        if ( m~^\s*;~  || m~^\s*$~)
        {
            push @data, $_;
            next;
        }

        m~(.+?)\s*=\s*(.+?)(\s*;.*)?$~ || Error ("Could not parse INF line","Line: $_");
        my $file = $1;
        my $index = $2;
        my $comment = $3 || '';

        $file = $1 if ( $file =~ m~^"(.+)"$~ );
        my $dir;
        ($dir, $file) = locate_file_in_packages ($file);
        if ( exists $dirs{$dir} )
        {
            $index = $dirs{$dir}{index};
        }
        else
        {
            $index = ++$dirs_index;
            $dirs{$dir}{index} = $index;
        }

        push @data, "\"$file\" = $index${comment}";
        Verbose ("INF: $section: $file :: $index :: $dir" );
    }
    $info{$section} = [@data];


    #
    #   Scan entries in SourceDisksNames
    #   Comment out the entire section and rewrite it with information
    #   that has been collected on the fly
    #   Use absolute directory paths
    #
    #   Format:
    #       <source ID> = ,<label>,,<source directory>
    #           <source ID>         will be used to specify the source files
    #                               belonging to this directory
    #           <label>             is unused
    #           <source directory>  is the relative or absolute directory
    #                               of the source files
    #
    #
    @data = ();
    $section = 'SourceDisksNames';

    #
    #   Insert new data
    #
    foreach my $dir ( keys %dirs )
    {
        my $tag = $dirs{$dir}{index};
        my $sdir = WinAbs($dir);
        push @data, "$tag = ,\"Jats Generated\",,\"${sdir}\"";
        Verbose ("INF: SourceDisksNames: $tag :: $sdir" );
    }
    @data = sort @data;
    
    foreach  ( @{$info{$section}} )
    {
        #
        #   Retain original - but as a comment
        #
        my $prefix = ($_ =~ m~^\s*;~) ? '' : '; ';
        push @data, $prefix . $_;
    }

    $info{$section} = [@data];

    #
    #   Generate the output file
    #   Create an array of arrays to output
    #
    @data = ();
    foreach $section ( @sections )
    {
        push @data, "[$section]" if ( $section );
        push @data, \@{$info{$section}};
    }

    Verbose ("Rewrite INF file: $outfile");
    FileCreate ($outfile, @data );
}

#-------------------------------------------------------------------------------
# Function        : locate_file_in_packages
#
# Description     : Locate a named file in the source packages
#                   This is a simple Package File Scanner
#                   It is designed to pick up
#                       Windows executables (bin)
#                       Windows shared libraries (lib)
#                       Config files (etc)
#
# Inputs          : $file           - Name of file to find
#                                     May contain a directory
#
#
# Returns         : Path to the file ( without the file name)
#                   Filename
#
my @pkg_paths;
my @plat_parts;
my @locate_dir_list;
sub locate_file_in_packages
{
    my ($file) = @_;
    my @found;
    my @scanned;
    Debug ("Locate file: $file");

    #
    #   Read in package data from build files
    #   Determine list of package directories
    #   Determine list of platform parts
    #
    unless ( @plat_parts )
    {
        use ReadBuildConfig;
        ReadBuildConfig( $opt_interface, $opt_target, '--NoTest' );
        @pkg_paths = ($opt_local, getPackagePaths("--Interface=$opt_interface"));
        @plat_parts = getPlatformParts ();

        #
        #   Create a list of available directories
        #   Do this once as it may be slow
        #
        @locate_dir_list  = qw(.); 
        foreach my $pkg ( @pkg_paths )
        {
            foreach my $part ( @plat_parts, '' )
            {
                foreach my $bit ( 'bin', 'lib', 'etc' )
                {
                    my @types = ($part) ? ($opt_type) : ();
                    foreach my $type ( @types ,'' )
                    {
                        my @joins = ($part) ? ("$bit.", "$bit/", "$bit/$bit.") : ("$bit/");
                        foreach my $join ( @joins )
                        {
                            my $dir = "$pkg/$join$part$type";
                            push @locate_dir_list, $dir if ( -d $dir);
                        }
                    }
                }
            }
        }
        Verbose2 ("Scan Files in:", @locate_dir_list);
    }

    #
    #   Scan the list of known available directories for the specified file.
    #
    foreach my $dir ( @locate_dir_list )
    {
        Verbose2 ("Look at: $file:  $dir");
        next unless ( -f "$dir/$file" );
        push @found, $dir;
    }

    #
    #   Report errors and warnings
    #
    Error ("Required file not found in packages: $file","Scanned:", @locate_dir_list)
        if ( $#found < 0 );
    Warning ("Required file found in multiple locations. First used",
             "File: $file",
             "Locations:", @found ) if ( $#found > 0 );

    #
    #   All the usr to specify 'subdir/path/file'
    #   Return file and dir
    #
    my $dir = "$found[0]/$file";
    return (StripFileExt($dir), StripDir($dir));
}

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=head1 NAME

cabwiz.pl - CabWiz wrapper

=head1 SYNOPSIS

  cabwiz.pl [options]

 Options:
    -help[=n]           - brief help message
    -help -help         - Detailed help message
    -man[=n]            - Full documentation
    -verbose[=n]        - Verbose operation
    -clean              - Clean up generated files
    -information=path   - Path of the INFO file
    -output=file        - Generated CAB file
    -cpu=name           - Name of CPU (optional, multiple)
    -platform=name      - Named platform (optional)

=head1 OPTIONS

=over 8

=item B<-help[=n]>

Print a brief help message and exits.

The verbosity of the help text can be controlled by setting the help level to a
number in the range of 1 to 3, or by invoking the option multiple times.

=item B<-man[=n]>

Without a numeric argument this is the same as -help=3. Full help will be
displayed.

With a numeric argument, this option is the same as -help=n.

=item B<-verbose[=n]>

This option will increase the level of verbosity of the utility.

If an argument is provided, then it will be used to set the level, otherwise the
existing level will be incremented. This option may be specified multiple times.

=item B<-information=xxxx>

This option specifies the name of source INF file used in the creation of a
Cabnet file. This option is mandatory.

=item B<-output=xxxx>

This option specifies the name of the generated CAB file.
The directory compoennt of this file will be used by the underlying utilities
as a work area and the root of the INF file

This wrapper script will correct the case and name of the generated CAB file
to that required by the user.

=item B<-cpu=name>

This option specifies the name of a CPU for which the CAB file will be
generated. This option may be specified more than once to allow the
specification of multiple CPUs.

=item B<-platform=name>

This option, if present, specifies the name of the platform for which the CAB
file will be generated.

=back

=head1 DESCRIPTION

This utility is used to simplify the interface to the CabWiz executable within
the JATS build environment.

It will:

=over 8

=item * Scan the SourceDisksFiles section

It scans this section to determine the source files used by the INF file, the
utilty will then create a local copy of te INF file and create the
SourceDisksNames and SourceDisksFiles to use absolute paths to files located
within external packages.

=item * Convert relative pathnames to absolute names

=item * Rename the generated CAB file as required

=item * Clean up intermediate files

=back

=cut