Subversion Repositories DevTools

Rev

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

########################################################################
# Copyright (C) 1998-2012 Vix Technology, All rights reserved
#
# Module name   : cc2svn_gendata_sbom.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Get all packages that are used in all releases
#                 Create a data file that can be used offline
#
#                 The process will exclude some old releases
#
#                 Generate data on Essential Package Versions to be
#                 transferred from CC to Subversion
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsError;
use JatsSystem;
use Getopt::Long;
use Pod::Usage;                             # required for help support
use JatsRmApi;
use ConfigurationFile;

use DBI;
use HTTP::Date;

my $VERSION = "1.2.3";                      # Update this
my $opt_verbose = 0;
my $opt_help = 0;
my $opt_manual;
my $opt_test;
my $opt_limit;
my $opt_quick;
my $opt_mode = '';
my $opt_sbom = 0;
my $RM_DB;
my $DM_DB;
my $now = time();

#
#   Package information
#
my %Releases;
my %Packages;
my %Suffixes;
my @StrayPackages;
my %AllPackages;

my %sboms;
my %os_id_list;
my %os_env_list;
my %sbom_pvid;
my @sbomNeeded;

my $doAllReleases = 0;
my $doIncludeOnly = 1;
my @includedProjects = (
#        481,    # UK BUS HOPS
);

my @includedReleases = (
        6222,   # HOME > UK STAGE COACH (SSW) > Mainline
        14503,  # HOME > UK STAGE COACH (SSW) > ITSO_HOPS_3
        21303,  # HOME > UK STAGE COACH (SSW) > SUPPORT_HOPS_REPORTS
        21343,  # HOME > UK STAGE COACH (SSW) > SUPPORT_CIPP
        17223,  # HOME > UK STAGE COACH (SSW) > ITSO HOPS 4
);


my @excludeProjects = ( 162,            # WASHINGTON (WDC)
                        341,            # TUTORIAL (TUT)
                        142,            # SYDNEY (SYD)
                        182 ,           # ROME (ROM)
                        6 ,             # GMPTE/PCL (GMP)
                        521,            # NSW CLUB CARD
                        221,            # NZ STAGE COACH (NZS)
                        82,             # LVS
                        42,             # SFO
                        641,            # BCC Releaeses
                        62,             # OSLO
                        4,              # Singapore
                        441,            # Tas
                        102,            # Ventura
                        );
my @excludeReleases = ( 20424,          # MASS_REF (MAS) > test
                        # RJACK 9043,           # TECHNOLOGY GROUP > Development Environment - For Test Setup
                        # RJACK 14383,          # TECHNOLOGY GROUP > eBrio TDS
                        # RJACK 20463,          # TECHNOLOGY GROUP > TPIT - BackOffice Linux build
                        # RJACK 14603,          # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]
                        #9263,           # TECHNOLOGY GROUP > Buildtool DEVI&TEST
                        22163,          # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey
                        19483,          # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]
                        20403,          # SEATTLE (SEA) > Phase 2 - I19 [backup]
                        20983,          # ??? May have been deleted
                        13083,          # TECHNOLOGY GROUP > TRACS
                        15224,          # 64Bit Solaris Test
                        
                        );

my @excludeBomProjects = (
    4,      # SINGAPORE (SG)
    6,      # GMPTE/PCL (GMP)
    42,     # SAN FRANCISCO (SFO)
    62,     # OSLO (OSO)
    82,     # LAS VEGAS (LVS)
    102,    # VENTURA (VC)
#    122,   # VASTTRAFIK (VTK)
    142,    # SYDNEY (SYD)
    162,    # WASHINGTON (WDC)
#    164,   # SEATTLE (SEA)
    182,    # ROME (ROM)
#    202,   # STOCKHOLM (SLS)
#    221    # NZ STAGE COACH (NZS)
#    261    # VÄSTTRAFIK PRODUCTION (VTProd)
#    301    # BEIJING (BEI)
    321,    # SAN FRANCISCO PRODUCTION (SFOProd)
#    361    # UK STAGE COACH (SSW) Historical
#    401    # SEATTLE INTEGRATION (SEA Int)
#    421    # UK STAGE COACH PRODUCTION (SSWProd)
    441,    # COTRAL
    461,    # TASMANIA DEMO (MFCS)
#    481    # TECHNOLOGY GROUP
#    501    # UK Certification (UKCert)
#    503    # UK SOUTHWEST TRAINS (SWT)
#    521    # UKSP
#    541    # UK BUS HOPS (SBH)
#    561    # NSW Club Card (NCC)
#    581    # UK Projects
#    601    # GLOBAL PRODUCT MGMT(GPM)
    621,    # NEW DEHLI (NDL)
#    641    # TRACS Projects
#    701    # BANGKOK (BKK)
#    721,   # CAPE TOWN
);

my @includeBomProjects = (
    361,    # UK STAGE COACH (SSW) Historical
    421,    # UK STAGE COACH PRODUCTION (SSWProd)
    501,    # UK Certification (UKCert)
    503,    # UK SOUTHWEST TRAINS (SWT)
    521,    # UKSP
    541,    # UK BUS HOPS (SBH)
    581,    # UK Projects
    641,    # TRACS Projects
);


my %sillyVersions =
(
    '2b6'           => '2.6.0.cots',
    '1.0b2'         => '1.0.2.cots',
    '1.6.x'         => '1.6.0.cots',
    '3.5beta12.5'   => '3.5.12.5.cots',
    '1.0b1.1.mas'   => '1.1.1.mas',
);

my %suffixFixup = (
    '.sf'           => '.sfo',
    '.vt'           => '.vtk',
    '.lv'           => '.lvs',
    '.was'          => '.wdc',
    '.uk.1'         => '.uk',
    '.ssts.demo'    => '.ssts',
    '.u244.syd'     => '.syd',
    '.pxxx.sea'     => '.sea',
    '.pxxx.syd'     => '.syd',
    '.pxxx.sydddd'  => '.syd',
    '.oslo'         => '.oso',
);
                        
#-------------------------------------------------------------------------------
# Function        : Main Entry
#
# Description     :
#
# Inputs          :
#
# Returns         :
#
my $result = GetOptions (
                "help+"         => \$opt_help,          # flag, multiple use allowed
                "manual"        => \$opt_manual,        # flag
                "verbose+"      => \$opt_verbose,       # flag
                "test:s"        => \$opt_test,          # Test a version string
                "limit:n"       => \$opt_limit,         #
                "quick"         => \$opt_quick,         # Don't look for indirects
                'mode:s'        => \$opt_mode,          # Mode of operation
                'sbom!'         => \$opt_sbom,          # Include Sboms
                );

#
#   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'    =>'CC2SVN_GENDATA' );

if ( $opt_test )
{
    my @results = massageVersion( $opt_test, 'DummyName' );
    Message ("Version", $opt_test, @results);
    exit 1;
}

#
#   Set up the mode
#   Must be specified
#
if ( $opt_mode eq 'all' ) {
    $doAllReleases = 1;
    $doIncludeOnly = 0;
    
} elsif ( $opt_mode eq 'hops' ) {
    $doAllReleases = 0;
    $doIncludeOnly = 1;

} elsif ( $opt_mode eq 'standard' ) {
    $doAllReleases = 0;
    $doIncludeOnly = 0;

} else {
    Error ("Mode not specified: all, hops, standard");
}

#
#   Extract information from Deployment Manager
#
if ( $opt_sbom )
{
    Message ("Get BOMs");
    getBoms();

    Message ("Get SBOM Info");
    getOSIDforBOMID($_) foreach keys %sboms;

    Message ("SBOMs : " . scalar @sbomNeeded);
    Message ("get SBOM Details");
    getSBOMDetails($_) foreach ( @sbomNeeded );

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

    #
    #   Determine all the top level packages in the BOM
    #
    Message ("get Top Level BOM Packages");
    foreach my $os_id ( sort keys %os_id_list )
    {
        getPackages_by_osid( $os_id );
    }
    Message ("SBOM PackageVersions : " . scalar keys %sbom_pvid);
    #DebugDumpData("PVID", \%sbom_pvid );
}
else
{
    Message ("SBOM Information not included");
}
GetAllPackageNames();
getReleaseDetails();
getPkgDetailsByRTAG_ID();
my ($pcount, $vcount) = countPackages();
print "Directly referenced Packages: $pcount Versions: $vcount\n";
LocateStrays() unless ($opt_quick);
($pcount, $vcount) = countPackages();
print "Indirectly referenced Packages: $pcount Versions: $vcount\n";
processData();
outputData();

if ( $opt_verbose > 1 )
{
    print "=========================================================================\n";
    DebugDumpData("Releases", \%Releases);
    print "=========================================================================\n";
    DebugDumpData("Packages", \%Packages );
    print "=========================================================================\n";
    DebugDumpData("Suffixes", \%Suffixes );
}

($pcount, $vcount) = countPackages();
print "Total References Packages: $pcount Versions: $vcount\n";
exit;


#-------------------------------------------------------------------------------
# Function        : getBoms
#
# Description     : Get all the BOM Id's and parent project IDs
#                   Also get base_env_id's where they exist
#
# Inputs          :
#
# Returns         :
#
sub getBoms
{
    my $foundDetails = 0;
    my (@row);
    Verbose ("getBoms");
    connectDM(\$DM_DB) unless ($DM_DB);

    my $m_sqlstr = "SELECT ".
                        "p.PROJ_ID,".
                        "p.PROJ_NAME,".
                        "br.BRANCH_ID,".
                        "bm.BOM_ID".
                   " FROM DEPLOYMENT_MANAGER.DM_PROJECTS p, " .
                         "DEPLOYMENT_MANAGER.BRANCHES br, ".
                         "DEPLOYMENT_MANAGER.BOMS bm ".
                   " WHERE p.PROJ_ID = br.PROJ_ID ".
                      "AND br.BRANCH_ID = bm.BRANCH_ID";

    my $sth = $DM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
#print "----@row\n";
                    my $project_id = $row[0];
                    my $name = $row[1];
                    my $bom_id = $row[3];

                    if ( exists $sboms{$bom_id} )
                    {
                        print "---- BAD: Multiple BOM IDS\n";
                    }

                    $sboms{$bom_id}{project_id} = $project_id;
                    $sboms{$bom_id}{project_name} = $name;
                    $foundDetails = 1;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("getBoms:Execute failure: $m_sqlstr" );
        }
    }
    else
    {
        Error("getBoms:Prepare failure" );
    }

    Warnng("getBoms:No BOM Information Found" ) unless $foundDetails;

#    DebugDumpData("sboms", \%sboms );
}
#-------------------------------------------------------------------------------
# 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);
print("getOSIDforBOMID: $bom_id\n");
    Verbose ("getOSIDforBOMID: $bom_id");
    connectDM(\$DM_DB) unless ($DM_DB);

    my $project_id = $sboms{$bom_id}{project_id};
#print "getOSIDforBOMID: $bom_id, $project_id\n";
    if ( $doIncludeOnly )
    {
        unless ( grep {$_ eq $project_id} @includeBomProjects)
        {
#print "Ignoring $bom_id, $project_id\n";
            return;
        }
    }
    else
    {
        if ( grep {$_ eq $project_id} @excludeBomProjects)
        {
     #print "Ignoring $bom_id\n";
            return;
        }
    }

    #
    #   Save for later
    #
    push @sbomNeeded, $bom_id;
#print "Processing getOSIDforBOMID: $bom_id, $project_id\n";

    my $m_sqlstr = "SELECT distinct bc.BOM_ID, 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 )
                {
#print "----@row\n";
                    Verbose ("OS_ID: ".join (',',@row) );
                    $sboms{$row[0]}{needed} = 1;
                    $os_id_list{$row[1]}{bom_id} = $row[0];
                    $os_id_list{$row[1]}{os_name} = $row[2];
                    $os_id_list{$row[1]}{node_name} = $row[3];

                    if ( defined $row[4] )
                    {
                        $os_env_list{$row[4]}{needed} = 1;
                        $os_env_list{$row[4]}{os_id}{$row[1]} = 1;
                    }

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

    Warning("getOSIDforBOMID:No OS Information Found: Project:$project_id BOM:$bom_id" ) unless $foundDetails;
    
}

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

    Verbose ("getSBOMDetails: $bom_id");
    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 )
                {
#                    $sboms{$bom_id}{sbom_project}   = $row[0];
                    $sboms{$bom_id}{sbom_name}      = $row[1];
                    $sboms{$bom_id}{sbom_branch}    = $row[2];
                    $sboms{$bom_id}{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        : 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';

                    $sbom_pvid{$pv_id}{pkg_name} =$name;
                    $sbom_pvid{$pv_id}{pkg_ver} = $ver;

                    push @{$Packages{$pv_id}{sbomBase}}, $base_env_id;

                    push @StrayPackages, $pv_id;

                    foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )
                    {
                        $sbom_pvid{$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         :
#

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 )
            {
                $foundDetails = 1;
                while ( @row = $sth->fetchrow_array )
                {
print ("SBOM Package:".join (',',@row). "\n" );
                    Verbose ("SBOM Package:".join (',',@row) );
                    my $pv_id =     $row[8];
                    unless ( exists $sbom_pvid{$pv_id} )
                    {
                        my $name =      $row[2]  || 'BadName';
                        my $ver =       $row[3]  || 'BadVer';

                        $sbom_pvid{$pv_id}{pkg_name} =$name;
                        $sbom_pvid{$pv_id}{pkg_ver} = $ver;

                        push @{$Packages{$pv_id}{sbomOsidUsed}}, $os_id;
                        $Packages{$pv_id}{sbomOsid} = 1;
                        push @StrayPackages, $pv_id;


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

    Error ("getPackages_by_osid: Nothing found for os_id: $os_id ")
        unless ( $foundDetails );
}

#-------------------------------------------------------------------------------
# Function        : getReleaseDetails
#
# Description     : Determine all candiate releases
#
# Inputs          : 
#
# Returns         : 
#
sub getReleaseDetails
{
    my (@row);

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    # First get all packages that are referenced in a Release
    # This will only get the top level packages
    # From non-archived releases

    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .
                   " FROM release_manager.release_tags rt, release_manager.projects prj" .
                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .
#                   "   AND rt.official != 'A' ".
#                   "   AND rt.official != 'Y'" .
                   " order by prj.PROJ_NAME";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
#            print "--- Execute\n";
            if ( $sth->rows )
            {
#                print "--- Execute ROWS\n";
                while ( @row = $sth->fetchrow_array )
                {
                    my $rtag_id =$row[3];
                    my $proj_id = $row[2];

                    $Releases{$rtag_id}{pName} = $row[0];
                    $Releases{$rtag_id}{name} = $row[1];
                    $Releases{$rtag_id}{proj_id} = $proj_id;
                    $Releases{$rtag_id}{rtag_id} = $rtag_id;
                    $Releases{$rtag_id}{official} = $row[4];

                    unless ( $doAllReleases )
                    {
                        if (grep {$_ eq $proj_id} @excludeProjects) {
                            $Releases{$rtag_id}{excluded} = 'E';
                        }

                        if (grep {$_ eq $rtag_id} @excludeReleases) {
                            $Releases{$rtag_id}{excluded} = 'E';
                        }
                    }

                    if ( $doIncludeOnly )
                    {

                        if (grep {$_ eq $proj_id} @includedProjects)
                        {
                            delete $Releases{$rtag_id}{excluded};
                        }
                        else
                        {
                            $Releases{$rtag_id}{excluded} = 'E';
                        }

                        if (grep {$_ eq $rtag_id} @includedReleases)
                        {
                            delete $Releases{$rtag_id}{excluded};
                        }
                    }

                    unshift @row, $Releases{$rtag_id}{excluded} || ' ';
                    print join (',',@row), "\n" if ($opt_verbose);
                }
            }
#            print "--- Finish\n";
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}


sub getPkgDetailsByPVID
{
    my ($pv_id) = @_;
    my (@row);

    #
    #   Only do once
    #
    return if ( exists $Packages{$pv_id}{name} );
    
    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    my $m_sqlstr = "SELECT" .
                        " pv.PV_ID, ".                                          #[0]
                        " pkg.PKG_NAME, ".                                      #[1]
                        " pv.PKG_VERSION, ".                                    #[2]
                        " pv.DLOCKED," .                                        #[3]
                        " release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), ". #[4]
                        " pv.PKG_ID," .                                         #[5]
                        " pv.MODIFIED_STAMP  ".                                 #[6]
                   " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
                   "      RELEASE_MANAGER.PACKAGES pkg ".
                   " WHERE pv.PV_ID = \'$pv_id\' ".
                   "   AND pv.PKG_ID = pkg.PKG_ID" ;
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
#            print "--- Execute\n";
            if ( $sth->rows )
            {
#                print "--- Execute ROWS\n";
                while ( @row = $sth->fetchrow_array )
                {
                    print join (',',@row), "\n" if ($opt_verbose);

                    my $pvid = $row[0];
                    $Packages{$pvid}{name} = $row[1];
                    $Packages{$pvid}{version} = $row[2];
                    $Packages{$pvid}{locked} = $row[3];
                    $row[4] =~ tr~\\/~/~;
                    $Packages{$pvid}{vcstag} = $row[4];
                    $Packages{$pvid}{pkgid} = $row[5];
#                    $Packages{$pvid}{tlp} = 1;
                    ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );
                    $Suffixes{$Packages{$pvid}{suffix}}++;
                    $Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);
                }
            }
#            print "--- Finish\n";
            $sth->finish();
        }
        else
        {
            Error("getPkgDetailsByPVID:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("getPkgDetailsByPVID:Prepare failure" );
    }
}


sub getPkgDetailsByRTAG_ID
{
    my (@row);
    my $excludes = '';
    my $count = 0;

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    Message ("Extract toplevel dependencies");

    # First get all packages that are referenced in a Release
    # This will only get the top level packages
    # From non-archived releases

    unless ($doAllReleases)
    {
        foreach  ( @excludeProjects )
        {
            $excludes .= " AND prj.PROJ_ID != $_ ";
        }
        foreach  ( @excludeReleases )
        {
            $excludes .= " AND rt.RTAG_ID != $_ ";
        }
    }

    my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.DLOCKED" .
                   "    , release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), pv.PKG_ID" .
                   "    , rt.RTAG_ID, rmv.VIEW_NAME, pv.MODIFIED_STAMP, prj.PROJ_ID" .
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv,".
                   "      RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .
                   "    , release_manager.views rmv" .
                   " WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .
                   "   AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .
                   "   AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .
#                   "   AND rt.official != 'A'" .
#                   "   AND rt.official != 'Y' " .
                   $excludes .
                   " order by pkg.PKG_NAME";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
#            print "--- Execute\n";
            if ( $sth->rows )
            {
#                print "--- Execute ROWS\n";
                while ( @row = $sth->fetchrow_array )
                {
                    print join (',',@row), "\n" if ($opt_verbose);
                    my $pvid = $row[0];
                    unless ( exists $Packages{$pvid}{name} )
                    {
                        $Packages{$pvid}{name} = $row[1];
                        $Packages{$pvid}{version} = $row[2];
                        $Packages{$pvid}{locked} = $row[3];
                        $row[4] =~ tr~\\/~/~;
                        $Packages{$pvid}{vcstag} = $row[4];
                        $Packages{$pvid}{pkgid} = $row[5];
                        $Packages{$pvid}{tlp} = 1;
                        ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );
                        $Suffixes{$Packages{$pvid}{suffix}}++;

                        push @StrayPackages, $pvid;
                    }

                    my $rtag_id = $row[6];
                    push @{$Packages{$pvid}{release}}, $rtag_id;
                    $Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );

                    $Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);

                    my $proj_id = $row[9];
                    push @{$Packages{$pvid}{projects}}, $proj_id
                        unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});

                    if ( $doIncludeOnly )
                    {
                        if (grep {$_ eq $proj_id} @includedProjects)
                        {
                            $Packages{$pvid}{NamedProject} = 1;
                        }
                        if (grep {$_ eq $rtag_id} @includedReleases)
                        {
                            $Packages{$pvid}{NamedProject} = 2;
                        }
                    }
                    else
                    {
                        $Packages{$pvid}{NamedProject} = 3;
                    }


                    if ( $opt_limit )
                    {
                        last if ( $count++ > $opt_limit );
                    }
                }
            }
#            print "--- Finish\n";
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     :
#
# Inputs          : $pvid
#
# Returns         :
#
sub GetDepends
{
    my ($pv_id ) = @_;

    #
    #   Ensure we have package information
    #
    getPkgDetailsByPVID( $pv_id );
    return if ( $Packages{$pv_id}{depend} );
    $Packages{$pv_id}{depend} = 1;

    #
    #   Now extract the package dependacies
    #   There may not be any
    #
    my $m_sqlstr = "SELECT ".
                    " pd.PV_ID, ".
                    " pd.DPV_ID " .
                  " FROM    RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".
                  " WHERE pd.PV_ID = \'$pv_id\'";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( my @row = $sth->fetchrow_array )
                {
                    my $pvid = $row[0];
                    my $dpvid = $row[1];
                    push @StrayPackages, $dpvid;
                    push @{$Packages{$dpvid}{usedBy}}, $pvid;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetAllPackageNames
#
# Description     :
#
# Inputs          : None
#
# Returns         :
#
sub GetAllPackageNames
{
    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM(\$RM_DB) unless $RM_DB;

    #
    #   Now extract all the package names
    #
    my $m_sqlstr = "SELECT pkg.PKG_ID, pkg.PKG_NAME" .
                  " FROM RELEASE_MANAGER.PACKAGES pkg";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( my @row = $sth->fetchrow_array )
                {
                    my $id = $row[0];
                    my $name = $row[1];
                    next unless ( $id );
                    $AllPackages{$id} = $name;
                }
            }
            $sth->finish();
        }
        else
        {
        Error("GetAllPackageNames:Execute failure" );
        }
    }
    else
    {
        Error("GetAllPackageNames:Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : massageVersion
#
# Description     : Process a version number and return usful bits
#
# Inputs          : Version Number
#                   Package Name - debug only
#
# Returns         : An array
#                       suffix
#                       multipart version string useful for text comparisons
#
sub massageVersion
{
    my ($version, $name) = @_;
    my ($major, $minor, $patch, $build, $suffix);
    my $result;
    my $buildVersion;
    my $isaRipple;
    my $isaWIP;
    $build = 0;

#print "--- $name, $version\n";
    $version =~ s~^_~~;
    $version =~ s~^\Q${name}\E_~~;

    #
    #   Pre-massage some silly ones
    #
    if ( exists $sillyVersions{$version} ) {
        $version = $sillyVersions{$version};
    }

    if ( $name eq 'ReleaseName' ) {
        $version =~ s~[a-z]~.~g;
        $version =~ s~\.+~.~g;
        $version =~ s~\.$~~g
    }

    #
    #   xxxxxxxxx.nnnn.cots
    #
    if ( $version =~ m~(.*)\.cots$~ ) {
        my $cots_base = $1;
        $suffix = '.cots';
        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )
        {
            $result = $1 . sprintf (".%4.4d", $2) . $suffix;
        }
        else
        {
            $result = $cots_base . '.0000.cots';
        }
    }
    #
    #   Convert version into full form for comparisions
    #       nnn.nnn.nnn.[p]nnn.xxx
    #       nnn.nnn.nnn.[p]nnn-xxx
    #       nnn.nnn.nnn-[p]nnn.xxx
    #       nnn.nnn.nnn-[p]nnn-xxx
    #       nnn.nnn.nnn[p]nnn-xxx
    #   Don't flag as ripples - they are patches
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = $4;
        $suffix = defined $6 ? ".$6" : '';
        $isaRipple = 0;
    }
    #
    #       nn.nnn.nnnnn.xxx
    #       nn.nnn.nnnnn-xxx
    #       nnn.nnn.nnnx.xxx
    #   Don't flag as ripples - they are patches
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        if ( length( $patch) >= 4 )
        {
            $build = substr( $patch, -3 ,3);
            $patch = substr( $patch,  0 ,length($patch)-3);
        }
        $suffix = defined $5 ? ".$5" : '';
    }

    #
    #       nnn.nnn.nnn
    #       nnn.nnn-nnn
    #       nnn.nnn_nnn
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $suffix = '';
    }

    #
    #       nnn.nnn.nnn.nnn
    #       nnn.nnn.nnn-nnn
    #       nnn.nnn.nnn_nnn
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = $4;
        $suffix = '';
        $isaRipple = 0;
    }
    

    #
    #       nnn.nnn
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = 0;
        $suffix = '';
    }
    #
    #       nnn.nnn.xxx
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = 0;
        $suffix = $3;
    }
    
    #
    #       nnn.nnn.nnnz
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = ord($4) - ord('a');
        $suffix = '.cots';
        $isaRipple = 0;
    }
    #
    #       ???REV=???
    #
    elsif ( $version =~ m~REV=~ ) {
        $suffix = '.cots';
        $result = $version . '.0000.cots';
    }

    #
    #   Wip Packages
    #   (nnnnnn).xxx
    #   Should be essential, but want to sort very low
    #
    elsif ($version =~ m~\((.*)\)(\..*)?~) {
        $suffix = $2 || '';
        $result = "000.000.000.000$suffix";
        $isaWIP = 1;
    }

    #
    #   !current
    #
    elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {
        $suffix = '';
        $result = "000.000.000.000$suffix";
        $isaWIP = 1;
    }
    
    #
    #   Also WIP: FINRUN.103649.BEI.WIP
    elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {
        $suffix = lc($1);
        $result = "000.000.000.000$suffix";
        $isaWIP = 1;
    }

    #
    #   Also ERGOFSSLS190100_015
    #   Don't flag as a ripple
    elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = $4;
        $suffix = $5 || '.sls';
        $isaRipple = 0;
    }
    
    #
    #   Stuff we don't yet handle
    #
    else  {
        Warning ("Unknown version number: $name,$version");
        $version =~ m~(\.\w+)$~;
        $suffix = $1 || '';
        $result = $version;
    }

    $isaRipple = ($build > 0) unless defined $isaRipple;
    unless ( $result )
    {
        # Major and minor of 99.99 are normally funny versions
        # Don't make important decisions on them
        #
        if (defined $major && defined $minor && $major == 99 && $minor == 99 )
        {
            $major = 0;
            $minor = 0;
            $patch = 0;
        }
        
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
        $buildVersion = [ $major, $minor, $patch, $build ];
    }

    $suffix = lc( $suffix );
    if ( exists $suffixFixup{$suffix} )
    {
        $suffix = $suffixFixup{$suffix} ;
    }

    return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );
}


#-------------------------------------------------------------------------------
# Function        : LocateStrays
#
# Description     :
#
# Inputs          :
#
# Returns         :
#
sub LocateStrays
{
    Message ("Locate indirectly referenced packages");
    while ( $#StrayPackages >= 0 )
    {
        my $pv_id = pop @StrayPackages;

        next if ( exists $Packages{$pv_id}{done} );
#print "... ",$#StrayPackages,"\n";
        GetDepends( $pv_id);
        $Packages{$pv_id}{done} = 1;
    }
}

#-------------------------------------------------------------------------------
# Function        : countPackages
#
# Description     : 
#
# Inputs          : 
#
# Returns         : Number of packages and number oof versions
#
sub countPackages
{
    my $v = 0;
    my $p = 0;
    my %names;

    foreach ( keys %Packages )
    {
        my $name = $Packages{$_}{name};
        next unless ( $name );
        $names{$name} = 1;
        $v++;
    }

    $p = keys %names;

    return $p,$v;

}

#-------------------------------------------------------------------------------
# Function        : processData
#
# Description     : Process data before its written out
#                       Remove a few packages that we do not want to now about
#                       Determine Reason that a version is in the list
#                       Finish taging packages in NamedProject
#
# Inputs          : 
#
# Returns         : 
#
sub processData
{
    foreach ( keys %Packages )
    {
        delete $Packages{$_}{done};
        next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );

        if ($Packages{$_}{name} eq 'Activestate Perl - Solaris')
        {
            delete $Packages{$_};
            next;
        }

        if ( $Packages{$_}{name} =~ m/^CSW/ || $Packages{$_}{name} =~ m/^Solaris$/)
        {
            delete $Packages{$_};
            next;
        }

        if ( $Packages{$_}{name} =~ m/^jats_/)
        {
            delete $Packages{$_};
            next;
        }

        #
        #   Determine why version is here
        #       tpl         - Top Level Package from a Release
        #       sbom        - Included because of an sbom
        #
        #       tplDepend   - Used by a TLP
        #       sbomDepend  - Used by an SBOM
        #
        #   Where there are multiple reasons for inclusion a tlp is more
        #   significant than a sbom
        #
        #
        if ( exists  $Packages{$_}{'tlp'}) {
            $Packages{$_}{Reason} = 'tlp';

        } elsif ( exists  $Packages{$_}{'sbomBase'}) {
            $Packages{$_}{Reason} = 'sbom';

        } elsif ( exists  $Packages{$_}{'sbomOsid'}) {
            $Packages{$_}{Reason} = 'sbom';

        } else {
            my $reason;
            my %usedBy;
            my @examineThese = @{$Packages{$_}{'usedBy'}};
            while ( @examineThese )
            {
                my $pvid = pop @examineThese;
                next if ( $usedBy{$pvid} );

                if ( exists $Packages{$pvid}{Reason}  )
                {
                    $reason = $Packages{$pvid}{Reason};

                } elsif ( exists  $Packages{$pvid}{'tlp'}) {
                    $reason = 'tlpDepend';
                    last;

                } elsif ( exists  $Packages{$pvid}{'sbomBase'}) {
                    $reason = 'sbomDepend';

                } elsif ( exists  $Packages{$pvid}{'sbomOsid'}) {
                    $reason = 'sbomDepend';
                }

                push @examineThese, @{$Packages{$pvid}{'usedBy'}}
                if (exists $Packages{$pvid}{'usedBy'});
            }

            if ( $reason )
            {
                $Packages{$_}{Reason} = $reason;
            }
            else
            {
                Message ("Don't know why I'm here: $_, $Packages{$_}{name} $Packages{$_}{'version'}");
            }
        }

        #
        #   Catch packages that are dependents of NamedProject's
        #
        if ( $doIncludeOnly )
        {
            if ( exists  $Packages{$_}{'sbomBase'} || exists  $Packages{$_}{'sbomOsid'} )
            {
                $Packages{$_}{NamedProject} = 4;
            }

            unless ( $Packages{$_}{NamedProject}  )
            {
                my $named;
                my %usedBy;

                if ( exists $Packages{$_}{'usedBy'})
                {
                    my @examineThese = @{$Packages{$_}{'usedBy'}};
                    while ( @examineThese )
                    {
                        my $pvid = pop @examineThese;
                        next if ( $usedBy{$pvid} );

                        if ( $Packages{$pvid}{NamedProject}  )
                        {
                            $named = 1;
                            last;
                        }

                        push @examineThese, @{$Packages{$pvid}{'usedBy'}}
                            if (exists $Packages{$pvid}{'usedBy'});
                    }
                    $Packages{$_}{NamedProject} = 5
                        if ( $named );
                }
#                else
#                {
#                    Warning("Not Named and not usedBy: $Packages{$_}{name} $Packages{$_}{'version'}");
#                }
            }
        }
        else
        {
            $Packages{$_}{NamedProject} = 6;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : outputData
#
# Description     : Write out data in a form to allow post processing
#
# Inputs          : 
#
# Returns         : 
#
sub outputData
{
    my $file = "cc2svn.raw.txt";
    Message ("Create: $file");
    my $fh = ConfigurationFile::New( $file );

    $fh->DumpData(
        "\n# Releases.\n#\n",
        "ScmReleases", \%Releases );

    $fh->DumpData(
        "\n# Packages.\n#\n",
        "ScmPackages", \%Packages );

    $fh->DumpData(
        "\n# Suffixes.\n#\n",
        "ScmSuffixes", \%Suffixes );

    $fh->DumpData(
        "\n# All Package Names.\n#\n",
        "ScmAllPackages", \%AllPackages );

#
#   Just for debug
#
    #
    #   Remove unused SBOMs
    #
    my %AllBomProjects;
    foreach ( keys %sboms )
    {
        if ( $sboms{$_}{needed} )
        {
            my $project_id =  $sboms{$_}{project_id};
            $AllBomProjects{$project_id}{project_name} = $sboms{$_}{project_name};
            next;
        }
        delete $sboms{$_};
    }

    $fh->DumpData("\n# All Bom Projects.\n#\n", "ScmAllBomProjects", \%AllBomProjects );
    $fh->DumpData("\n# All SBOMS.\n#\n", "ScmSboms", \%sboms );

    $fh->DumpData("\n# All os_id_list.\n#\n", "ScmOsIdList", \%os_id_list );
    $fh->DumpData("\n# All os_env_list.\n#\n", "ScmOsEnvList", \%os_env_list );
    $fh->DumpData("\n# All sbom_pvid.\n#\n", "ScmSbomPVID", \%sbom_pvid );
        
    #
    #   Close out the file
    #
    $fh->Close();

#    #
#    #   Split up package data into small files for easy consumption
#    #
#
#    foreach ( keys %Packages )
#    {
#        my $file = "cc2svn.raw.${_}.txt";
#        Message ("Create: $file");
#        my $fh = ConfigurationFile::New( $file );
#
#        $fh->DumpData(
#            "\n# Releases.\n#\n",
#            "ScmReleases", \$Packages{$_} );
#        $fh->Close();
#    }
    
}


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

=pod

=for htmltoc    SYSUTIL::cc2svn::

=head1 NAME

cc2svn_gendata - Extract CC2SVN Essential Package Data from Release Manager

=head1 SYNOPSIS

  jats cc2svn_gendata [options]

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -test=version      - Test a version string, then exit
    -limit=n           - Limit packages processed. Test only
    -mode=xxx          - Set Mode: all, hops, standard
    -[no]sbom          - Include SBOM versions. Default: Yes

=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<-test=version>

Examine a package version string and report how the tool will parse it.

=item B<-limit=n>

Limit the number of packages processed by the tool. This is only used to
simplify testing of the program

=back

=head1 DESCRIPTION

This program is a tool used in the conversion of ClearCase VOBS to subversion.
It will:

=over 8

=item *

Determine all Releases in Release manager and mark those that
are to be excluded.

=item *

Determine all the package-versions used by the releases that are
not excluded. These are called 'direct' dependencies.

=item *

Recursively find all the dependent packages of all packages. New package
versions are called 'indirect' dependencies. They are buried. This process can
take several minutes.

=back

The data collected is dumped into a text file for later processing.

=cut