Subversion Repositories DevTools

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

# 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

#                   info                - Show sandbox info

#

#                   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 Pod::Usage;                             # required for help support

use Getopt::Long qw(:config require_order); # Stop on non-option

my $VERSION = "1.0.0";                      # Update this

#

#   Options

#

my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_help = 0;                           # Help level

my $opt_exact = 0;                          # Exact (escrow) build

my $opt_toPackage;                          # Control recursion

my $opt_fromPackage;                        # Control recursion

my @opt_justPackage;                        # Control recursion

my @opt_ignorePackage;                      # Control recursion

#

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

my $GBE_MACHTYPE = $ENV{'GBE_MACHTYPE'};

my $GBE_DPKG_LOCAL  = $ENV{'GBE_DPKG_LOCAL'};

my $GBE_DPKG_CACHE  = $ENV{'GBE_DPKG_CACHE'};

my $GBE_DPKG        = $ENV{'GBE_DPKG'};

my $GBE_DPLY        = $ENV{'GBE_DPLY'};

my $GBE_DPKG_STORE  = $ENV{'GBE_DPKG_STORE'};

my $GBE_BUILDFILTER = $ENV{'GBE_BUILDFILTER'};

#

#   Globals

#

my @stopped = ();                         # Stopped entries

my @build_order = ();                     # Build Ordered list of entries

my %extern_deps;                          # Hash of external dependencies

my %packages;                             # Hash of packages

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

# Function        : Mainline Entry Point

#

# Description     :

#

# Inputs          :

#

#

#   Process help and manual options

#

my $result = getOptionsFromArray ( \@ARGV );

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

#

#   Reconfigure the options parser to allow subcommands to parse options

#

Getopt::Long::Configure('permute');

#

#   Determine Sandbox type. Exact or local

#

$opt_exact = (-f  $GBE_SANDBOX . '/sandbox_dpkg_archive/.exact' )

    if ( $GBE_SANDBOX );

#

#   Parse the user command and decide what to do

#

#   Remove user command from the command line. This will leave command options

#   in @ARGV so that they can be parsed by the subcommand.

#

my $cmd = shift @ARGV || "";

help(1)                                 if ( $cmd =~ m/^help$/ || $cmd eq "" );

buildcmd($cmd, @ARGV )                  if ( $cmd =~ m/(^all$)|(^build$)/  );

cache(@ARGV)                            if ( $cmd =~ m/^cache$/  );

clean($cmd, @ARGV)                      if ( $cmd =~ m/(^clobber$)|(^clean$)/  );

cmd('make', $cmd, @ARGV )               if ( $cmd =~ m/(^make$)/  );

cmd('cmd', @ARGV)                       if ( $cmd =~ m/^cmd$/ );

create_sandbox()                        if ( $cmd =~ m/^create$/ );

delete_sandbox()                        if ( $cmd =~ m/^delete$/ );

info(@ARGV)                             if ( $cmd =~ m/^info$/ );

populate(@ARGV)                         if ( $cmd =~ m/^populate$/  );

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

{

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "exact"         => \$opt_exact,

                ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Create Sandbox") if ($opt_help || $#ARGV >= 0 );

    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") ;

    TouchFile( 'sandbox_dpkg_archive/.exact', 'Sandbox marker file')

        if ($opt_exact);

    Message ('Sandbox created' . ($opt_exact ? ' - With exact version number processing' : ''));

    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

{

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Delete Sandbox") if ($opt_help || $#ARGV >= 0 );

    unless ( $GBE_SANDBOX )

    {

        Warning("No sandbox found to delete");

    }

    else

    {

        Error ("Sandbox directory not completely removed")

            if RmDirTree( "$GBE_SANDBOX/sandbox_dpkg_archive" );

        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

{

    my (@cmd_opts ) = @_;

    my $show = 0;

    Getopt::Long::Configure('pass_through');

    getOptionsFromArray ( \@cmd_opts,

                           'verbose:+'  => \$show,

                        ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Sandbox Information") if ($opt_help || $#cmd_opts >=0 );

    #

    #   Determine Sandbox information

    #   Populate global variables

    #

    calc_sandbox_info(1);

    #

    #   Display information

    #

    Message ("Type       : " . ($opt_exact ? 'Exact' : 'Development') );

    Message ("Base       : $GBE_SANDBOX");

    Message ("Archive    : $GBE_DPKG_SBOX");

    Message ("BuildFilter: $GBE_BUILDFILTER" . ( (-f $GBE_SANDBOX . '/buildfilter')  ? ' - Local to sandbox' : ''));

    Message ("Build Order");

    foreach my $pname ( @stopped )

    {

        Message( "    Level:" . "-"  . " Name: " . $pname . ' (Stopped)');

    }

    foreach my $fe ( @build_order )

    {

        Message( "    Level:" . $fe->{level} . " Name: " . $fe->{dname} . ($fe->{buildActive} ? '' : ' (Build Suppressed)'));

        Message( DisplayPath ("        Path: $fe->{dir}" )) if $show;

        if ( $show )

        {

            foreach my $idep ( sort values %{$fe->{'ideps'}} )

            {

                Message ("        I:$idep");

            }

            foreach my $edep ( sort keys %{$fe->{'edeps'}} )

            {

                my ($ppn,$ppv) = split( $; , $edep);

                Message ("        E:$ppn $ppv");

            }

        }

    }

    #

    #   External dependencies flags

    #       * - Package does not exist in dpkg_archive

    #       + - Multiple versions of this package are used

    Message("External Dependencies");

    foreach my $de ( sort keys %extern_deps )

    {

        my @vlist = keys %{$extern_deps{$de}};

        my $flag = $#vlist ? '+' : '';

        foreach my $pve ( @vlist )

        {

            my ($pn,$pv) = split( $; , $pve );

            my $exists = check_package_existance($pn,$pv  ) ? '' : '*';

            my $flags = sprintf ("%4.4s", $flag . $exists);

            Message ("${flags}${pn} ${pv}");

            if ( $show )

            {

                foreach my $pkg ( @{$extern_deps{$de}{$pve}} )

                {

                    my $ppn = join ('.', split( $; , $pkg));

                    Message ("        U:$ppn");

                }

            }

        }

    }

    if ( $show > 2 || $opt_verbose > 2 )

    {

        DebugDumpData( "extern_deps", \%extern_deps);

        DebugDumpData( "build_order", \@build_order);

        DebugDumpData( "packages", \%packages);

    }

    exit (0);

}

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

# Function        : check_package_existance

#

# Description     : Determine if a given package-version exists

#

# Inputs          : $name           - Package Name

#                   $ver            - Package Version

#

# Returns         : true            - Package exists

#

sub check_package_existance

{

    my ($name, $ver) = @_;

    #

    #   Look in each package archive directory

    #

    foreach my $dpkg ( $GBE_DPKG_SBOX,

                       $GBE_DPKG_LOCAL,

                       $GBE_DPKG_CACHE,

                       $GBE_DPKG,

                       $GBE_DPLY,

                       $GBE_DPKG_STORE )

    {

        next unless ( $dpkg );

        if ( -d "$dpkg/$name/$ver" )

        {

            return 1;

        }

    }

   return 0;

}

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

# Function        : calc_sandbox_info

#

# Description     : Examine the sandbox and determine all the important

#                   information

#

#                   Operation will be modified by

#                       $opt_toPackage

#                       $opt_fromPackage

#                       @opt_justPackage

#                       @opt_ignorePackage

#

# Inputs          : info                - True: Just for info

#                                               Keep supressed packages

#

# Returns         : Will exit if not in a sandbox

#                   Populates global variables

#                       @build_order - build ordered array of build entries

#

sub calc_sandbox_info

{

    my ($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" || -f "$pname/stop.$GBE_MACHTYPE" )

        {

            push @stopped, $pname;

            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',

                                                 $opt_exact ? '--ScanExactDependencies' : '--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} ));

        #

        #   Sandbox vs Exact processing

        #       Set a suitable display name

        #       Set a suitable tag

        #

        $be->{dname} = $opt_exact ? $be->{full}    : $be->{mname};

        $be->{tag}   = $opt_exact ? $be->{fullTag} : $be->{package};

        $be->{fname} = join ('_', $be->{name}, $be->{version});

#        DebugDumpData ("be", $be );

        #

        #   Catch multiple builds for the same package

        #   Report later - when we have all

        #

        next unless ( $be->{dname} );

        push @{$multi{$be->{dname}}},$be->{dir};

        #

        #   Add into dependency struct

        #

        $depends{$be->{tag}} = $be;

    }

    foreach my $dname ( sort keys %multi )

    {

        ReportError ("Multiple builders for : $dname", @{$multi{$dname}} )

            if ( scalar @{$multi{$dname}} > 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

    #

    #   Split 'depends' into internal (ideps) and external (edeps)

    #       edeps : External Dependencies

    #               Key:        Name;Version

    #               Value:      'tag' - index into packages

    #       ideps : Internal Dependencies

    #               Key:        'tag'   - Index into packages

    #               Value:      'dname' - Display Name

    #

    foreach my $key ( keys %depends )

    {

        foreach my $build ( keys( %{$depends{$key}{depends}} ))

        {

            unless (exists $depends{$build})

            {

                $depends{$key}{'edeps'}{$depends{$key}{depends}{$build}} = $build;

                delete ($depends{$key}{depends}{$build}) ;

                Verbose2( "Not in set: $build");

            }

            else

            {

                $depends{$key}{'ideps'}{$build} = $depends{$build}{dname};

            }

        }

    }

#DebugDumpData ("depends", \%depends );

    #

    #   Determine package build order

    #       Scan the list of packages in the build set and determine

    #       those with no dependencies. These can be built.

    #       Remove those packages as dependents from all packages

    #       Repeat.

    #

    my %found    = map { $_ => 1 } @opt_ignorePackage;

    my %notFound = map { $_ => 1 } @opt_justPackage;

    my $scan_start = 0;

    my $scan_stop = 0;

    my $scan_active = ($opt_fromPackage) ? 0 : 1;

    $scan_active = 0 if ( !$opt_fromPackage && !$opt_fromPackage && !@opt_ignorePackage && @opt_justPackage );

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

            my $scan_add = $scan_active ? 1 : 0;

            if ( $opt_fromPackage && (($fe->{mname} eq $opt_fromPackage) || ($fe->{name} eq $opt_fromPackage) || ($fe->{fname} eq $opt_fromPackage)))

            {

                $scan_add = 1;

                $scan_active = 1;

                $scan_start = 1;

            }

            if ( $opt_toPackage && (($fe->{mname} eq $opt_toPackage) || ($fe->{name} eq $opt_toPackage) || ($fe->{fname} eq $opt_toPackage)))

            {

                $scan_add = 0;

                $scan_active = 0;

                $scan_stop = 1;

            }

            if ( @opt_justPackage )

            {

                foreach my $pname ( @opt_justPackage )

                {

                    if ( (($fe->{mname} eq $pname) || ($fe->{name} eq $pname) || ($fe->{fname} eq $pname)))

                    {

                        $scan_add = 1;

                        delete $notFound{$pname};

                    }

                }

            }

            if ( @opt_ignorePackage )

            {

                foreach my $pname ( @opt_ignorePackage )

                {

                    if ( (($fe->{mname} eq $pname) || ($fe->{name} eq $pname) || ($fe->{fname} eq $pname)))

                    {

                        $scan_add = 0;

                        delete $found{$pname};

                    }

                }

            }

            $fe->{level} = $level;

            $fe->{buildActive} = $scan_add;

            $packages{$build} = $fe;

            push (@build_order, $fe) if ( $scan_add || $info );

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

            }

        }

    }

    #

    #   Detect bad user specifications

    #

    ReportError ("Specified FromPackage not found: $opt_fromPackage") if ( $opt_fromPackage && !$scan_start );

    ReportError ("Specified ToPackage not found: $opt_toPackage") if ( $opt_toPackage && !$scan_stop );

    ReportError ("Specified ExactPackages not found: ", keys( %notFound) ) if ( %notFound );

    ReportError ("Specified IgnorePackages not found: ", keys( %found) ) if ( %found );

    ErrorDoExit();

    #

    #   Calculate the external dependencies

    #       Only process packages that are a part of the build

    #

    #   extern_deps structure

    #       Hash key: 'tag'   - Index into packages

    #          Value: Hash of:

    #                 Key  : Name;Version

    #                 Value: Array of: 'tags' (Index into packages)

    #                                   of packages that use the external

    #                                   component.

    {

        Verbose ("Calculate external dependencies");

        %extern_deps = ();

        foreach my $key ( keys %packages )

        {

                next unless ( $packages{$key}{buildActive} );

                next unless ( $packages{$key}{'edeps'} );

                foreach ( keys %{$packages{$key}{'edeps'}} )

                {

                    push @{$extern_deps{$packages{$key}{'edeps'}{$_}} {$_} }, $key;

                }

        }

    }

    #

    #   Just to be sure to be sure

    #

    if ( keys %depends )

    {

        #DebugDumpData ("depends", \%depends );

        Error( "Internal algorithm error: Bad dependancy walk",

               "Possible circular dependency");

    }

#   DebugDumpData("Packages", \%packages);

#   DebugDumpData ("Order", \@build_order);

#   DebugDumpData("External Depends", \%extern_deps );

}

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

# 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 ($hcmd, @cmd_opts ) = @_;

    my $opt_keepgoing;

    Getopt::Long::Configure('pass_through');

    getOptionsFromArray ( \@cmd_opts,

                           'keepgoing!'  => \$opt_keepgoing,

                        ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, $hcmd) if ($opt_help  );

    #

    #   Determine Sandbox information

    #   Populate global variables

    #

    calc_sandbox_info();

    foreach my $fe ( @build_order )

    {

        my $dir = $fe->{dir};

        Message( "Level:" . $fe->{level} . " Name: " . $fe->{dname} ,

                  DisplayPath ("        Path: $fe->{dir}" ));

        my $result = JatsCmd( "-cd=$dir", @cmd_opts);

        if ( $result ) {

            if ( $opt_keepgoing ) {

                Warning ("Cmd failure");

            } else {

                Error   ("Cmd failure");

            }

        }

    }

    exit 0;

}

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

# Function        : buildcmd

#

# Description     : Build the entire sandbox

#                   The all and the build are similar.

#                   Its not really useful to do a build without a make

#                   so we don't try

#

# Inputs          : Arguments passed to jats make

#

#

# Returns         : Will exit

#

sub buildcmd

{

    my ($cmd, @cmd_opts) = @_;

    my @build_opts;

    my @make_opts;

    #

    #   Extract and options

    #

    Getopt::Long::Configure('pass_through');

    getOptionsFromArray ( \@cmd_opts ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Command $cmd") if ($opt_help );

    #

    #   Insert default options

    #

    push @build_opts, '-noforce' if ( $cmd eq 'all' );

    push @build_opts, '-force' if ( $cmd ne 'all' );

    #

    #   Attempt to split the options into build and make options

    #   Only handle the often used options to build.

    #

    foreach  ( @cmd_opts )

    {

        if ( m/^-cache/ || m/^-package/ || m/^-forcebuildpkg/ || m/-expert/) {

            push @build_opts, $_;

        } else {

            push @make_opts, $_;

        }

    }

    push @make_opts, 'all'  unless ( @make_opts  );

    #

    #   Determine Sandbox information

    #   Populate global variables

    #

    calc_sandbox_info();

    foreach my $fe ( @build_order )

    {

        my $dir = $fe->{dir};

        Message( "Level:" . $fe->{level} . " Name: " . $fe->{dname} ,

                  DisplayPath ("        Path: $fe->{dir}" ));

        JatsCmd( "-cd=$dir", 'build', @build_opts) && Error ("Build Cmd failure") if ( $result );

        JatsCmd( "-cd=$dir", 'make',  @make_opts)  && Error ("Make 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, @cmd_opts ) = @_;

    #

    #   Extract and options

    #

    Getopt::Long::Configure('pass_through');

    getOptionsFromArray ( \@cmd_opts ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Clean") if ($opt_help );

    #

    #   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->{dname} ,

                  DisplayPath ("        Path: $fe->{dir}" ));

        my $result = JatsCmd( "-cd=$dir", @cmd, @cmd_opts);

        Error ("Cmd failure") if ( $result );

    }

    exit 0;

}

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

# Function        : cache

#

# Description     : Cache external packages into the sandbox

#

# Inputs          : @opts                   - User options

#

# Returns         : Nothing

#

sub cache

{

    my (@cmd_opts) = @_;

    getOptionsFromArray ( \@cmd_opts ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Cache") if ($opt_help || $#cmd_opts >= 0 );

    #

    #   Determine Sandbox information

    #   Populate global variables

    #

    Message("Cache External Dependencies");

    calc_sandbox_info();

    #

    #   Walk the list of external dependencies and cache each one

    #

    foreach my $de ( sort keys %extern_deps )

    {

        my @vlist = keys %{$extern_deps{$de}};

        foreach my $pve ( @vlist )

        {

            my ($pn,$pv) = split( $; , $pve );

            Message ("Cache ${pn} ${pv}");

            JatsTool ('cache_dpkg', "${pn}/${pv}" );

        }

    }

    exit 0;

}

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

# Function        : populate

#

# Description     : Populate the sandbox with package versions

#

#

# Inputs          : commands            - Array of command line arguments

#                   Mode-0:

#

#                       pkg_name pkg_version        - Import files for named package

#                       options:

#                           -recurse                - Import dependent packages too

#                           -missing                - Import dependencies not in dpkg_archive

#                           -test                   - Show what would be done

#                           -extractfiles           - Extract file, no view

#

#

#

#

# Returns         : Does not return

#

use JatsRmApi;

use DBI;

#

#   Data Base Interface

#

my $RM_DB;

my $PopLevel = 0;

my %PopPackage;

my @StrayPackages;

my @PopBase;

sub populate

{

    my (@cmd_opts ) = @_;

    my $opt_missing = 0;

    my $opt_recurse = 0;

    my $opt_test = 0;

    my $opt_show = 0;

    my $opt_extractfiles;

    my @opt_extract = qw(-extract);

    my @opt_fnames;

    my @opt_exclude;

    my $opt_all;

    Getopt::Long::Configure('pass_through');

    getOptionsFromArray ( \@cmd_opts,

                "all"               => \$opt_all,

                "missing"           => \$opt_missing,

                "test"              => \$opt_test,

                "show"              => \$opt_show,

                "recurse:100"       => \$opt_recurse,

                'excludePackage:s'  => sub{ opts_add2List( \@opt_exclude, @_ )},

                ) || Error ("Invalid command line" );

    SubCommandHelp( $opt_help, "Populate Sandbox") if ($opt_help );

    #

    #   Sanity tests

    #

    Error ("Populate: -missing and -all options are mutually exclusive")

        if ( $opt_missing && $opt_all );

    #

    #   Extract options for the jats extract utility

    #

    foreach ( @cmd_opts )

    {

        if ( m~^-~ ) {

            push ( @opt_extract, $_);

        } else {

            push ( @opt_fnames, $_);

        }

    }

    #

    #   Allow exactly zero or two 'bare' arguments

    #   Create an array of package-versions to be processed.

    #

    if ( $#opt_fnames >= 0 )

    {

        Error ("Populate: Must specify both a package name and version")

            if ( $#opt_fnames != 1 );

        push @PopBase, join( $;, @opt_fnames );

    }

    elsif ( $opt_missing || $opt_all )

    {

        #

        #   User has not provided a package name to extract

        #   Assume that the user will want all or missing dependencies

        #

        #   Determine packages that are not present

        #

        calc_sandbox_info();

        #

        # Scan for missing dependencies

        #

        foreach my $de ( sort keys %extern_deps )

        {

            my @vlist = keys %{$extern_deps{$de}};

            foreach my $pve ( @vlist )

            {

                my ($pn,$pv) = split( $; , $pve );

                unless ($opt_missing && check_package_existance( $pn, $pv ))

                {

                    push @PopBase, join( $;, $pn , $pv );

                }

            }

        }

    }

    else

    {

        Error ("No command or option specified. See help for command usage");

    }

    #

    #   Process the list of package-versions

    #   These are top level packages. Get details from Release Manager