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/^--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

#

# 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;

    sub find_file_wanted

    {

        if ( $_ eq $ff_file  )

        {

            Verbose ("find_file_wanted: FOUND $File::Find::dir, $_");

            push @{$ff_datap}, BuildEntry( $File::Find::dir, $_, 1);

        }

        #

        #   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} );

        }

        #

        #   Calculate internal information from the basic information

        #   full  - Full package version and extension

        #   mname - name and extension

        #   package - name and extension with a $; joiner

        #

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

        $be->{full} = $be->{name} . '.' . $be->{version};

        $be->{mname} = $be->{name};

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

        $be->{package} = join $;, $be->{name}, $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 );

            $be->{depends}{$package,$suf} = $rel;

        }

    }

    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 ( $scanDeps ) {

                    my ( $package, $rel, $suf, $full ) = SplitPackage( $name, $value );

                    $be->{depends}{$package,$suf} = $rel;

                }

            }

        }

    }

    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}} )

    {

        if ( $package eq $be->{mname} || $package eq $be->{full} )

        {

            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};

        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;