WebSVN – DevTools – /core_devl/trunk/TOOLS/LOCAL/jats_dm_play02.pl

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# 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 JatsError;
use DBI;
use JatsRmApi;
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_manual;
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
my $opt_sbom_id;
my $opt_test = 0;

#
#   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 @StrayPackages;              # Non-top level packages
my @create_list;                # List of files created
my $RM_DB;
my $DM_DB;
our $GBE_RM_BASE;
our $GBE_DM_BASE;

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


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

my $result = GetOptions (
                "help+"         => \$opt_help,              # flag, multiple use allowed
                "manual"        => \$opt_manual,            # flag
                "verbose+"      => \$opt_verbose,           # flag
                "sbomid=s"      => \$opt_sbom_id,           # string
                "test!"         => \$opt_test,              #[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_manual || ($opt_help > 2));

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

#
#   Sanity test
#
Error ("No sbomid provided.", "example: -sbomid=13543, for NZS Phase-1") unless ( $opt_sbom_id );
$dm_base =~ s~BOMID~$opt_sbom_id~;

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

$rm_base = $GBE_RM_BASE . $rm_base;
$dm_base = $GBE_DM_BASE . $dm_base;

#
#   Determines the OS_ID's for the bom
#
getOSIDforBOMID($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
#
foreach my $pv_id ( keys %pv_id )
{
    getPkgDetailsByPV_ID( $pv_id);
}
LocateStrays();

##
##   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 = "sbom_extract.txt";
push @create_list, $file;
open (JE, ">$file" ) || Error ("Cannot create $file");

$file = "sbom_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 @reason;

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

        push @reason, 'No Source Path' unless ( $path );
        push @reason, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
        push @reason, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
        push @reason, 'Bad Path, http' if ( $path =~ m~^http:~i );

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

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

            print JE "jats extract -view=$vname -label=$label -path=$path -root=. -noprefix\n";
        }
        else
        {
            $Package{$name}{$ver}{bad_extract} = [@reason];
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
        }
    }
}

close (JE);
close (ST);

#
#   Generate build order info
#
BuildOrder();

#
#   Generate depenedancy information and other useful stuff
#
ShowDepends();


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


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

    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 OPERATING_SYSTEMS os, BOM_CONTENTS bc, NETWORK_NODES nn, 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;
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("getOSIDforBOMID:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# 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 PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd, 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 PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd,".
                    "(" .
                        " SELECT osc.seq_num, osc.prod_id".
                        " FROM 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" .
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg, 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] || '';

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

                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info");

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

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

                    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        : 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 PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, 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        : LocateStrays
#
# Description     : Locate stray packages
#                   These are packages that have not been defined by the
#                   top level SBOM. These are not really stray
#
# Inputs          :
#
# Returns         :
#
sub LocateStrays
{
    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} );
#print "Stray: $pv_id, $name, $ver\n";
        getPkgDetailsByPV_ID ( $pv_id );
        $Package{$name}{$ver}{stray} = 1;
    }
}

#-------------------------------------------------------------------------------
# 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 = "sbom_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 $label = $Package{$name}{$ver}{label} || '';
            my $path  = $Package{$name}{$ver}{path} || '';
            $Package{$name}{$ver}{buildorder}  = $level;

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

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

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

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

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

    #
    #   Generate an index
    #
    print DP "<dl><dt><h1>Index</h1></dt>\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=\"#NoBuild\">Packages that cannot be built</a></dd>\n";
    print DP "</dl>\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</th>\n";
    print DP "<th>Package Used by</th>\n";
    print DP "<th>Build Info</th>\n";
    print DP "</tr>\n";

    foreach my $name ( sort keys %Package )
    {
        foreach my $ver ( sort keys %{$Package{$name}} )
        {
            print DP "<tr>\n";
            #
            #   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 %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 %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 %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 %s</a></dd>\n", $dname, $dver;
            }
            print DP "</dl>\n";
            print DP "</td>\n";

            #
            #   Build Info
            #
            print DP $td;
            print DP "<table>";

            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\">$pv_id</a>";

            printf DP "<tr>${tdr}Pvid:</td><td>%s</td></tr>\n", $pv_id_str;
            printf DP "<tr>${tdr}Label:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{label} || 'NoneProvided';
            printf DP "<tr>${tdr}Path:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{path}  || '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 %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 = '';
            }
            

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

            #
            #   End of Row
            #
            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</th>\n";
    print DP "</tr>\n";

    foreach my $name ( sort keys %Package )
    {
        my @versions = keys %{$Package{$name}};
        next unless ( $#versions > 0 );
        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}";
            printf  DP "    <dd><a href=\"#$tag\">%s %s</a></dd>\n", $name, $ver;
        }
        print DP "</dl>\n";
        print DP "</td>\n";
        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</th>\n";
    print DP "</tr>\n";

    foreach my $name ( sort keys %Package )
    {
        my @versions = keys %{$Package{$name}};
        foreach my $ver ( sort @versions )
        {
            next unless exists($Package{$name}{$ver}{bad_extract});
            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 %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 "</tbody></table>\n";


    close DP;
}


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

=pod

=head1 NAME

escrow - Extract Escrow Build Information

=head1 SYNOPSIS

  jats escrow [options] -sbomid=<sbomid>

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -sbomid=xxx        - Specify the SBOM to process
    -verbose           - Enable verbose output
    -[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 is mandatory. It specifies the SBOM to process. The sbomid must be
determined from Deployment Manager.

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

Given an SBOM_ID this program will:

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

=cut
Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LOCAL/jats_dm_play02.pl – Rev 6177
