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 Pod::Usage;                             # required for help support

use Getopt::Long;

use File::Spec;

use Time::HiRes;

$VERSION = 1.00;

@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)

@EXPORT = qw( processUtf help man );

#

#   Global Variables

#

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

my $opt_utfOuput;

my $opt_help = 0;

#   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 Path 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 %filterData;

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

# Function        : help

#                   man 

#

# Description     : Utility functions to make is easier for users to get POD

#                   from this module

#

# Inputs          : 

#

# Returns         : 

#

sub help

{

    pod2usage(-verbose => 0, -input =>  __FILE__);

}

sub man

{

    pod2usage(-verbose => 2, -input =>  __FILE__);

}

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

# 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 $argCount = scalar @ARGV;

    my $result = GetOptions (

                    "help|h:+"      => \$opt_help,

                    "manual:3"      => \$opt_help,

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

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

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

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

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

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

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

                    "type=s"        => \$filterData{TYPE},

                    );

    pod2usage(-verbose => 0, -input =>  __FILE__) if ($opt_help == 1 || ! $result || $argCount < 1);

    pod2usage(-verbose => 1, -input =>  __FILE__) if ($opt_help == 2 );

    pod2usage(-verbose => 2, -input =>  __FILE__) if ($opt_help  > 2);

    #   Reconfigure the verbosity level

    ErrorConfig( 'verbose', $opt_verbose);

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

    Error("Internal: No PkgDir specified") unless defined $filterData{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', $filterData{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($filterData{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))

    {

        $filterData{$entry}  = File::Spec->rel2abs($filterData{$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($filterData{PKGDIR}, 'utfResults');

    $filterData{OUTDIR} = $opt_utfOuput;

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

    mkdir $opt_utfOuput;

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

    #

    #   Add in known values from the environment

    #

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

    Error("Internal: EnvVar 'GBE_MAKE_TYPE' not specified") unless $filterData{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, "$filterData{TARGET}-$filterData{TYPE}-$time.xml");

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

    Verbose("Writing output to $filename");

    $filterData{OUTFILE} = $filename;

    #

    #   Diagnostics

    #

    if (IsVerbose(1))

    {

        DebugDumpData("Filter Parameters", \%filterData);

    }

    #

    #   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: $filterData{FILTER}");

    $module_name->processUtf(\%filterData);

}

=pod 1

=for htmltoc    SYSUTIL::

=head1 NAME

jats_runutf - Post Process UTF results for build system

=head1 SYNOPSIS

  $(GBE_PERL) -Mjats_runutf -e processUtf -- <args>

 Options:

    -help[=n]       - Brief help message

    -help -help     - Detailed help message

    -man            - Full documentation

    -verbose[=n]    - Verbose operation

    -filter=name    - Name of the required processing filter

    -target=name    - Current build target

    -root=path      - Path to the root of the build

    -pkgdir=path    - Path to the packaging directory

    -interface=path - Path to the build interface directory

    -local=path     - Path to the local build directory

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose>

This option will display progress information as the program executes.

=item B<-filter=name>

Name of the required processing filter.

=item B<-target=name>

The current build target.

=item B<-root=path>

The path to the root of the current build.

=item B<-pkgdir=path>

The path to the packaging directory

=item B<-interface=path>

The path to the build interface directory

=item B<-local=path>

The path to the local build directory

=back

=head1 DESCRIPTION

This tool is not designed to be run directly by users. It is intended to be run by the 

JATS generated makefiles in conjunction with unit tests to process the output from a unit 

test to provide a common output format to be passed on the build system.

Normally this process only occurs with the Auto BuildTool environment.

The tool provides the following operations:

=over 4

=item *

Sanitize environment

The environment passed to the filter processing module will be verified. 

The path to the output directory will be created if required. All paths will be absolute.

=item *

Locate the required filter processing module. The module must be a Perl Module with a name of the form 'UtfFilter_<name>'

=item *

Invoke the required filter module.

=back

=head2 Locating the Filter Module

The filter module may be located, in order of precedence, within:

=over 4

=item *

The package currently being built.

The package may provide its own UTF post processing module. This is not encouraged.

The following locations will be examined for a suitable module:

=over 4

=item *

The current directory. The directory of the makefile.pl that is running the unit test.

=item *

A directory in the Build Root called 'gbe/UtfFilters'

=back

=item *

An external Package, within the gbe/scripts directory.

The package can be specified with either LinkPkgArchive or BuildPkgArchive directive 

within the current packages build.pl file.

=item *

Within JATS.

Jats may provide useful filter modules.

=back

=head2 Filter Module Interface

The filter module Interface consists of four items:

=over 4

=item 1 The name of the Package

=item 1 The named function with the package

=item 1 Arguments passed to the named function

=item 1 The processing expected to be done by the named function

=item 1 The Output Format

=back

=head3 The name of the Package

Each filter function is in its own package. The package name is created by concatenating the 

text 'UtfFilter_' with the name of the required filter. 

ie: If the required filter is 'junit4', then the name of the filter package must 

be UtfFilter_junit4 and it will be held in a file named UtfFilter_junit4.pm.

=head3 The named function with the package

The filter package must provide a function called 'processUtf'

=head3 Arguments passed to the named function

The processing function 'processUtf' is called with two arguments:

=over 4

=item 1

The name of the package

=item 2

A reference to a Perl hash. The hach will contain the following named items:

=over 4

=item       FILTER          

The Name of the filter 

=item       INTERFACE       

The absolute Path to Interface directory

=item       LOCAL

The absolute Path to Local directory

=item       OUTDIR

The absolute Path to output directory

=item       OUTFILE

The absolute Path to suggested output file. The user does not need to use this name. It is 

provided to remove the need for each filter to create a unique name.

This file will not exist.

=item       PKGDIR

The absolute Path to Packaging directory. This directory will exist.

=item       ROOT

The absolute Path to Root of the build

=item       TARGET

The current make target

=item       TYPE

The build type P or D

=back

The return value from the function 'processUtf' is ignored. If the function encounters 

any error it should use the Jats 'Error' function to report the error.

=back

=head3 The processing expected to be done by the named function

The processing function is expected to transform the results of a unit test into 

a constient form so that they can be processed by the remainder of the build tool.

The processing should:

=over 4

=item *

Create information in the OUTDIR directory. 

The filter may create a new file or insert information into an existing file. 

The user may make use of the OUTFILE path, but this is not mandatory.

=item *

Report errors by calling the Jats 'Error' function. This will terminate processing.

=back

=head3 The Output Format

Yet to be defined.

=cut

1;