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 File::Path qw(rmtree);

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

#

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

#

#   Globals

#

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          :

#

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

#

#   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

    {

        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

{

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "verbose:+"     => \$opt_verbose,

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

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

    #

    #   Determine Sandbox information

    #   Populate global variables

    #

    calc_sandbox_info();

    #

    #   Display information

    #

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

    Message ("Base   : $GBE_SANDBOX");

    Message ("Archive: $GBE_DPKG_SBOX");

    Message ("Build Order");

    foreach my $fe ( @build_order )

    {

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

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

        if ( $opt_verbose )

        {

            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 ( $opt_verbose )

            {

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

                {

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

                    Message ("        U:$ppn");

                }

            }

        }

    }

    if ( $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

#

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

        {

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

#        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}}{entry} = $be;

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

    }

    foreach my $dname ( sort keys %multi )

    {

        ReportError ("Mutiple 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

    #

    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'}{$depends{$key}{depends}{$build}} = 1;

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

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

            }

            else

            {

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

            }

        }

    }

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

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

    #

    #   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.

    #

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

#   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, @cmds ) = @_;

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

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                ) || 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", @cmds);

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

    }

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

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                ) || 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, @cmds ) = @_;

    #

    #   Extract and options

    #

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

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                ) || 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, @cmds);

        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 (@opts) = @_;

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

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

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

    #

    #   Determine Sandbox information

    #   Populate global variables

    #

    Message("Cache External Dependencies");

    calc_sandbox_info();

    #

    #   Walk the list of external depenedencies 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 $opt_missing = 0;

    my $opt_recurse = 0;

    my $opt_test = 0;

    my $opt_extractfiles;

    my @opt_extract = qw(-extract);

    my @opt_fnames;

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

    GetOptions (

                "help:+"        => \$opt_help,

                "manual:3"      => \$opt_help,

                "missing"       => \$opt_missing,

                "test"          => \$opt_test,

                "recurse:100"   => \$opt_recurse,

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

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

    #

    #   Extract options for the jats extract utility

    #

    foreach ( @ARGV )

    {

        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 speicfy both a package name and version")

            if ( $#opt_fnames != 1 );

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

    }

    elsif ( $opt_missing )

    {

        #

        #   User has not provided a package name to extract

        #   Assume that the user will want 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 (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

    #

    #DebugDumpData("Data", \@PopBase );

    $PopLevel = 0;

    foreach my $entry ( @PopBase )

    {

        my ($pname, $pver ) = split( $; , $entry);

        my $pv_id = getPkgDetailsByName($pname, $pver);

        Error ("populate: $pname, $pver not found in Release Manager" )

            unless ( $pv_id );

        getPkgDetailsByPV_ID($pv_id);

    }

    #

    #   If recursing then process packages that have yet to

    #   be processed. At the start there will be the initial user specified

    #   packages on the list. Place a marker at the end so that we can

    #   determine how far we are recursing down the dependency tree.

    #

    if ( $opt_recurse )

    {

        my $marker = join($; , '_NEXT_LEVEL_', 0, 0 );

        push @StrayPackages, $marker;

        $PopLevel++;

        while ( $#StrayPackages >= 0 )

        {

            my ($name, $ver, $pv_id) = split($;, shift @StrayPackages);

            #

            #   Marker.

            #   Increment the level of recursion

            #   Detect end conditions

            #

            if ( $name eq '_NEXT_LEVEL_' )

            {

                last unless ($#StrayPackages >= 0 );

                $PopLevel++;

                last if ( $PopLevel > $opt_recurse );

                push @StrayPackages, $marker;

                next;

            }

            next if ( exists $PopPackage{$name}{$ver}{done} );

            getPkgDetailsByPV_ID ( $pv_id );

            #print "Stray: $pv_id, $name, $ver\n";

        }

    }

    #DebugDumpData("Data", \%PopPackage );

    #

    #   Determine packages that need to be extracted

    #   Not ordered in any way. Could order by level if we wanted

    #

    foreach my $pname ( sort keys %PopPackage )

    {

        foreach my $pver ( sort keys %{$PopPackage{$pname}} )

        {

            #

            #   Create a nice view name for the extraction

            #   Will also be used to test for package existance

            #

            my $vname = "$pname $pver";

            $vname =~ s~ ~_~g;

            $vname =~ s~__~~g;

            if ( -d "$GBE_SANDBOX/$vname" )

            {

                Warning("Package already in sandbox: $pname, $pver");

                next;

            }

            #

            #   If scanning for missing packages, then examine archives

            #   for the packages existence. Don't do this on level-0 packages

            #   These have been user specified.

            #

            if ( $opt_missing && $PopPackage{$pname}{$pver}{level}  )

            {

                my $found = check_package_existance( $pname, $pver );

                if ( $found )

                {

                    Verbose ("Package found in archive - skipped: $pname, $pver");

                    next;

                }

            }

            #

            #   Generate commands to extract the package

            #

            my $vcstag = $PopPackage{$pname}{$pver}{vcstag};

            my @cmd = qw(jats_vcsrelease);

            push @cmd, "-view=$vname", "-label=$vcstag", @opt_extract;

            if ( $opt_test )

            {

                Message "jats " . QuoteCommand (@cmd );

            }

            else

            {

                Message "Extracting: $pname $pver";

                my $rv = JatsCmd (@cmd);

                Error ("Package version not extracted")

                    if ( $rv );

            }

        }

    }

    #

    # This command does not return

    #

    exit (0);

}

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

# Function        : getPkgDetailsByName

#

# Description     : Determine the PVID for a given package name and version

#

# Inputs          : $pname          - Package name