######################################################################## # 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 ( ) { 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 ( ) { # # Process "property" statements # if ( m~{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;