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;