Subversion Repositories DevTools

########################################################################
# Copyright (C) 2008 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Class to provide utilities associated with a locating
#                 build files and build file dependencies.
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

package JatsBuildFiles;
use JatsError;
use File::Find;
use BuildName;
use JatsVersionUtils;

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

$VERSION = 1.00;
@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)
@EXPORT = qw( BuildFileScanner
            );


#-------------------------------------------------------------------------------
# Function        : BuildEntry
#
# Description     : Create a BuildEntry Object
#                   This object describes a build file. It is passed to the
#                   user of this class.
#
#                   There are no object accessors.
#                   Just use the object as a reference to hash.
#
# Inputs          : $dir                - Dir of the build file
#                   $file               - Name of the build file
#                   $type               - Type 1:Jats, 2:ANT
#
# Returns         : Reference to an object
#
sub BuildEntry
{
    my $self  = {};

    $self->{dir} = shift;
    $self->{file}  = shift;
    $self->{type} = shift;

    #
    #   Other fields that are known:
    #       name
    #       version
    #       full
    #       mname
    #       project
    #

    bless ($self, 'BuildEntry');
    return $self;
}

#-------------------------------------------------------------------------------
# Function        : BuildFileScanner
#
# Description     : Create a new instance of a build file class
#                   This is the one exported function of this class
#                   It is a constructor to allow scanning for build files
#
# Inputs          : root            - Base pathname
#                   file            - Build filename
#                   options         - Options to be processed
#
#                   Options are:
#                   --ScanDependencies  - Collect information on dependent packages
#                   --LocateAll         - Scan for ANT and JATS build files
#
#
# Returns         : A reference to class.
#
sub BuildFileScanner {
    my $self  = {};

    $self->{root} = shift;
    $self->{file}  = shift;
    $self->{info} = [];
    $self->{scandeps} = 0;
    $self->{locateAll} = 0;             # Scan Jats and Ant files

    bless ($self);

    Error ("Locating Build files. Root directory not found",
           "Path: $self->{root}" ) unless ( -d $self->{root} );
    #
    #   Process user arguments.
    #   These are treated as options. Leading '--' is optional
    #
    foreach ( @_ )
    {
        my $opt = '--' . $_;
        $opt =~ s~^----~--~;
        $self->option ($opt) || Error( "BuildFileScanner. Unknown initialiser: $_");
    }
    return $self;
}

#-------------------------------------------------------------------------------
# Function        : option
#
# Description     : Function to simplify the processing of arguments
#                   Given an argument this function will act on it or
#                   return false
#
# Inputs          : option          - One possible standard search option
#
# Returns         : True            - Option is an  option and its been
#                                     processed
#
sub option
{
    my ($self, $opt) = @_;
    my $result = 1;

    if ( $opt =~ m/^--ScanDependencies/ ) {
        $self->{scandeps} = 1;

    } elsif ( $opt =~ m/^--ScanExactDependencies/ ) {
        $self->{scandeps} = 2;

    } elsif ( $opt =~ m/^--LocateAll/ ) {
        $self->{locateAll} = 1;

    } else {
        $result = 0;

    }
    return $result;
}

#-------------------------------------------------------------------------------
# Function        : locate
#
# Description     : Locate all build files within a given directory tree
#                   Collects the data and builds up a data structure
#
#                   If the file is an xml file, then we are looking for
#                   an ant pair of files.
#
# Inputs          : $self
#
# Returns         : Number of buildfiles found 0,1 ....
#
sub locate
{
    my ($self) = @_;

    #
    #   Locate all the build files that match the users request
    #   Use 'our' to avoid closure issues

    our  $ff_datap = \@{$self->{info}};
    our  $ff_file = $self->{file};
    our  $ff_all = $self->{locateAll};
    our  $ff_self = $self;
    our  $ff_ant = ( $ff_file =~ m~(.+)\.xml$~i ) ? $1 : '';

    sub find_file_wanted
    {
        Verbose3( "find_file_wanted: $_");
        if ( $_ eq $ff_file  )
        {
            if ( $ff_ant )
            {
                if ( -f (${ff_ant} . 'depends.xml') )
                {
                    Verbose ("find_file_wanted: FOUND $File::Find::dir, $_");
                    push @{$ff_datap}, BuildEntry( $File::Find::dir, $_, 2);
                }
            }
            else
            {
                $_ = 'auto.pl' if ( $ff_self->{scandeps} && -f 'auto.pl' );
                Verbose ("find_file_wanted: FOUND $File::Find::dir, $_");
                push @{$ff_datap}, BuildEntry( $File::Find::dir, $_, 1);
            }
            return;    
        }

        #
        #   Detect ANT {packagename}depends.xml file
        #   These are file pairs (mostly)
        #
        if ( $ff_all && $_ =~ m/(.+)depends.xml$/ )
        {
            if ( -f $1 . '.xml' )
            {
                Verbose ("find_file_wanted: FOUND $File::Find::dir, $_");
                push @{$ff_datap}, BuildEntry( $File::Find::dir, $_, 2);
            }
        }
    }

    #
    #   Find all matching files
    #   Call helper rouine to populate the data strcutures
    #
    File::Find::find ( \&find_file_wanted, $self->{root} );

    #
    #   Flag that the directories have been scanned
    #
    $self->{locate_done} = 1;
    return scalar  @{$self->{info}};
}

#-------------------------------------------------------------------------------
# Function        : scan
#
# Description     : Scan all buildfiles and determine the packages that are
#                   created by file(s)
#
#                   This routine can extract build dependency information, but
#                   this is not done by default
#
# Inputs          : $self
#
# Returns         : 
#
sub scan
{
    my ($self) = @_;

    #
    #   Locate the buildfiles, unless this has been done
    #
    locate ( $self ) unless ( $self->{locate_done} );

    #
    #   Scan all build files and determine the target package name
    #
    #
    foreach my $be ( @{$self->{info}} )
    {
        if ( $be->{type} == 2 ) {
            scan_ant ( $be, $self->{scandeps} );
        } else {
            scan_jats( $be, $self->{scandeps} );
        }

        #
        #   Skip invalid build files
        #
        next unless ( $be->{name} &&  $be->{version}  );

        #
        #   Calculate internal information from the basic information
        #   To be used as a Display Name (Display to user)
        #   full    - Full package version and extension
        #   mname   - name and extension
        #
        #   To be used for data processing (Hash key into data)
        #   fullTag - Full package version and extension $; joiner
        #   package - name and extension with a $; joiner
        #
        #
        $be->{fullTag} = join $;, $be->{name}, $be->{version}, $be->{prj};
        $be->{package} = join $;, $be->{name}, $be->{prj};
        
        $be->{version} .= '.' . $be->{prj} if ( $be->{prj} );

        $be->{full} = $be->{name} . ' ' . $be->{version};
        $be->{mname} = $be->{name};
        $be->{mname} .= '.' . $be->{prj} if ( $be->{prj} );

        Verbose2( "Buildfile: $be->{dir}, $be->{file},$be->{name}");
    }
    $self->{scan_done} = 1;
}

#-------------------------------------------------------------------------------
# Function        : scan_jats
#
# Description     : Scan a jats build file
#
# Inputs          : $be         - Reference to a BuildEntry
#                   $scanDeps   - Include dependency information
#
# Returns         : Nothing
#
sub scan_jats
{
    my ($be, $scanDeps ) = @_;

    my $infile = "$be->{dir}/$be->{file}";
    open ( INFILE, "<$infile" ) || Error( "Cannot open $infile" );
    while ( <INFILE> )
    {
        next if ( m~^\s*#~ );            # Skip comments
        #
        #   Process BuildName
        #
        if ( m~\s*BuildName[\s\(]~ )
        {
            #   Build names come in many flavours, luckily we have a function
            #
            m~\(\s*(.*?)\s*\)~;
            my @args = split /\s*,\s*/, $1;
            my $build_info = BuildName::parseBuildName( @args );

            $be->{name} = $build_info->{BUILDNAME_PACKAGE};
            $be->{version} = $build_info->{BUILDNAME_VERSION};
            $be->{prj} = $build_info->{BUILDNAME_PROJECT};
        }

        #
        #   (Optional) Process BuildPkgArchive and LinkPkgArchive
        #   Retain the Name and the ProjectSuffix and the version
        #
        if ( $scanDeps && ( m/^LinkPkgArchive/ or m/^BuildPkgArchive/ ))
        {
            m/['"](.*?)['"][^'"]*['"](.*?)['"]/;

            my ( $package, $rel, $suf, $full ) = SplitPackage( $1, $2 );
            if ( $scanDeps > 1 ) {
                $be->{depends}{$package,$rel,$suf} = join ($;, $1, $2);
            } else {
                $be->{depends}{$package,$suf} = join ($;, $1, $2);
            }
        }
    }
    close INFILE;
}


#-------------------------------------------------------------------------------
# Function        : scan_ant
#
# Description     : Scan an ant build file
#
# Inputs          : $be         - Reference to a BuildEntry
#                   $scanDeps   - Include dependency information
#
# Returns         : Nothing
#
sub scan_ant
{
    my ($be, $scanDeps ) = @_;
    my $infile = "$be->{dir}/$be->{file}";
    my $release_name;
    my $release_version;

    open ( INFILE, "<$infile" ) || Error( "Cannot open $infile" );
    while ( <INFILE> )
    {
        #
        #   Process "property" statements
        #
        if ( m~<property~ )
        {
            my $name;
            my $value;

            #
            #   Extract the name and version
            #
            $name = $1 if m~name=\"([^"]*)"~;
            $value = $1 if m~value=\"([^"]*)"~;

            if ( $name && $value )
            {
                if ( $name eq 'packagename' ) {
                    $release_name = $value;

                } elsif ( $name eq 'packageversion' ) {
                    $release_version = $value;
                    my ( $package, $rel, $suf, $full ) = SplitPackage( $release_name, $release_version );
                    $be->{name} = $package;
                    $be->{version} = $rel;
                    $be->{prj} = $suf;

                } elsif ( $name eq 'releasemanager.releasename' ) {
                    next;

                } elsif ( $name eq 'releasemanager.projectname' ) {
                    next;
                    
                } elsif ( $scanDeps ) {
                    my ( $package, $rel, $suf, $full ) = SplitPackage( $name, $value );
                    if ( $scanDeps > 1 ) {
                        $be->{depends}{$package,$rel,$suf} = join ($;, $name, $value);
                    } else {
                        $be->{depends}{$package,$suf} = join ($;, $name, $value);
                    }
                }
            }
        }
    }
    close INFILE;
}

#-------------------------------------------------------------------------------
# Function        : getInfo
#
# Description     : Returns an array of stuff that can be used to iterate
#                   over the collected data.
#
#                   Will perform a 'locate' if not already done
#
#                   The elements are BuildEntries
#                   These are pretty simple
#
# Inputs          : $self
#
# Returns         : 
#
sub getInfo
{
    my ($self) = @_;

    #
    #   Locate the buildfiles, unless this has been done
    #
    locate ( $self ) unless ( $self->{locate_done} );

    return @{$self->{info}};
}

#-------------------------------------------------------------------------------
# Function        : match
#
# Description     : Determine build files that match a given package
#                   A full package name has three fields
#                       1) Name
#                       2) Version
#                       3) Extension (optional)
#                   The package can be specified as:
#                       Name.Version.Extension
#                       Name.Extension
#
# Inputs          : $self
#                   $package                - See above
#
# Returns         : Number of buildfiles that match
#
sub match
{
    my ($self, $package) = @_;
    return 0 unless ( $package );
    scan ( $self ) unless ( $self->{scan_done} );

    $self->{match} = [];

    foreach my $be ( @{$self->{info}} )
    {
        next unless ( $be->{name} &&  $be->{version}  );
        if ( $package eq $be->{mname} || $package eq ($be->{name} . '.' . $be->{version}) )
        {
            push @{$self->{match}}, $be;
        }
    }

    $self->{match_done} = 1;
    return scalar @{$self->{match}}
}

#-------------------------------------------------------------------------------
# Function        : getMatchList
#
# Description     : Get the results of a match
#                   If no match has been done, then return the complete
#                   list - Like getInfo
#
# Inputs          : $self
#
# Returns         : Array of directories that matched the last match
#
sub getMatchList
{
    my ($self) = @_;
    my $set = 'info';
    $set = 'match' if ( $self->{match_done} );

    return @{$self->{$set}};
}

#-------------------------------------------------------------------------------
# Function        : getMatchDir
#
# Description     : Get the results of a match
#                   Can be an array or a scalar. If a scalar is requested
#                   then this rouitne will ensure that only one entry
#                   has been matched.
#
# Inputs          : $self
#
# Returns         : Array of directories that matched the last match
#
sub getMatchDir
{
    my ($self) = @_;
    my @list;
    foreach my $be ( $self->getMatchList() )
    {
        push @list, $be->{dir};
    }

    if ( wantarray )
    {
        return @list;
    }

    Error ("Locate Build file. Internal error",
           "Multiple build files have been located. This condition should have",
           "been handled by the application") if ( $#list > 0 );

    return $list[0];
}

#-------------------------------------------------------------------------------
# Function        : formatData
#
# Description     : Create an array of build files and package names
#                   Used to pretty print error messages
#
# Inputs          : $self
#
# Returns         : Array of text strings formatted as:
#                   path : packagename
#
#
sub formatData
{

    my ($self) = @_;
    my @text;

    my $max_len = 0;
    my %data;

    #
    #   Travserse the internal data
    #
    foreach my $be ( @{$self->{info}} )
    {
        my $package = $be->{mname} || '-Undefined-';
        my $path = "$be->{dir}/$be->{file}";
        my $len = length $path;
        $max_len = $len if ( $len > $max_len );
        $data{$path} = $package;
    }

    foreach my $path ( sort keys %data )
    {
        push (@text, sprintf ("%${max_len}s : %s", $path, $data{$path} ));
    }
    
    return @text;
}

1;