Subversion Repositories DevTools

Rev

Rev 7299 | Blame | Compare with Previous | Last modification | View Log | RSS feed

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : escrow.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats build system
#
# Description   : Determine packages from an SBOM for escrow purposes
#                 For a given bom_id determine all used packages
#                 Create various bits of useful information
#                   Extract commands
#                   Build Order
#                   Depenendency Info
#                   Bad Packages
#
#......................................................................#

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_skim;
my $opt_test = 0;
my $opt_patch = 1;
my $opt_extract;
my $opt_rootpkg;
my $opt_rootpkg_version;

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

#
#   Constants, that should be variable
#
my $rm_base = "/dependencies.asp?pv_id=";
my $dm_base = "/OsDefault.asp?bom_id=BOMID&os_id=";

#
#   Build types. Should be populated from a table
#
my %BM_ID = (
    1 => "Solaris",
    2 => "Win32",
    3 => "Linux",
    4 => "Generic",
);

my %BSA_ID = (
    1 => "Jats Debug",
    2 => "Jats Prod",
    3 => "Jats Debug+Prod",
    4 => "Ant Java 1.4",
    5 => "Ant Java 1.5",
    6 => "Ant Java 1.6",
);

#
#   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|sbom_id=s"  => \$opt_sbom_id,           # string
                "rtagid|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
                "skim!"             => \$opt_skim,              # Skim the packages from a release - do not recurse
                );

#
#   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'    => 'ESCROW',
             '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, compared against given release",
           "Example: -rtagid=2362, for Sydney R1/R2",
           "Example: -rtagid=8843 -root=StockholmSBOM",
           "Example: PackageName PackageVersion, for extracting a single package",
    )
}
if ($opt_skim && ! $opt_rtag_id)
{
    Error ("The skim option only operates with the rtagid option");
}

#
#   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 );
$dm_base =~ s~BOMID~$opt_sbom_id~ if ($opt_sbom_id);
$fpref = "release" unless ( $opt_sbom_id );

#
#   Import essential EnvVars
#
EnvImport('GBE_RM_URL');
EnvImport('GBE_DM_URL');

$rm_base = $GBE_RM_URL . $rm_base;
$dm_base = $::GBE_DM_URL . $dm_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) unless $opt_skim;
}
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 $tag = $Package{$name}{$ver}{vcstag} || '';
#
#        printf ("%30s %15s %s\n", $name, $ver, $tag );
#    }
#}

#
#   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 $vcstag = $Package{$name}{$ver}{vcstag};
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
        my @reason1;            # can't extract files
        my @reason2;            # Others
        push @reason1, 'No VCS Info' unless ( $vcstag );
        if ( $vcstag =~ m~^CC::(.*?)(::(.+))?$~ ) {
            my $path = $1  || '';
            my $label = $2 || '';
            push @reason1, 'No Label' unless ( $label );
            push @reason1, 'Bad Label, N/A' if ( $label =~ m~^N/A$~i || $label  =~ m~^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~^/~ );

        } elsif ( $vcstag =~ m~^SVN::(.*)?$~ ) {
            my $url = $1;
            push @reason1, 'Bad Path, https' if ( $url =~ m~^https:~i );
            push @reason1, 'Bad Path, http' if ( $url =~ m~^http:~i );
            push @reason1, 'Bad Path, svn' if ( $url =~ m~^svn:~i );
            push @reason1, 'Bad Path, file' if ( $url =~ m~^file:~i );
            push @reason1, 'Bad Path, Begins with /' if ( $url =~ m~^/~i );

        } else {
            push @reason1, 'Bad Version Control Information';
        }

        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 jats_vcsrelease -extractfiles \"-view=$vname\" \"-label=$vcstag\" -root=. -noprefix\n";
        }

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

close (JE);
close (ST);

#
#   Generate build order info
#
BuildOrder();

#
#   Generate HTML depenedancy information and other useful stuff
#
GenerateHTML();
GenerateHTMLLodgement();


#
#   Display names of files created
#
foreach my $file ( sort @create_list )
{
    Message ("Created: $file");
}
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
#                   Also get base_env_id's where they exist
#
# 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];

                    if ( defined $row[3] )
                    {
                        $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

    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

    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.IS_DEPLOYABLE, pbi.BSA_ID, pbi.BM_ID, PV_DESCRIPTION, release_manager.PK_RMAPI.return_vcs_tag($PV_ID)" .
                    " 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 $deployable  = $row[3];
                    my $build_info  = $row[4] || '';
                    my $build_mach  = $row[5] || '';
                    my $description = $row[6] || '';
                    my $vcstag      = $row[7] || '';

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

                    $vcstag =~ 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}{build}{$build_mach} = $build_info if $build_mach;
                    $Package{$name}{$ver}{description} = $description;
                    $Package{$name}{$ver}{vcstag} = $vcstag;

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

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

    connectRM(\$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        : BuildOrder
#
# Description     : Determine the order to build packages
#
# Inputs          :
#
# Returns         :
#
sub BuildOrder
{
    foreach my $name ( keys %Package )
    {
        foreach my $ver ( keys %{$Package{$name}} )
        {
            AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );
        }
    }
    
    DetermineBuildOrder();
}

#-------------------------------------------------------------------------------
# Function        : AddToBuildList
#
# Description     : Add packages to a build list
#
# Inputs          : PackageName
#                   PackageVersion
#                   Hash of dependancies
#
# Returns         :
#
my %BuildList;
sub AddToBuildList
{
    my ($name, $ver, $pdepends ) = @_;

    Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};

    #
    #   Clone dependancies as we will destroy the list as we process data
    #
    my $ref;
    $ref = dclone ($pdepends ) if $pdepends;
    $BuildList{$name,$ver}{depends} = $ref;
}

#-------------------------------------------------------------------------------
# Function        : DetermineBuildOrder
#
# Description     : Determine the build order
#
# Inputs          :
#
# Returns         :
#
sub DetermineBuildOrder
{

    my $file = "${fpref}_buildinfo.txt";
    push @create_list, $file;
    
    open (BI, ">$file" )  || Error ("Cannot create $file");

#    DebugDumpData ("BuildList", \%BuildList); exit 1;

    my $more = 1;
    my $level = 0;
    while ( $more )
    {
        my @build;
        $level ++;
        $more = 0;
        foreach my $key ( keys %BuildList )
        {
            #
            #   Locate packges with no dependencies left
            #
            next if ( keys %{$BuildList{$key}{depends}} );
            push @build, $key;
        }

        foreach my $build ( @build )
        {
            $more = 1;
            delete $BuildList{$build};
            my ($name, $ver) = split $;, $build;
            my $vcstag = $Package{$name}{$ver}{vcstag} || '';
            $Package{$name}{$ver}{buildorder}  = $level;

            printf BI "Build(%2d): %40s %15s %s\n", $level, $name, $ver, $vcstag;
        }

        #
        #   Delete dependencies
        #
        foreach my $key ( keys %BuildList )
        {
            foreach my $build ( @build )
            {
                delete $BuildList{$key}{depends}->{$build};
            }
        }
    }
    close BI;
}

#-------------------------------------------------------------------------------
# Function        : GenerateHTML
#
# Description     : Generate Dependency information
#                   Generate a nive HTML dependancy table
#                   Shows DependOn and UsedBy
# Inputs          :
#
# Returns         :
#

sub th
{
    my ($text, $span) = @_;

    my $string = '<th style="vertical-align: top;"';
    $string .= " colspan=\"$span\"" if ( $span );
    $string .= '>' . $text . '</th>' . "\n";
    return $string;
}

sub thl
{
    my ($text, $span) = @_;

    my $string = '<th style="text-align: left;"';
    $string .= " colspan=\"$span\"" if ( $span );
    $string .= '>' . $text . '</th>' . "\n";
    return $string;
}


sub GenerateHTML
{
    my $td = '<td style="vertical-align: top;">' . "\n";
    my $tdr = '<td style="text-align: right;">';

    my $file = "${fpref}_depends.html";
    push @create_list, $file;
    open (DP, ">$file" )  || Error ("Cannot create $file");

    #
    #   Generate a header
    #
    print DP "<dl><dt><h1>Extraction Details</h1></dt>\n";
    if ( $opt_sbom_id )
    {
        print DP "<dd>SBOM Base</dd>\n";
        print DP "<dd>Project: $sbom_project</dd>\n";
        print DP "<dd>BOM    : $sbom_name</dd>\n";
        print DP "<dd>Branch : $sbom_branch</dd>\n";
        print DP "<dd>Version: $sbom_version</dd>\n";
        print DP "<dd>SBOM ID: $opt_sbom_id</dd>\n";
    }

    if ( $opt_rtag_id )
    {
        getReleaseDetails($opt_rtag_id);
        print DP "<dd>Release Base</dd>\n";
        print DP "<dd>Project: $rtag_project</dd>\n";
        print DP "<dd>Release: $rtag_release</dd>\n";
        print DP "<dd>RTAG ID: $opt_rtag_id</dd>\n";
    }

    print DP "<dd>Root Package: $opt_rootpkg , $opt_rootpkg_version</dd>\n" if ($opt_rootpkg);
    print DP "</dl>\n";

    #
    #   Generate an index
    #
    print DP "<dl><dt><h1>Index</h1></dt>\n";
    print DP "<dd><a href=\"#Ignore\">Ignored Packages</a></dd>\n";
    print DP "<dd><a href=\"#Depend\">Dependency Info</a></dd>\n";
    print DP "<dd><a href=\"#Multi\">Multiple Package Version</a></dd>\n";
    print DP "<dd><a href=\"#Leaf\">Packages that have no parents</a></dd>\n";
    print DP "<dd><a href=\"#NoBuild\">Packages that cannot be built</a></dd>\n";
    print DP "<dd><a href=\"#Excess\">Excess Packages from Release: $opt_rtag_id</a></dd>\n" if ( $opt_rtag_id && ($opt_sbom_id || $opt_rootpkg ));
    print DP "<dd><a href=\"#Stray\">Required Packages, not part of the release</a></dd>\n" if ( $opt_rtag_id && ! ($opt_sbom_id || $opt_rootpkg) );
    print DP "<dd><a href=\"#Inconsistent\">Packages in the Release, with inconsistent dependencies</a></dd>\n" if ( $opt_rtag_id && !$opt_sbom_id );

    print DP "</dl>\n";

    #
    #   Ignored Packages
    #
    print DP "<h1><a name=\"Ignore\">Ignored Packages</a></h1>\n";

    print DP "The following package, and all dependents, have been ignored.<br><br>\n";

    foreach my $name ( sort keys %ignore )
    {
        print DP "$name: $ignore{$name} versions<br>\n";
    }

    unless ( $opt_patch )
    {
        print DP "The following package have patches that have been ignored.<br><br>\n";
        foreach my $name ( sort keys %patch )
        {
            print DP "$name: $patch{$name} patches<br>\n";
        }
    }

    #
    #   Dependency Information
    #
    print DP "<h1><a name=\"Depend\">Dependency Info</a></h1>\n";

    print DP "<table border=\"1\"><tbody>\n";
    print DP "<tr>\n";
    print DP th("Package Dependency");
    print DP th("Package Used by");
    print DP th("Build Info");
    print DP "</tr>\n";
    my $package_count = 0;
    foreach my $name ( sort keys %Package )
    {
        foreach my $ver ( sort keys %{$Package{$name}} )
        {
            print DP "<tr>\n";
            $package_count++;
            #
            #   Depends On info
            #

            print DP $td;
            my $anchor= "${name}_${ver}";
            my $tag = "usedby_${name}_${ver}";
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Depends on:</dt>\n", $name, $ver;
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
            {
                my ($dname, $dver) = split $;, $depend;
                my $tag = "${dname}_${dver}";
                printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
            }
            print DP "</dl>\n";
            print DP "</td>\n";


            #
            #   Used By information
            #
            print DP $td;
            $anchor= "usedby_${name}_${ver}";
            $tag = "${name}_${ver}";
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Used by:</dt>\n", $name, $ver;
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
            {
                my ($dname, $dver) = split $;, $depend;
                my $tag = "usedby_${dname}_${dver}";
                printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
            }
            print DP "</dl>\n";
            print DP "</td>\n";

            #
            #   Build Info
            #
            print DP $td;
            print DP "<table>";
            my $stray = ( exists ($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );

            my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';
            my $pv_id_ref = $rm_base . $pv_id;
               $pv_id_ref .= "&rtag_id=" . $opt_rtag_id if ($opt_rtag_id && !$stray);
            my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";

            printf DP "<tr>${tdr}Pvid:</td><td>%s</td></tr>\n", $pv_id_str;
            printf DP "<tr>${tdr}VcsTag:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{vcstag} || 'NoneProvided';

            my $order = 'Not Built';
            my @machs;

            if ( exists($Package{$name}{$ver}{build}) )
            {
                $order = $Package{$name}{$ver}{buildorder};
                @machs = sort keys %{$Package{$name}{$ver}{build}};
            }
            else
            {
                my $tag = "notbuilt_${name}_${ver}";
                $order = "<a href=\"#$tag\">Not Built</a>"
            }

            printf DP "<tr>${tdr}Build Order:</td><td>%s</td></tr>\n", $order;

            my $text = "Build:";
            foreach my $mach ( @machs )
            {
                my $type = $Package{$name}{$ver}{build}{$mach};
                printf DP "<tr>${tdr}$text</td><td>%s&nbsp;%s</td></tr>\n", $BM_ID{$mach} || "Unknown, $mach", $BSA_ID{$type} || 'Unknown';
                $text = '';
            }

            my $pvid = $Package{$name}{$ver}{pvid};
            $text = "Deployed:";
            foreach my $osid ( sort keys %{ $pv_id{$pvid}{os_id}  } )
            {
                my $os_name = $os_id_list{$osid}{os_name};
                my $node =    $os_id_list{$osid}{node_name};

                my $ref = $dm_base . $osid;
                my $str = "<a href=\"$ref\">$node,($os_name)</a>";


                printf DP "<tr>${tdr}$text</td><td>$str</td></tr>\n";
                $text = '';
            }

            if ( $stray )
            {
                printf DP "<tr>${tdr}Stray:</td><td>Package included indirectly</td></tr>\n";
            }
            
            

            print DP "</table>";
            print DP "</td>\n";

            #
            #   End of Row
            #
            print DP "</tr>\n";
        }
    }
    print DP "<tr>\n";
    print DP thl("Total Count: $package_count", 3);
    print DP "</tr>\n";
    
    print DP "</tbody></table>\n";


    #
    #   Multiple versions of a package
    #
    print DP "<h1><a name=\"Multi\">Multiple Package Versions</a></h1>\n";
    print DP "<table border=\"1\"><tbody>\n";
    print DP "<tr>\n";
    print DP th("Multiple Versions");
    print DP "</tr>\n";
    my $multiple_count = 0;
    foreach my $name ( sort keys %Package )
    {
        my @versions = keys %{$Package{$name}};
        next unless ( $#versions > 0 );
        $multiple_count++;
        print DP "<tr>\n";
        print DP $td;
        printf  DP "<dl><dt>$name</a> Versions:<dt>\n";

        foreach my $ver ( sort @versions )
        {
            my $tag = "${name}_${ver}";
            print  DP "    <dd>";
            printf DP "<a href=\"#$tag\">%s&nbsp;%s</a>\n", $name, $ver;
            print  DP " - Not in Release" if ($opt_rtag_id && $Package{$name}{$ver}{stray});
            print  DP "</dd>\n";
        }
        print DP "</dl>\n";
        print DP "</td>\n";
        print DP "</tr>\n";
    }
    print DP "<tr>\n";
    print DP thl("Total Count: $multiple_count");
    print DP "</tr>\n";
    
    print DP "</tbody></table>\n";


    #
    #   Leaf Packages
    #
    print DP "<h1><a name=\"Leaf\">Packages that have no parents</a></h1>\n";
    print DP "<table border=\"1\"><tbody>\n";
    print DP "<tr>\n";
    print DP th("Leaf Packages");
    print DP "</tr>\n";
    my $leaf_count = 0;
    foreach my $name ( sort keys %Package )
    {
        foreach my $ver ( sort keys %{$Package{$name}} )
        {
            my @usedby = keys %{$Package{$name}{$ver}{usedby}};
            next if ( @usedby );
            $leaf_count++;

            print DP "<tr>\n";
            print DP $td;

            my $tag = "${name}_${ver}";

            printf  DP "<dt><a href=\"#$tag\">%s&nbsp;%s</a>\n", $name, $ver;

            print DP "</td>\n";
            print DP "</tr>\n";
        }
    }
    print DP "<tr>\n";
    print DP thl("Total Count: $leaf_count");
    print DP "</tr>\n";
    print DP "</tbody></table>\n";



    #
    #   Packages that cannot be built
    #
    print DP "<h1><a name=\"NoBuild\">Packages that cannot be built</a></h1>\n";
    print DP "<table border=\"1\"><tbody>\n";
    print DP "<tr>\n";
    print DP th("Not Built");
    print DP "</tr>\n";
    my $no_build_count = 0;

    foreach my $name ( sort keys %Package )
    {
        my @versions = keys %{$Package{$name}};
        foreach my $ver ( sort @versions )
        {
            next unless exists($Package{$name}{$ver}{bad_extract});
            $no_build_count++;
            my @reasons = @{$Package{$name}{$ver}{bad_extract}};

            print DP "<tr><dl>\n";
            print DP $td;

            my $tag = "${name}_${ver}";
            my $anchor = "notbuilt_${name}_${ver}";
            
            printf  DP "<dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a></dt>\n", $name, $ver;
            foreach my $reason ( @reasons )
            {
                print  DP "<dd>$reason</dd>\n";
            }


            print DP "</dl>\n";
            print DP "</td>\n";
            print DP "</tr>\n";
            
        }
    }
    print DP "<tr>\n";
    print DP thl("Total Count: $no_build_count");
    print DP "</tr>\n";

    print DP "</tbody></table>\n";

    #
    #   Packages that are in a specified release, but not described by the SBOM
    #
    if ( $opt_rtag_id && ($opt_sbom_id || $opt_rootpkg) )
    {
        print DP "<h1><a name=\"Excess\">Excess Packages from Release: $opt_rtag_id</a></h1>\n";
        print DP "<table border=\"1\"><tbody>\n";
        print DP "<tr>\n";
        print DP th("Excess Packages",3);
        print DP "</tr>\n";

        print DP "<tr>\n";
        print DP th("Package");
        print DP th("PVID");
        print DP th("Used Package");
        print DP "</tr>\n";

        my $were_found = 0;
        my $not_found = 0;
        foreach my $name ( sort keys %Release )
        {
            my @versions = keys %{$Release{$name}};
            foreach my $ver ( sort @versions )
            {
                if (exists($Package{$name}{$ver}))
                {
                    $were_found++;
                    next;
                }
                $not_found++;

                print DP "<tr>\n";
                print DP $td;

                my $pv_id = $Release{$name}{$ver}{pv_id} || 'No PVID';
                my $pv_id_ref = $rm_base . $pv_id . "&rtag_id=" . $opt_rtag_id;
                my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";

                print DP $name, $ver;
                print DP "</td>\n";

                print DP $td;
                printf DP "Pvid: %s\n", $pv_id_str;
                print DP "</td>\n";

                print DP $td;
                my @pver = keys %{$Package{$name}};
                if (@pver)
                {
                    printf  DP "<dl><dt> Uses Versions:<dt>\n";
                    foreach my $ver ( sort @pver  )
                    {
                        my $tag = "${name}_${ver}";
                        printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $name, $ver;
                    }
                    print DP "</dl>\n";
                }
                else
                {
                    printf DP "No Versions of this package used\n"
                }
                print DP "</td>\n";


                print DP "</tr>\n";
            }
        }

        print DP "<tr>\n";
        print DP thl("Packages found in SBOM: $were_found",3);
        print DP "</td>\n";
        print DP "</tr>\n";

        print DP "<tr>\n";
        print DP thl("Packages NOT found in SBOM: $not_found", 3);
        print DP "</td>\n";
        print DP "</tr>\n";
        
        print DP "</tbody></table>\n";
    }

    #
    #   Packages that are strays
    #   They are not top level packages in the release
    #
    if ( $opt_rtag_id && ! ($opt_sbom_id || $opt_rootpkg) )
    {
        print DP "<h1><a name=\"Stray\">Required Packages, not part of the release</a></h1>\n";
        print DP "<table border=\"1\"><tbody>\n";
        print DP "<tr>\n";
        print DP th("Stray Packages",3);
        print DP "</tr>\n";

        print DP "<tr>\n";
        print DP th("Inconsisient Package");
        print DP th("PVID");
        print DP th("Preferred Package");
        print DP "</tr>\n";
        my $stray_count = 0;

        foreach my $name ( sort keys %Package )
        {

            my @versions = keys %{$Package{$name}};
            foreach my $ver ( sort @versions )
            {
                unless (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} )
                {
                    next;
                }

                #
                #   Determine preferred package version(s)
                #   These will be those without a 'stray' tag
                #
                my @preferred = ();
                foreach my $pver ( keys %{$Package{$name}} )
                {
                    next if (exists($Package{$name}{$pver}{stray} ) && $Package{$name}{$pver}{stray} );
                    push @preferred, $pver;
                }

                print DP "<tr>\n";
                $stray_count++;

                #
                #  Package name and Used By information
                #
                print DP $td;
                my $anchor= "usedby_${name}_${ver}";
                my $tag = "${name}_${ver}";
                printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Used by:</dt>\n", $name, $ver;
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
                {
                    my ($dname, $dver) = split $;, $depend;
                    my $tag = "usedby_${dname}_${dver}";
                    printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
                }
                print DP "</dl>\n";
                print DP "</td>\n";


                my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';

                my $pv_id_ref = $rm_base . $pv_id;
                my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";

                print DP $td;
                printf DP "Pvid: %s\n", $pv_id_str;
                print DP "</td>\n";

                #
                #   Insert Preferred package(s)
                #
                print DP $td;
                print DP "<table>\n";
                foreach my $pver ( sort @preferred )
                {
                    my $tag = "${name}_${pver}";
                    printf  DP "<tr><td><a href=\"#$tag\">%s&nbsp;%s</a></td></tr>\n", $name, $pver;
                }

                print DP "</table>\n";
                print DP "</tr>\n";
                
            }
        }

        print DP "<tr>\n";
        print DP thl("Total Count: $stray_count", 3);
        print DP "</tr>\n";
        print DP "</tbody></table>\n";
    }

    #
    #   Packages that have components not in the release
    #   They are not top level packages in the release
    #
    if ( $opt_rtag_id && !$opt_sbom_id )
    {
        print DP "<h1><a name=\"Inconsistent\">Packages in the Release, with inconsistent dependencies</a></h1>\n";
        print DP "<table border=\"1\"><tbody>\n";

        print DP "<tr>\n";
        print DP th("Inconsisient Package");
        print DP "</tr>\n";
        my $inconsistent_count = 0;

        foreach my $name ( sort keys %Package )
        {

            my @versions = keys %{$Package{$name}};
            foreach my $ver ( sort @versions )
            {
                #
                #   Ignore 'stray' packages
                #
                next if (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );

                #
                #   Is it inconsitient
                #
                my $ok = 1;
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
                {
                    my ($dname, $dver) = split $;, $depend;
                    if (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} )
                    {
                        $ok = 0;
                        last;
                    }
                }

                next if ( $ok );
                $inconsistent_count++;

                #
                #   Depends On info
                #

                print DP "<tr>\n";
                print DP $td;
                my $anchor= "${name}_${ver}";
                my $tag = "usedby_${name}_${ver}";
                printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Inconsistent::</dt>\n", $name, $ver;
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
                {
                    my ($dname, $dver) = split $;, $depend;
                    next unless (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} );
                    
                    my $tag = "${dname}_${dver}";
                    printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
                }
                print DP "</dl>\n";
                print DP "</td>\n";
                print DP "<tr>\n";

            }
        }

        print DP "<tr>\n";
        print DP thl("Total Count: $inconsistent_count");
        print DP "</tr>\n";
        print DP "</tbody></table>\n";
    }
    
    close DP;
}

#-------------------------------------------------------------------------------
# Function        : GenerateHTMLLodgement
#
# Description     : Simple document to describe packages
#
# Inputs          : 
#
# Returns         : 
#
sub GenerateHTMLLodgement
{
    my $td  = '<td style="vertical-align: top;">' . "\n";

    my $file = "${fpref}_lodgement.html";
    push @create_list, $file;
    open (DP, ">$file" )  || Error ("Cannot create $file");

    #
    #   Package Information
    #
    print DP "<h1>Package Information</h1>\n";

    print DP "<table border=\"1\"><tbody>\n";
    print DP "<tr>\n";
    print DP th("Name, Version");
    print DP th("Dependencies");
    print DP "</tr>\n";
    my $package_count = 0;
    foreach my $name ( sort keys %Package )
    {
        foreach my $ver ( sort keys %{$Package{$name}} )
        {
            print DP "<tr>\n";
            $package_count++;

            my $anchor= "${name}_${ver}";

            #
            #   Package Name and description
            #   Cleanup and html-ize the description string
            #
            my $description = $Package{$name}{$ver}{description};
            $description =~ s{\n\r}{\n}g;
            $description =~ s{\r}{}g;
            $description =~ s{^\n+}{};
            $description =~ s{&}{&amp;}g;
            $description =~ s{<}{&lt;}g;
            $description =~ s{>}{&gt;}g;
            $description =~ s{"}{&quot;}g;
            $description =~ s{\n}{<br>\n}g;

            print DP $td;
            printf  DP "<a name=\"$anchor\"></a>%s,&nbsp;%s<br>\n", $name, $ver;
            print DP "<dl><dd>\n";
            print  DP $description;
            print DP "</dd></dl>\n";
            print DP "\n</td>\n";

            #
            #   Depends On info
            #
            my $icount = 0;
            print DP $td;
#            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Depends on:</dt>\n", $name, $ver;
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
            {
                my ($dname, $dver) = split $;, $depend;
                my $tag = "${dname}_${dver}";
                printf  DP "<a href=\"#$tag\">%s&nbsp;%s</a><br>\n", $dname, $dver;
                $icount++;
            }
            print DP "<br>\n" unless $icount;
            print DP "</td>\n";

            #
            #   End of Row
            #
            print DP "</tr>\n";
        }
    }
    print DP "<tr>\n";
    print DP thl("Total Count: $package_count", 2);
    print DP "</tr>\n";
    
    print DP "</tbody>\n";
    print DP "</table>\n";
    close DP;
}

#-------------------------------------------------------------------------------
# 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 ($view, $vcstag);
        if ( m{(\s"-view=([^"]+)")|(\s-view=(\S+))} )
        {
            $view = $2 || $4;
        }

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


        Error "Bad file format in line: $_" unless ( $view && $vcstag );
        Error "Duplicate view name: $view" if ( exists $extract{$view} );
        push @extract_order, $view;
        $extract{$view}{vcstag} = $vcstag;
    }
    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 $vcstag = $extract{$view}{vcstag};
        if ( $opt_test )
        {
            Verbose ("view($view) vcstag($vcstag)");
            print FH "view($view) vcstag($vcstag) : TEST\n";
        }
        else
        {
            my $rv = JatsCmd ('jats_vcsrelease', '-devmode=escrow', '-extractfiles', "-view=$view", "-label=$vcstag", "-root=.", "-noprefix");
            print FH "$view : SUCCESS\n" unless $rv;
            print FH "$view : 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
    -[no]skim          - Skim packages from release. Do not extract dependencies

=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<-[no]skim>

This option is only valid with the -rtag option. It will only process the package versions
specified in the release. It will not locate dependent packages that may be required for 
pegged 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