Rev 299 | Rev 325 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### Copyright (C) 2008 ERG Limited, All rights reserved## Module name : jats_sandbox.pl# Module type : JATS Utility# Compiler(s) : Perl# Environment(s): JATS## Description : A script to build a collection of packages in the# same sandbox. This script will:## Determine the packages in the sandbox# Determine the build order of the packages# Build the packages in the correct order# Make the packages in the correct order## The script will allow for:# The creation of a sandbox# The addition of packages to the sandbox# Removal of packages from the sandbox### Command syntax (basic)# jats sandbox <command> (options | actions)@## Commands include:# create - Create a sandbox# delete - Delete a sandbox## add package_name - Add a package to the sandbox# rm package_name - Remove a package from the sandbox## build - Build all packages in the sandbox# make - make all packages in the sandbox##......................................................................#require 5.008_002;use strict;use warnings;use JatsError;use JatsSystem;use FileUtils;use JatsBuildFiles;use JatsVersionUtils;use File::Path qw(rmtree);use Pod::Usage; # required for help supportuse Getopt::Long qw(:config require_order); # Stop on non-optionmy $VERSION = "1.0.0"; # Update this## Options#my $opt_debug = $ENV{'GBE_DEBUG'}; # Allow global debugmy $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbosemy $opt_help = 0;## Globals - Provided by the JATS environment#my $USER = $ENV{'USER'};my $UNIX = $ENV{'GBE_UNIX'};my $HOME = $ENV{'HOME'};my $GBE_SANDBOX = $ENV{'GBE_SANDBOX'};my $GBE_DPKG_SBOX= $ENV{'GBE_DPKG_SBOX'};## Globals#my @build_order = (); # Build Ordered list of entriesmy %extern_deps; # Hash of external dependenciesmy %packages; # Hash of packages#-------------------------------------------------------------------------------# Function : Mainline Entry Point## Description :## Inputs :#my $result = GetOptions ("help|h:+" => \$opt_help,"manual:3" => \$opt_help,"verbose+" => \$opt_verbose, # flag, multiple use allowed);## UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!### Process help and manual options#pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);pod2usage(-verbose => 1) if ($opt_help == 2 );pod2usage(-verbose => 2) if ($opt_help > 2 );## Configure the error reporting process now that we have the user options#ErrorConfig( 'name' => 'SANDBOX','verbose' => $opt_verbose );## Validate user options### Parse the user command and decide what to do##my $cmd = shift @ARGV || "";help(1) if ( $cmd =~ m/^help$/ || $cmd eq "" );delete_sandbox() if ( $cmd =~ m/^delete$/ );create_sandbox() if ( $cmd =~ m/^create$/ );info(@ARGV) if ( $cmd =~ m/^info$/ );cmd(@ARGV) if ( $cmd =~ m/^cmd$/ );cmd($cmd, @ARGV ) if ( $cmd =~ m/(^all$)|(^build$)|(^make$)/ );clean($cmd, @ARGV) if ( $cmd =~ m/(^clobber$)|(^clean$)/ );Error ("Unknown sandbox command: $cmd");exit 1;#-------------------------------------------------------------------------------## Give the user a clue#sub help{my ($level) = @_;$level = $opt_help unless ( $level );pod2usage(-verbose => 0, -message => "Version: ". $VERSION) if ($level == 1 );pod2usage(-verbose => $level -1 );}#-------------------------------------------------------------------------------# Function : create_sandbox## Description : create a sandbox in the current current directory## Inputs : None##sub create_sandbox{Error ("Cannot create a sandbox within a sandbox","Sandbox base is: $GBE_SANDBOX" ) if ( $GBE_SANDBOX );mkdir ('sandbox_dpkg_archive') || Error ("Cannot create the directory: sandbox_dpkg_archive") ;exit 0;}#-------------------------------------------------------------------------------# Function : delete_sandbox## Description : Delete a sandbox# Its up to the user the delete the components in the sandbox## Inputs : None## Returns :#sub delete_sandbox{unless ( $GBE_SANDBOX ){Warning("No sandbox found to delete");}else{my $sdir = "$GBE_SANDBOX/sandbox_dpkg_archive";rmtree($sdir,0,0);Error ("Sandbox directory not completly removed")if ( -e $sdir );Message("Sandbox information deleted","Sandbox components must be manually deleted");}exit 0;}#-------------------------------------------------------------------------------# Function : info## Description : Display Sandbox information## Inputs : Command line args# -v - Be more verbose## Returns : Will exit#sub info{## Allow user to specify verboseness as an argument#foreach ( @_ ){$opt_verbose++ if ( m/^-v/ )}## Determine Sandbox information# Populate global variables#calc_sandbox_info();## Display information#Message ("Base: $GBE_SANDBOX");Message ("Archive: $GBE_DPKG_SBOX");Message ("Build Order");foreach my $fe ( @build_order ){Message( " Level:" . $fe->{level} . " Name: " . $fe->{mname} );Message( DisplayPath (" Path: $fe->{dir}" )) if $opt_verbose;if ( $opt_verbose ){foreach my $idep ( sort keys %{$fe->{ideps}} ){my ($ppn,$pps) = split( $; , $idep);Message (" I:$ppn.$pps");}foreach my $edep ( sort keys %{$fe->{edeps}} ){my ($ppn,$pps) = split( $; , $edep);my $pv = $fe->{edeps}{$edep};Message (" E:$ppn $pv.$pps");}}}Message("External Dependencies");foreach my $de ( sort keys %extern_deps ){my ($pn,$ps) = split( $; , $de);my @vlist = keys %{$extern_deps{$de}};my $flag = $#vlist ? '*' : ' ';foreach my $pv ( @vlist ){Message (" $flag$pn $pv.$ps");if ( $opt_verbose ){foreach my $pkg ( @{$extern_deps{$de}{$pv}} ){my ($ppn,$pps) = split( $; , $pkg);Message (" U:$ppn.$pps");}}}}if ( $opt_verbose > 2 ){DebugDumpData( "extern_deps", \%extern_deps);DebugDumpData( "build_order", \@build_order);DebugDumpData( "packages", \%packages);}exit (0);}#-------------------------------------------------------------------------------# Function : calc_sandbox_info## Description : Examine the sandbox and determine all the important# information## Inputs : None## Returns : Will exit if not in a sandbox# Populates global variables# @build_order - build ordered array of build entries#sub calc_sandbox_info{## Start from the root of the sandbox#Error ("Command must be executed from within a Sandbox") unless ( $GBE_SANDBOX );chdir ($GBE_SANDBOX) || Error ("Cannot chdir to $GBE_SANDBOX");## Locate all packages within the sandbox# These will be top-level directories - one per package#my @dirlist;my @build_list;foreach my $pname ( glob("*") ){next if ( $pname =~ m~^\.~ );next if ( $pname =~ m~dpkg_archive$~ );next if ( $pname =~ m~^CVS$~ );next unless ( -d $pname );Verbose ("Package discovered: $pname");if ( -f "$pname/stop" ){Warning("Package contains stop file: $pname");next;}push @dirlist, $pname;## Locate the build files in each package# Scan the build files and extract dependancy information#my $bscanner = BuildFileScanner( $pname, 'build.pl', '--LocateAll', '--ScanDependencies' );$bscanner->scan();my @blist = $bscanner->getInfo();Warning ("Package does not have build files: $pname") unless ( @blist );Warning ("Package has multiple build files: $pname") if ( $#blist > 0 );push @build_list, @blist;}## Process each build file and extract# Name of the Package# Dependency list# Build up a hash of dependence information#my %depends;my %multi;foreach my $be ( @build_list ){Verbose( DisplayPath ("Build file: " . $be->{dir} . " Name: " . $be->{file} ));# DebugDumpData ("be", $be );## Catch multiple builds for the same package# Report later - when we have all#next unless ( $be->{mname} );push @{$multi{$be->{mname}}},$be->{dir};## Add into dependency struct#$depends{$be->{package}}{depends} = $be->{depends};$depends{$be->{package}}{entry} = $be;}foreach my $mname ( sort keys %multi ){ReportError ("Mutiple builders for : $mname", @{$multi{$mname}} )if ( scalar @{$multi{$mname}} > 1 );}ErrorDoExit();#DebugDumpData ("depends", \%depends );## Determine the build order#@build_order = ();my $more = 1;my $level = 0;## Remove any dependencies to 'external' packages# These will not be met internally and can be regarded as constant#foreach my $key ( keys %depends ){foreach my $build ( keys( %{$depends{$key}{depends}} )){unless (exists $depends{$build}){push @{$extern_deps{$build}{$depends{$key}{depends}{$build}}}, $key;$depends{$key}{entry}{edeps}{$build} = $depends{$key}{depends}{$build};delete ($depends{$key}{depends}{$build}) ;Verbose2( "Not in set: $build");}else{$depends{$key}{entry}{ideps}{$build} = 1;}}}while ( $more ){$more = 0;$level++;my @build;## Locate packages with no dependencies#foreach my $key ( keys %depends ){next if ( keys( %{$depends{$key}{depends}} ) );push @build, $key;}foreach my $build ( @build ){$more = 1;my $fe = $depends{$build}{entry};$fe->{level} = $level;$packages{$build} = $fe;push @build_order, $fe;delete $depends{$build};delete $fe->{depends}; # remove now its not needed}foreach my $key ( keys %depends ){foreach my $build ( @build ){delete $depends{$key}{depends}{$build};}}}## Just to be sure to be sure#if ( keys %depends ){#DebugDumpData ("depends", \%depends );Error( "Internal algorithm error: Bad dependancy walk","Possible circular dependency");}# DebugDumpData ("Order", \@build_order);}#-------------------------------------------------------------------------------# Function : cmd## Description : Execute a command in all the sandboxes# Locate the base of the sandbox# Locate all packages in the sandbox# Locate all build files in each sandbox# Determine build order# Issue commands for each sandbox in order## Inputs : Arguments passed to jats build## Returns : Will exit#sub cmd{my @cmds = @_;## Determine Sandbox information# Populate global variables#calc_sandbox_info();foreach my $fe ( @build_order ){my $dir = $fe->{dir};Message( "Level:" . $fe->{level} . " Name: " . $fe->{mname} ,DisplayPath (" Path: $fe->{dir}" ));my $result = JatsCmd( "-cd=$dir", @cmds);Error ("Cmd failure") if ( $result );}exit 0;}#-------------------------------------------------------------------------------# Function : clean## Description : Execute a command in all the sandboxes# Locate the base of the sandbox# Locate all packages in the sandbox# Locate all build files in each sandbox# Determine build order# Issue commands for each sandbox in order## Inputs : Arguments passed to jats build## Returns : Will exit#sub clean{my ($mode, @cmds ) = @_;## Determine Sandbox information# Populate global variables#calc_sandbox_info();my @cmd = $mode eq 'clobber' ? ('clobber') : ('make', 'clean' );## Clobber and clean need to be done in the reverse order#foreach my $fe ( reverse @build_order ){my $dir = $fe->{dir};Message( "Level:" . $fe->{level} . " Name: " . $fe->{mname} ,DisplayPath (" Path: $fe->{dir}" ));my $result = JatsCmd( "-cd=$dir", @cmd, @cmds);Error ("Cmd failure") if ( $result );}exit 0;}#-------------------------------------------------------------------------------# Documentation#=pod=head1 NAMEjats_sandbox - Build in a Development Sandbox=head1 SYNOPSISjats sandbox [options] [commands]Options:-help[=n] - Display help with specified detail-help -help - Detailed help message-man - Full documentationCommands:help - Same as -helpcreate - Create a sandbox in the current directorydelete - Delete the sandboxinfo [[-v]-v] - Sandbox information. -v: Be more verbosecmd - Do commands in all sandbox componentsall - Do 'build and make' in all sandbox componentsbuild - Do 'build' in all sandbox componentsmake - Do 'make' in all sandbox componentsclean - Do 'make clean' in all sandbox componentsclobber - Do 'build clobber' is all sandbox components=head1 OPTIONS=over 8=item B<-help[=n]>Print a brief help message and exits.There are three levels of help=over 8=item 1 Brief synopsis=item 2 Synopsis and option summary=item 3 Detailed help in man format=back 8=item B<-help -help>Print a detailed help message with an explanation for each option.=item B<-man>Prints the manual page and exits. This is the same a -help=3=back=head1 DESCRIPTIONThis program is the primary tool for the maintenance of Development Sandboxes.More documentation will follow.=head2 SANDBOX DIRECTORYThe sandbox directory is marked as being a sandbox through the use of the'sandbox create' command. This will create a suitable structure within thecurrent directory.Several JATS commands operate differently within a sandbox. The 'extract' and'release' commands will create static viwes within the sandbox and not thenormal directory. The 'sandbox' sub commands can only be used within a sandbox.The sandbox directory contains sub directories, each should contain a singlepackage. Sub directories may be created with the 'jats extract' command.Note: Symbolic links are not supported. They cannot work as he sandbox mechanismrequires that all the packages be conatined within a sub directory tree sothat the root of the sandbox can be located by a simple scan of the directorytree.If a package subdirectory contains a file called 'stop', then that packagewill not be considered as a part of the build-set.=head2 COMMAND SUMMARY=head3 createThe 'create' command will create a sandbox in the users current directory. It isnot possible to create a sandbox within a sandbox.A sandbox can be created in a directory that contains files and subdirectories.The create command simply places a known directory in the current directory.This dorectory is used by the sandboxing process. It may be manually deleted, ordeleted with the 'delete' command.=head3 deleteThe 'delete' command will delete the sandbox's marker directory. The command maybe executed anywhere within the sandbox.Once the sanbox has been deleted, the user must remove the components within thesandbox.=head3 infoThe 'info' command will display information about the build order and thedepenedencies of packages that it finds within the sandbox.The command will accept one option '-v' to increase the verbosity of theinformation being displayed.=over 8=item * No VerbosityThe basic command will display the build order and the externaldependencies=item Verbosity of 1This level of verbosoity will display the build order and detailed informationon the dependencies. The dependencies will be prefixed with:=over 8=item E Dependent Package is external to the sandbox=item I Dependent Package is internal to the sandbox=backThis level of verbosity display information on packages that are external to thesandbox. External dependencies may be prefixed with a '*'. This indicates thatmultiple versions of this package are being used by sandboxed components.The internal consumer of the external package is also shown. These areprefixed with a 'U'.=item Verbosity of 2Reserved forfuture use=item Verbosity over 2This should be considered a debug option. Undocument internal information willbe displayed.=back=cut