######################################################################## # 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 # --stop - Ignore if a 'stop' file exists in the directory # # # 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 $self->{Stop} = 0; # Support a 'stop' file 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/^--Stop/ ) { $self->{Stop} = 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 # 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; } } # # Stop file processing # If the directory conatins a 'stop' file then we won't find any build files in it # Nor should we find any below it. # if ($self->{Stop}) { if ( -f $File::Find::name . '/stop' ) { $File::Find::prune = 1; Verbose0( "locateBuildFile: Stop file: $_"); 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) # Must not be empty # if ( $ff_all && $file =~ m/(.+)depends.xml$/ && -s $file ) { my $baseFile = $File::Find::dir . '/' . $1 . '.xml'; if ( -f $baseFile && -s $baseFile ) { 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 ( ) { 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;