Subversion Repositories DevTools

########################################################################
# Copyright (C) 2009 ERG Limited, All rights reserved
#
# Module name   : svn_pump2.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Pump packages into subversion
#                 Process all packages in a Release or SBOM
#                 Create a file to process, or process directly
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsEnv;
use JatsError;
use JatsSystem;
use JatsRmApi;
use DBI;
use Getopt::Long;
use Pod::Usage;                             # required for help support
use Storable qw (dclone);

#
#   Config Options
#
my $VERSION = "1.0.0";              # Update this
my $opt_help = 0;
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
my $opt_sbom_id;
my $opt_rtag_id;
my $opt_test = 0;
my $opt_patch = 1;
my $opt_extract;
my $opt_rootpkg;
my $opt_rootpkg_version;
my $opt_direct;

#
#   Data Base Interface
#
my $RM_DB;
my $DM_DB;

#
#   Global variables
#
my %os_id_list;                 # os_id in the SBOM
my %os_env_list;                # OS Environments
my %pv_id;                      # Packages in the SBOM
my %Package;                    # Per Package information
my %Release;                    # Release information
my %Release_pvid;               # Release info
my @StrayPackages;              # Non-top level packages
my @create_list;                # List of files created
my $fpref = "sbom";             # Sbom Prefix
our $GBE_RM_URL;
our $GBE_DM_URL;
my $sbom_name;
my $sbom_branch;
my $sbom_project;
my $sbom_version;
my $rtag_release;
my $rtag_project;

#
#   Packages to be ignored
#
my %ignore;
my %patch;


#-------------------------------------------------------------------------------
# Function        : Main
#
# Description     : Main entry point
#                   Parse user options
#
# Inputs          :
#
# Returns         :
#

my $result = GetOptions (
                "help:+"        => \$opt_help,              # flag, multiple use allowed
                "manual:3"      => \$opt_help,              # flag, multiple use allowed
                "verbose:+"     => \$opt_verbose,           # flag
                "sbomid=s"      => \$opt_sbom_id,           # string
                "sbom_id=s"     => \$opt_sbom_id,           # string
                "rtagid=s"      => \$opt_rtag_id,           # string
                "rtag_id=s"     => \$opt_rtag_id,           # string
                "rootpackage=s" => \$opt_rootpkg,           # String
                "ignore=s",     => sub{my ($a,$i) = @_; $ignore{$i} = 0 },
                "test!"         => \$opt_test,              #[no]flag
                "patch!"        => \$opt_patch,             #[no]flag
                "extract=s"     => \$opt_extract,           # Name of file
                "direct"        => \$opt_direct,            #[no]flag
                );

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

ErrorConfig( 'name'    => 'PUMP',
             'verbose' => $opt_verbose );

#
#   Sanity test
#
unless ( $opt_rtag_id || $opt_sbom_id || $opt_extract || $#ARGV >= 1)
{
    Error ("Need sbomid and/or rtagid, or -extract",
           "Example: -sbomid=13543, for NZS Phase-1",
           "Example: -sbomid=13543 -rtagid=xxxx, for NZS Phase-1, comapred against given release",
           "Example: -rtagid=2362, for Sydney R1/R2",
           "Example: -rtagid=8843 -root=StockholmSBOM",
           "Example: PackageName PackageVersion, for extracting a single package",
    )
}

#
#   The extract option is special
#   It places the progam in a different mode
#
if ( $opt_extract )
{
    Error ("Cannot mix -extract with sbomid or rtagid" )
        if ( $opt_rtag_id || $opt_sbom_id || $#ARGV >= 0 );

    Error ("Cannot use -nopatch or -ignore with -extract")
        if ( ! $opt_patch || keys %ignore );

    extract_files();
    exit (0);
}

Warning ("No sbomid provided. Output based an a Release") unless ( $opt_sbom_id );
$fpref = "release" unless ( $opt_sbom_id );

#
#   Figure out package base
#
if ( $opt_sbom_id )
{
    #
    #   Determines the OS_ID's for the bom
    #
    getOSIDforBOMID($opt_sbom_id);
    getSBOMDetails($opt_sbom_id);

    #
    #   Locate packages associated with the base install for each os
    #
    foreach my $base_env_id ( sort keys %os_env_list )
    {
        getPackagesforBaseInstall( $base_env_id );
    }

    #
    #   Determine all the top level packages in the BOM
    #
    foreach my $os_id ( sort keys %os_id_list )
    {
        getPackages_by_osid( $os_id );
    }

    #
    #   For each Top Level Package determine the dependent packages
    #
    getPkgDetailsForPVIDs (keys %pv_id);
    LocateStrays(0);

    #
    #   Determine packages in a given Release
    #
    if ( $opt_rtag_id )
    {
        getPkgDetailsByRTAG_ID( $opt_rtag_id );
    }
}
elsif ( $opt_rtag_id )
{
    getPkgDetailsByRTAG_ID( $opt_rtag_id );
    if ( $opt_rootpkg )
    {
        #
        #   Base the report on a single package in a release
        #   Determine the package
        #
        Error ("Root Package not found: $opt_rootpkg") unless ( exists $Release{$opt_rootpkg} );
        my @root_vers = keys %{$Release{$opt_rootpkg}};
        Error ("Multiple versions of Root Package: $opt_rootpkg", @root_vers ) if ( $#root_vers > 0 );
        $opt_rootpkg_version = $root_vers[0];
        Message("Root Package: $opt_rootpkg, " . $opt_rootpkg_version);

        getPkgDetailsByPV_ID( $Release{$opt_rootpkg}{$opt_rootpkg_version}{pv_id} );
    }
    else
    {
        getPkgDetailsForPVIDs (keys %Release_pvid);
    }
    LocateStrays(1);
}
elsif ( $#ARGV >= 1 )
{
    #
    #   Locate package and dependents
    #   Convert package name into a PVID
    #
    my $pv_id = getPkgDetailsByName( @ARGV );
    Error ("Cannot locate package by name and version: @ARGV")
        unless ( $pv_id );

    #
    #   Set package as the root package
    $opt_rootpkg = $ARGV[0];
    $opt_rootpkg_version = $ARGV[1];
    getPkgDetailsByPV_ID( $pv_id  );
    LocateStrays(2);
}
else
{
    Error ("Don't know what to do with common line arguments provided");
}


#
#   Remove packages to be ignored
#
foreach my $pkg ( keys %ignore )
{
    delete $Package{$pkg};
}

##
##   Display a list of all packages found so far
##
#foreach my $name ( sort keys %Package )
#{
#    foreach my $ver ( sort keys %{$Package{$name}} )
#    {
#
#        my $label = $Package{$name}{$ver}{label} || '';
#        my $path = $Package{$name}{$ver}{path} || '';
#
#        printf ("%30s %15s %45s %s\n", $name, $ver, $label, $path );
#    }
#}

#
#   Generate output files
#       1) Jats extract commands
#       2) Error list
my $file;
$file = "${fpref}_extract.txt";
push @create_list, $file;
open (JE, ">$file" ) || Error ("Cannot create $file");

$file = "${fpref}_status.txt";
push @create_list, $file;

open (ST, ">$file" ) || Error("Cannot create $file");
print ST "Cannot build:\n";

foreach my $name ( sort keys %Package )
{
    foreach my $ver ( sort keys %{$Package{$name}} )
    {

        my $label = $Package{$name}{$ver}{label} || '';
        my $path = $Package{$name}{$ver}{path} || '';
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
        my @reason1;            # can't extract files
        my @reason2;            # Others

        push @reason1, 'No Label' unless ( $label );
        push @reason1, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i || $label  =~ s~^na$~~i );

        push @reason1, 'No Source Path' unless ( $path );
        push @reason1, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
        push @reason1, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
        push @reason1, 'Bad Path, http' if ( $path =~ m~^http:~i );
        push @reason1, 'Bad Path, Drive' if ( $path =~ m~^[A-Za-z]\:~ );
        push @reason1, 'Bad Path, UNC' if ( $path =~ m~^//~ );
        push @reason1, 'Bad Path, Relative' unless ( $path =~ m~^/~ );


        push @reason2, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );

        unless ( @reason1 )
        {
            my $vname = "$name $ver";
            $vname =~ s~ ~_~g;
            $vname =~ s~__~~g;

            print JE "jats etool svn_pump -package=$name -version=$ver\n";
        }

        if ( @reason1 || @reason2 )
        {
            $Package{$name}{$ver}{bad_extract} = [@reason1, @reason2];
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
        }
    }
}

close (JE);
close (ST);

#
#   Display names of files created
#
foreach my $file ( sort @create_list )
{
    Message ("Created: $file");
}

#
#   Do it all at once
#
if ( $opt_direct )
{
    foreach my $name ( sort keys %Package )
    {
        foreach my $ver ( sort keys %{$Package{$name}} )
        {

            my $label = $Package{$name}{$ver}{label} || '';
            my $path = $Package{$name}{$ver}{path} || '';
            my $rv = JatsTool ('svn_pump', "-package=$name", "-version=$ver", "-label=$label", "-path=$path" );
        }
    }
}

exit;


#-------------------------------------------------------------------------------
# Function        : getSBOMDetails
#
# Description     : Get some details about the SBOM
#                   Used fro descriptive text
#
# Inputs          : $bom_id             - BOM to process
#
# Returns         : 
#
sub getSBOMDetails
{
    my ($bom_id) = @_;
    my $foundDetails = 0;
    my (@row);
Verbose ("getSBOMDetails");
    connectDM(\$DM_DB) unless ($DM_DB);

    my $m_sqlstr = "SELECT distinct dp.PROJ_NAME ,bn.BOM_NAME, br.BRANCH_NAME, bm.BOM_VERSION, bm.BOM_LIFECYCLE" .
                   " FROM DEPLOYMENT_MANAGER.BOMS bm, DEPLOYMENT_MANAGER.BOM_NAMES bn, DEPLOYMENT_MANAGER.BRANCHES br, DEPLOYMENT_MANAGER.DM_PROJECTS dp" .
                   " WHERE bm.BOM_ID = $bom_id AND bm.BOM_NAME_ID = bn.BOM_NAME_ID AND bm.BRANCH_ID = br.BRANCH_ID AND br.PROJ_ID = dp.PROJ_ID";

    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $sbom_project   = $row[0];
                    $sbom_name      = $row[1];
                    $sbom_branch    = $row[2];
                    $sbom_version   = $row[3] . '.' . $row[4];
                    $foundDetails = 1;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("getSBOMDetails:Execute failure", $m_sqlstr );
        }
    }
    else
    {
        Error("getSBOMDetails:Prepare failure" );
    }

    Error("getSBOMDetails:No OS Information Found" ) unless $foundDetails;
    
}

#-------------------------------------------------------------------------------
# Function        : getReleaseDetails
#
# Description     : Get some details about the Release
#                   Used fro descriptive text
#
# Inputs          : $rtag_id             - RTAG_ID to process
#
# Returns         : 
#
sub getReleaseDetails
{
    my ($rtag_id) = @_;
    my $foundDetails = 0;
    my (@row);
Verbose ("getReleaseDetails");
    connectDM(\$DM_DB) unless ($DM_DB);

    my $m_sqlstr = "SELECT distinct rt.RTAG_NAME, pr.PROJ_NAME" .
                   " FROM RELEASE_MANAGER.RELEASE_TAGS rt, RELEASE_MANAGER.PROJECTS pr" .
                   " WHERE rt.RTAG_ID = $rtag_id AND rt.PROJ_ID = pr.PROJ_ID";

    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $rtag_release = $row[0];
                    $rtag_project = $row[1];
                    $foundDetails = 1;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("getReleaseDetails:Execute failure", $m_sqlstr );
        }
    }
    else
    {
        Error("getReleaseDetails:Prepare failure" );
    }

    Error("getReleaseDetails:No OS Information Found" ) unless $foundDetails;
    
}



#-------------------------------------------------------------------------------
# Function        : getOSIDforBOMID
#
# Description     : Get all the os_id's associated with a BOMID
#
# Inputs          : $bom_id             - BOM to process
#
# Returns         :
#

sub getOSIDforBOMID
{
    my ($bom_id) = @_;
    my $foundDetails = 0;
    my (@row);
Verbose ("getOSIDforBOMID");
    connectDM(\$DM_DB) unless ($DM_DB);

    my $m_sqlstr = "SELECT distinct os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .
                   " FROM DEPLOYMENT_MANAGER.OPERATING_SYSTEMS os, DEPLOYMENT_MANAGER.BOM_CONTENTS bc, DEPLOYMENT_MANAGER.NETWORK_NODES nn, DEPLOYMENT_MANAGER.OS_BASE_ENV obe" .
                   " WHERE bc.BOM_ID = $bom_id AND bc.NODE_ID = os.NODE_ID AND nn.NODE_ID = os.NODE_ID AND obe.OS_ID = os.OS_ID ";

    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    Verbose ("OS_ID: ".join (',',@row) );
                    $os_id_list{$row[0]}{os_name} = $row[1];
                    $os_id_list{$row[0]}{node_name} = $row[2];

                    $os_env_list{$row[3]}{needed} = 1;
                    $os_env_list{$row[3]}{os_id}{$row[0]} = 1;

                    $foundDetails = 1;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("getOSIDforBOMID:Execute failure" );
        }
    }
    else
    {
        Error("getOSIDforBOMID:Prepare failure" );
    }

    Error("getOSIDforBOMID:No OS Information Found" ) unless $foundDetails;
    
}

#-------------------------------------------------------------------------------
# Function        : getPackagesforBaseInstall
#
# Description     : Get all the packages for a given base install
#
# Inputs          :
#
# Returns         :
#

sub getPackagesforBaseInstall
{
    my ($base_env_id) =@_;
    my $foundDetails = 0;
    my (@row);

    connectDM(\$DM_DB) unless ($DM_DB);

    # First get details from pv_id
    Verbose("getPackagesforBaseInstall");
    my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .
                " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd, DEPLOYMENT_MANAGER.BASE_ENV_CONTENTS bec".
                " WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";

    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );

                    my $pv_id =     $row[0];
                    my $name =      $row[1]  || 'BadName';
                    my $ver =       $row[2]  || 'BadVer';

                    $pv_id{$pv_id}{pkg_name} =$name;
                    $pv_id{$pv_id}{pkg_ver} = $ver;
                    foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )
                    {
                        $pv_id{$pv_id}{os_id}{$os_id} = 2;
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            Error ("getPackagesforBaseInstall: Execute error");
        }
    }
    else
    {
        Error("getPackagesforBaseInstall:Prepare failure" );
    }

}


#-------------------------------------------------------------------------------
# Function        : getPackages_by_osid
#
# Description     : Get all the packages used by a given os_id
#
# Inputs          :
#
# Returns         :
#

my $count = 0;
sub getPackages_by_osid
{
    my ($os_id) =@_;
    my $foundDetails = 0;
    my (@row);

    connectDM(\$DM_DB) unless ($DM_DB);

    # First get details from pv_id
    Verbose("getPackages_by_osid");
    my $m_sqlstr = "SELECT osc.*, pkg.pkg_name, pv.pkg_version, pd.IS_REJECTED, pv.IS_PATCH,pv.IS_OBSOLETE, pkg.pkg_id, pv.pv_id" .
                " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd,".
                    "(" .
                        " SELECT osc.seq_num, osc.prod_id".
                        " FROM DEPLOYMENT_MANAGER.os_contents osc".
                        " WHERE osc.os_id = $os_id" .
                    " ) osc" .
                " WHERE pd.PROD_ID (+)= pv.PV_ID" .
                "   AND pv.pkg_id = pkg.pkg_id" .
                "   AND osc.PROD_ID = pv.pv_id" .
                " ORDER BY osc.SEQ_NUM desc" ;

    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
next if ( $opt_test && ++$count > 2 );
                    Verbose ("SBOM Package:".join (',',@row) );
                    my $pv_id =     $row[8];
                    my $name =      $row[2]  || 'BadName';
                    my $ver =       $row[3]  || 'BadVer';

                    $pv_id{$pv_id}{pkg_name} =$name;
                    $pv_id{$pv_id}{pkg_ver} = $ver;
                    $pv_id{$pv_id}{os_id}{$os_id} = 1;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("getPackages_by_osid:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : getPkgDetailsByPV_ID
#
# Description     : Populate the Packages structure given a PV_ID
#                   Called for each package in the SBOM
#
# Inputs          : PV_ID           - Package Unique Identifier
#
# Returns         : Populates Package
#
sub getPkgDetailsByPV_ID
{
    my ($PV_ID) = @_;
    my $foundDetails = 0;
    my (@row);

    connectRM(\$RM_DB) unless ($RM_DB);

    # First get details from pv_id

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.PKG_LABEL, pv.SRC_PATH, pv.IS_DEPLOYABLE, pbi.BSA_ID, pbi.BM_ID, PV_DESCRIPTION" .
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_BUILD_INFO pbi" .
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";

    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $pv_id       = $row[0];
                    my $name        = $row[1];
                    my $ver         = $row[2];
                    my $label       = $row[3] || '';
                    my $path        = $row[4] || '';
                    my $deployable  = $row[5];
                    my $build_info  = $row[6] || '';
                    my $build_mach  = $row[7] || '';
                    my $description = $row[8] || '';

                    #
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
                    #


                    #
                    #   Does it look like a patch
                    #   We may want to ignore it.
                    #
                    my $patch = "";
                    unless ( $opt_patch )
                    {
                        if ( $ver =~ m~\.p\d+.\w+$~ )
                        {
                            $patch = "Patch";
                            $patch{$name} = 0
                                unless (  exists $patch{$name} );
                            $patch{$name}++;
                        }
                    }
                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch");
                    next if ( $patch );


                    if ( exists $ignore{$name} )
                    {
                        Verbose2( "    Ignoring: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch\n");
                        $ignore{$name}++;
                        last;
                    }

                    $path =~ tr~\\/~/~;

                    $Package{$name}{$ver}{pvid} = $PV_ID;
                    $Package{$name}{$ver}{done} = 1;
                    $Package{$name}{$ver}{base} = 1;
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
                    $Package{$name}{$ver}{label} = $label;
                    $Package{$name}{$ver}{path} = $path;
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;
                    $Package{$name}{$ver}{description} = $description;

                    GetDepends( $pv_id, $name, $ver );

                }
            }
            else
            {
                Warning ("No Package details for: PVID: $PV_ID");
            }
            $sth->finish();
        }
        else
        {
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : getPkgDetailsByName
#
# Description     : Determine the PVID for a given package name and version
#
# Inputs          : $pname          - Package name
#                   $pver           - Package Version
#
# Returns         : 
#

sub getPkgDetailsByName
{
    my ($pname, $pver) = @_;
    my $pv_id;
    my (@row);

    connectRM(\$RM_DB) unless ($RM_DB);

    # First get details for a given package version

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $pv_id = $row[0];
                    my $name = $row[1];
                    my $ver = $row[2];
                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id");
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("Prepare failure" );
    }
    return $pv_id;
}

#-------------------------------------------------------------------------------
# Function        : getPkgDetailsForPVIDs
#
# Description     : Get all package details by PVID, from a list of PVIDs
#
# Inputs          : List of PVID's to process
#
# Returns         : Nothing
#
sub getPkgDetailsForPVIDs
{
    
    my $count = 0;
    foreach my $pv_id ( @_ )
    {
        next if ( $opt_test && ++$count > 2 );
        getPkgDetailsByPV_ID( $pv_id);
    }
}

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     : Extract the dependancies for a given package version
#
# Inputs          : $pvid
#
# Returns         :
#
sub GetDepends
{
    my ($pv_id, $pname, $pver ) = @_;

    connectRM(\$RM_DB) unless ($RM_DB);

    #
    #   Now extract the package dependacies
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
                   " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                my %depends;
                while ( my @row = $sth->fetchrow_array )
                {
#print "$pname $pver ===== @row\n";
                    my $name = $row[0];
                    my $ver = $row[1];

                    Verbose2( "       Depends: $name, $ver");

                    $depends{$name,$ver} = 1;
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;

                    unless ( exists $Package{$name}{$ver}{done} )
                    {
                        my @DATA = ($name, $ver, $row[2]);
                        push @StrayPackages, \@DATA;
                    }
                }
                $Package{$pname}{$pver}{depends} = \%depends;
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : getPkgDetailsByRTAG_ID
#
# Description     : Extract all the packages for a given rtag_id
#
# Inputs          : RTAG_ID
#
# Returns         : 
#

sub getPkgDetailsByRTAG_ID
{
    my ($RTAG_ID) = @_;
    my $foundDetails = 0;
    my (@row);

    Verbose("getPkgDetailsByRTAG_ID");
    connectRM(\$RM_DB) unless ($RM_DB);
    # First get details from pv_id
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION".
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
                   " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $pv_id   = $row[0];
                    my $name    = $row[1];
                    my $ver     = $row[2];
                    Verbose ("getPkgDetailsByRTAG_ID: $RTAG_ID, $name, $ver, $pv_id");

                    $Release{$name}{$ver}{pv_id} = $pv_id;
                    $Release_pvid{$pv_id} = 1;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("getPkgDetailsByRTAG_ID:Prepare failure" );
    }
}


#-------------------------------------------------------------------------------
# Function        : LocateStrays
#
# Description     : Locate stray packages
#                   These are packages that have not been defined by the
#                   top level SBOM. These are not really stray
#
# Inputs          : $mode           2: No stray tagging
#                                   0: Mark all as stray
#                                   1: Don't mark packages as stray
#                                      if they are in releases hash
# Returns         : Nothing
#
sub LocateStrays
{
    my ($mode) = @_;
    while ( $#StrayPackages >= 0 )
    {
        my $DATA = pop @StrayPackages;
        my $name = $DATA->[0];
        my $ver = $DATA->[1];
        my $pv_id = $DATA->[2];

        next if ( exists $Package{$name}{$ver}{done} );
        getPkgDetailsByPV_ID ( $pv_id );
        
        next if ( $mode > 1 );
        if ( $mode )
        {
            next if ( exists $Release{$name}{$ver} );
        }
        $Package{$name}{$ver}{stray} = 1;
#print "Stray: $pv_id, $name, $ver\n";
    }
}

#-------------------------------------------------------------------------------
# Function        : extract_files
#
# Description     : Alternate mode of operation
#                   Extract files from the generated list. This is intended to
#                   be run as a seperate phase taking the 'extract' file
#
# Inputs          :
#
# Returns         : 
#
sub extract_files
{
    my @extract_order;
    my %extract;
    ErrorConfig( 'name'    => 'ESCROW-EXTRACT' );

    #
    #   Open the file and read in data in one hit
    #   This will detect file errors early
    #   The lines may have arguments that are quoted.
    #   Supported forms are:
    #           "-tag=data"         - data may contain spaces
    #           -tag=data           - data must not contain spaces
    #
    #
    Error ("Cannot find specified file: $opt_extract")
        unless ( -f $opt_extract );

    open (FH, "<$opt_extract" ) || Error ("Cannot open file");
    while ( <FH> )
    {
        s~[\r\n]+$~~;
        Verbose2 ($_);
        next unless ( $_ );

        my ($name, $version);
        if ( m{(\s"-name=([^"]+)")|(\s-name=(\S+))} )
        {
            $name = $2 || $4;
        }

        if ( m{(\s"-version=([^"]+)")|(\s-version=(\S+))} )
        {
            $version = $2 || $4;
        }

        Error "Bad file format in line: $_" unless ( $name && $version );
        my $view = "${name} ${version}";
        Error "Duplicate view name: $view" if ( exists $extract{$view} );
        push @extract_order, $view;
        $extract{$view}{name} = $name;
        $extract{$view}{version} = $version;
    }
    close FH;

    #
    #   Log the file processing
    #
    my $lfile = "${opt_extract}.log";
    Message ("Creating logfile: ${opt_extract}.log");
    open (FH, ">$lfile" ) || Error ("Cannot open log file: $lfile");

    #
    #   Process each entry
    #
    foreach my $view ( @extract_order )
    {
        my $name = $extract{$view}{name};
        my $version = $extract{$view}{version};
        if ( $opt_test )
        {
            Verbose ("$name :: $version");
            print FH "$name :: $version : TEST\n";
        }
        else
        {
            my $rv = JatsTool ('svn_pump', $name, $version);
            print FH "$name, $version : SUCCESS\n" unless $rv;
            print FH "$name, $version : ERROR\n" if $rv;
        }
    }
    close FH;
    Message ("Results in logfile: ${opt_extract}.log");

}


#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=head1 NAME

escrow - Extract Escrow Build Information

=head1 SYNOPSIS

  jats escrow [options] [name version]

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -sbomid=xxx        - Specify the SBOM to process
    -rtagid=xxx        - Specify the Release to process (Optional)
    -rootpackage=xxx   - Specifies a root package. In conjunction with -rtagid.
    -ignore=name       - Ignore packages with the specified name
    -extract=fname     - Extract files from a previous run
    -verbose           - Enable verbose output
    -[no]patch         - Ignore/Include patches. Default:Include
    -[no]test          - Reduced package scanning for test

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-sbomid=xxx>

This option specifies the SBOM to process. The sbomid must be determined from
Deployment Manager.

=item B<-rtagid=xxx>

This option specified an RTAG_ID that must be determined from Release Manager.

This option may be used with or without the B<-sbomid=xxx> option.

With an SBOM_ID this option specifies an RTAG_ID to process in conjunction with the SBOM.
The program will determine packages that are in the Release, but not in the
SBOM.

Without an SBOM_ID, this option will limit the processing to the specified
release. Less information is generated. This form of the generation may be
combined with B<-rootpackage=xxx> to further limit the set of packages
processed.

=item B<-rootpackage=xxx>

This option can be used in conjunction with B<-rtagid=xxx> to limit the
extraction to named package and all of its dependent packages. The tool will
determine the required version of the package via the specified release.

=item B<-ignore=name>

All versions of the named package will be ignored. This parameter is options.
It may be used multiple times.

=item B<-extract=name>

This option will process the 'extract' file created in a previous run of this
program and extract source files for the package-versions found in the file.

The command will then create a log file recording packages that could ne be
extracted.

This option does not not interwork with many of the other command line options.
This option cannot be used in conjunction with the -rtagid, -sbomid, rootpackage
and -nopatch.

=item B<-[no]patch>

This option is used ignore patches. If -nopatch is selected, then packages
versions that look like a patch will be added to the ignore list.

=item B<-[no]test>

This option is used for testing. It will only process the first two OS entries
in the SBOM. This speeds up processing. It does not generate a complete list of
packages.

=item B<-verbose>

This option will display progress information as the program executes.

=back

=head1 DESCRIPTION

This program is a tool for extracting Escrow build information.
The program has two modes of operation:

=over 8

=item 1. Generation. Generate files describing packages within an SBOM/Release/
Package.

=item 2. Extraction  Supervise extraction of source trees.

=back

=head2 Generation Operations

This program has several modes of operation. The mode is determined from the
command line arguments provided.

=over 8

=item   Full Escrow

This mode requires an SBOM_ID. If an RTAG_ID is also provided, then additional
information will be generated.

=item   Release Escrow

If only an RTAG_ID is provided then the processing wil be limited to the
packages involved in creating the specified release.

If a 'rootpackage' name is provided, then the processing is limited to
packages that depend on the named package.

=item   Single Package

If a package name and a package version are specified on the command line,
then the processing will be limited to the specified package and ist dependents.
No release related information will be provided.

=back

The 'Full Escrow' extract is the complete operation. All others are sub-sets of
this processing. The complete processing is:

=over 8

=item * Determine all the NODES in the SBOM

=item * Determine all the Base Packages for each NODE

=item * Determine all the Packages for each NODE

=item * Determine all the dependent packages for all packages encountered

=item * Generate a list of jats commands to extract the package source

=item * Generate a file describing the build order

=item * Generate a file describing the packages that cannot be built

=item * Generate an HTML file with extensive cross reference information

=over 8

=item * List of all packages with references into Release Manager

=item * List of all packages showing dependent packages

=item * List of all packages showing consumer packages

=item * List of all packages for which multiple versions are required

=item * Details of packages that are not built.

=item * Build order

=item * Build machines and built types

=item * Deployed target nodes, with references into Deployment Manager

=back

=back

This may take some time, as a typical escrow build may contain many hundreds of packages.

The program will display a list of files that have been created.

=head2 Extraction Operations

Given an 'extract' file from a previous run of this program the program will:

=over 8

=item * Parse the 'extract' file

=item * Create subdirectories for each package version within the file. This is done
in such a way that no views are left in place.

=item * Create a log file showing packages that could not be extracted.

=back

=cut