Subversion Repositories DevTools

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

# Copyright (c) VIX TECHNOLOGY (AUST) LTD

#

# Module name   : jats_runutf.pm

# Module type   : JATS Utility

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : JATS Make Time Test Harness Support

#                 This package contains fucntions that will be used by JATS

#                 to invoke the tests.

#

#                 This is more powerful that the previous shell-based solution

#                 that had problems under windows.

#

#                 The functions are designed to be invoked as:

#                   $(GBE_PERL) -Mjats_runutf -e <function> -- <args>+

#

#                 The functions in this packages are designed to take parameters

#                 from @ARVG as this makes the interface easier to read.

#

# Usage         : See POD at the end of this file

#

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

require 5.008_002;

use strict;

use warnings;

package jats_runutf;

our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);

use Exporter;

use JatsError qw(:name=jats_runutf);

use Getopt::Long;

use File::Spec;

use Time::HiRes;

$VERSION = 1.00;

@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)

@EXPORT = qw( processUtf $opt_filter );

#

#   Global Variables

#

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_utfOuput;

#   Data to be passed into the filter function

#   Defined values are:

#       FILTER          - Name of the filter 

#       INTERFACE       - Abs Path to Interface directory

#       LOCAL           - Abs Path to Local directory

#       OUTDIR          - Abs Path to output directory

#       OUTFILE         - Abs Patch to suggested output file

#       PKGDIR          - Abs Path to Packaging directory

#       ROOT            - Abs Path to Root of the build

#       TARGET          - Current make target

#       TYPE            - Built type P or D

#

our %usrData;

#BEGIN

#{

#    Message "jats_runutf initiated";

#}

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

# Function        : processUtf  

#

# Description     : Main function to process UTF results

#                   This function will locate a suitable filter process and invoke

#                   it to process the results

#

#                   The filter process will be provided in a Perl Module

#                   It may be a part of JATS or an external modules provided

#                   within an external package. ie(utf may provide its own filter)

#

#

# Inputs          : None. Parameters are passed via @ARGV

#

# Returns         : Nothing

#

sub processUtf

{

    my $result = GetOptions (

                    "verbose:+"     => \$opt_verbose,       # Only set to to 0,1 or 3

                    "root=s"        => \$usrData{ROOT},

                    "filter=s"      => \$usrData{FILTER},

                    "interface=s"   => \$usrData{INTERFACE},

                    "local=s"       => \$usrData{LOCAL},

                    "target=s"      => \$usrData{TARGET},

                    "pkgdir=s"      => \$usrData{PKGDIR},

                    );

    Error("Incorrect arguments passed to processUtf") 

        unless ($result);

    #   Reconfigure the verbosity level

    ErrorConfig( 'verbose', $opt_verbose);

    Error("Internal: No Filter specified") unless defined $usrData{FILTER};

    Error("Internal: No PkgDir specified") unless defined $usrData{PKGDIR};

    #

    #   Locate the required filter module

    #   Filter modules have a name of the form:

    #       UtfFilter_<FilterName>.pm

    #   And can be located:

    #       within JATS

    #           in 'TOOLS/LIB'

    #       within a Package declared

    #           with a BuildPkgArchive or a LinkPkgArchive

    #           within the packages 'tools/scripts' subdirectory

    #       within the current package

    #           Perl modules with ROOT/gbe/utfFilters_*.pm

    #                         or  ROOT/gbe/SomeDir/utfFilters_*.pm

    #                         or in the current directory

    my $module_name = join('_','UtfFilter', $usrData{FILTER});

    Verbose("Filter Module: $module_name");

    #   Extend Perl Module search path for package-local filters

    #   Check the current directory

    #       The current directory is also within @INC, but it is at the end

    #       thus local filter will not override external filters. Place the

    #       current directory first - if it conatins a filter.

    if (-f "$module_name.pm" )

    {

        Verbose("Extend the filter module search path: Current Directory");

        unshift @INC, '.';

    }

    else

    {

        #

        #   Check package-local directory

        #       <root>/gbe/utfFilters

        #

        my $localUtfPath = File::Spec->catfile($usrData{ROOT}, 'gbe', 'utfFilters');

        if ( -f( "$localUtfPath/$module_name.pm") )

        {

            Verbose("Extend the filter module search path: $localUtfPath");

            unshift @INC, $localUtfPath;

        }

    }

    #

    #   Locate a Perl Module of the required name

    #

    eval "require $module_name";

    if ($@)

    {

        Error ("Could not load required filter module: $module_name");

    }

    #

    #   Ensure that the filter contains the required interface methods

    #

    foreach my $fname ( qw(processUtf))

    {

        ReportError("Required function DOES NOT exist: $fname")

            unless (defined($module_name->can($fname)));

    }

    ErrorDoExit();

    #

    #   Convert potentially local paths to absolute paths

    #       Simplifies use when the CWD is changed

    #

    foreach my $entry ( qw(INTERFACE LOCAL PKGDIR ROOT))

    {

        $usrData{$entry}  = File::Spec->rel2abs($usrData{$entry} );

    }

    #

    #   Ensure that the output directory is present

    #       Store utf output directly into the packaging directory in a subdirectoy called 'utfResults'

    #           This location is known to the buildtool

    #       The output path is provided to the filter process

    #

    $opt_utfOuput = File::Spec->catfile($usrData{PKGDIR}, 'utfResults');

    $usrData{OUTDIR} = $opt_utfOuput;

    Error("Packaging directory does not exist") unless -d $usrData{PKGDIR};

    mkdir $opt_utfOuput;

    Error("Creating utfResults directory") unless -d $opt_utfOuput;

    #

    #   Add in known values from the environment

    #

    $usrData{TYPE} = $ENV{'GBE_MAKE_TYPE'};

    #

    #   Create a uniq filename as a suggestion to the filter tool

    #       The filter is not forced to use it, but it is a good idea

    #

    #   Construct the output filename from the microsecond time.

    my $time = Time::HiRes::time;

    $time =~ s/\.//;

    #   Append enough '0' to make 15 chars. This make uniform length numbers

    #   and allows filename sorting.

    $time .= "0" x (15-length($time));

    my $filename = File::Spec->catfile($opt_utfOuput, "$usrData{TARGET}-$usrData{TYPE}-$time.xml");

    Error("Output file:$filename already exists: $!") if -e $filename;

    Verbose("Writing output to $filename");

    $usrData{OUTFILE} = $filename;

    #

    #   Invoke the process method

    #   If it has a problem it should use 'Error(...)' to report it

    #   There is no exit code processing

    #

    Message("Processing UTF test results using filter: $usrData{FILTER}");

    $module_name->processUtf(\%usrData);

}

1;