Subversion Repositories DevTools

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

# COPYRIGHT - VIX IP PTY LTD ("VIX"). 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

#                   --LimitDepth=n      - Limit the depth of the scan

#

#

# 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

    $self->{LimitDepth} = 0;            # Skim the tree

    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;

    } elsif ( $opt =~ m/^--LimitDepth=(\d+)/ ) {

        $self->{LimitDepth} = $1;

    } else {

        $result = 0;

    }

    return $result;

}

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

# Function        : getLocation 

#

# Description     : Serialize location data such that it can be used by the

#                   setLocation function.

#                   Format:

#                       RootDirectory

#                       Number of BuildEntry(s) that follow

#                       BuildEntry

#                   Where each BuildEntry is:

#                       Path

#                       BuildFile

#                       Type 1:Jats, 2:ANT    

#

# Inputs          :  $self

#

# Returns         :  Text string of serailised data

#

sub getLocation

{

    my ($self) = shift;

    my @locationData;

    push @locationData,  $self->{root};

    push @locationData,  scalar  @{$self->{info}};

    foreach my $be ( @{$self->{info}} )

    {

        push @locationData,  $be->{dir}, $be->{file}, $be->{type};

    }

    return (join($;, @locationData));

}

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

# Function        : setLocation 

#

# Description     : Insert location data

#                   Bypass the need to perform a 'locate' operation

#                   Used to cache location data in large systems 

#                   

#                   Will detect missing build files and allow the user to

#                   handle the error.

#

# Inputs          : $self

#                   ...     Location data as returned by getLocation

#

# Returns         : 1   - All Build files exist

#                   0   - At least one of the build files does not exist

#

sub setLocation

{

    my ($self, $data) = @_;

    my @locationData =  split($;, $data);

    my $rv = 1;

    my $root = shift @locationData;

    my $count = shift @locationData;

    while ($count-- > 0)

    {

        my $buildfile = join('/',$locationData[0], $locationData[1]);

        $rv = 0 unless -f $buildfile;    

        push @{$self->{info}}, BuildEntry( @locationData);

        splice @locationData, 0, 3;

    }

    $self->{locate_done} = 1;

    return $rv;

}

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

# 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

    my $ff_datap = \@{$self->{info}};

    my $ff_file = $self->{file};

    my $ff_all = $self->{locateAll};

    my $ff_self = $self;

    my $ff_ant = ( $ff_file =~ m~(.+)\.xml$~i ) ? $1 : '';

    #

    #   Anonymous sub for the file::find wanted function

    #       Use closure to allow access to local variables

    #       Use no_chdir to allow very deep (windows) structures

    #

    my $wanted = sub 

    {

        # Using no_chdir - extract just the filename

        my $file = $_;

        $file =~ s~.*/~~;

        Verbose3( "locateBuildFile: $file");

        if ( -d $_)

        {

            #

            #   Skip known dirs

            #   

            if ($file eq '.git' || $file eq '.svn' || $file eq 'lost+found')

            {

                $File::Find::prune = 1;

                Verbose3( "locateBuildFile: PRUNE: $file");

                return;

            }

            #

            #   Limit the depth of the scan

            #       Suggestion 3 or 4 below the package base

            #

            if ($self->{LimitDepth})

            {

                my $depth = $File::Find::name =~ tr~/~/~;

                if ($depth >= $self->{LimitDepth})

                {

                    $File::Find::prune = 1;

                    Verbose3( "locateBuildFile: LimitDepth: $_");

                    return;

                }

            }

        }

        if ( $file eq $ff_file  )

        {

            if ( $ff_ant )

            {

                if ( -f ( $File::Find::dir . '/' . ${ff_ant} . 'depends.xml') )

                {

                    Verbose ("locateBuildFile: FOUND $File::Find::dir, $file");

                    push @{$ff_datap}, BuildEntry( $File::Find::dir, $file, 2);

                }

            }

            else

            {

                $file = 'auto.pl' if ( $ff_self->{scandeps} && -f 'auto.pl' );

                Verbose ("locateBuildFile: FOUND $File::Find::dir, $file");

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

            }

            return;    

        }

        #

        #   Detect ANT {packagename}depends.xml file

        #       These are file pairs (mostly)

        #

        if ( $ff_all && $file =~ m/(.+)depends.xml$/ )

        {

            if ( -f ($File::Find::dir . '/' . $1 . '.xml') )

            {

                Verbose ("locateBuildFile: FOUND $File::Find::dir, $file");

                push @{$ff_datap}, BuildEntry( $File::Find::dir, $file, 2);

            }

        }

    };

    #

    #   Find all matching files

    #   Call helper rouine to populate the data strcutures

    #

    File::Find::find ( { wanted => $wanted, no_chdir => 1 }, $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;