WebSVN – DevTools – Blame – /core_devl/trunk/TOOLS/LOCAL/cc2svn_gendata_sbom.pl

Rev	Author	Line No.	Line
394	dpurdie	1	`########################################################################`
6177	dpurdie	2	`# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.`
394	dpurdie	3	`#`
1197	dpurdie	4	`# Module name : cc2svn_gendata_sbom.pl`
394	dpurdie	5	`# Module type : Makefile system`
		6	`# Compiler(s) : Perl`
		7	`# Environment(s): jats`
		8	`#`
		9	`# Description : Get all packages that are used in all releases`
		10	`# Create a data file that can be used offline`
		11	`#`
		12	`# The process will exclude some old releases`
		13	`#`
		14	`# Generate data on Essential Package Versions to be`
		15	`# transferred from CC to Subversion`
		16	`#`
		17	`#......................................................................#`
		18
		19	`require 5.006_001;`
		20	`use strict;`
		21	`use warnings;`
		22	`use JatsError;`
		23	`use JatsSystem;`
		24	`use Getopt::Long;`
		25	`use Pod::Usage; # required for help support`
		26	`use JatsRmApi;`
		27	`use ConfigurationFile;`
		28
		29	`use DBI;`
		30	`use HTTP::Date;`
		31
		32	`my $VERSION = "1.2.3"; # Update this`
		33	`my $opt_verbose = 0;`
		34	`my $opt_help = 0;`
		35	`my $opt_manual;`
		36	`my $opt_test;`
		37	`my $opt_limit;`
		38	`my $opt_quick;`
		39	`my $opt_mode = '';`
404	dpurdie	40	`my $opt_sbom = 0;`
394	dpurdie	41	`my $RM_DB;`
		42	`my $DM_DB;`
		43	`my $now = time();`
		44
		45	`#`
		46	`# Package information`
		47	`#`
		48	`my %Releases;`
		49	`my %Packages;`
		50	`my %Suffixes;`
		51	`my @StrayPackages;`
		52	`my %AllPackages;`
		53
		54	`my %sboms;`
		55	`my %os_id_list;`
		56	`my %os_env_list;`
		57	`my %sbom_pvid;`
395	dpurdie	58	`my @sbomNeeded;`
394	dpurdie	59
		60	`my $doAllReleases = 0;`
		61	`my $doIncludeOnly = 1;`
		62	`my @includedProjects = (`
		63	`# 481, # UK BUS HOPS`
		64	`);`
		65
		66	`my @includedReleases = (`
		67	`6222, # HOME > UK STAGE COACH (SSW) > Mainline`
		68	`14503, # HOME > UK STAGE COACH (SSW) > ITSO_HOPS_3`
		69	`21303, # HOME > UK STAGE COACH (SSW) > SUPPORT_HOPS_REPORTS`
		70	`21343, # HOME > UK STAGE COACH (SSW) > SUPPORT_CIPP`
		71	`17223, # HOME > UK STAGE COACH (SSW) > ITSO HOPS 4`
		72	`);`
		73
		74
		75	`my @excludeProjects = ( 162, # WASHINGTON (WDC)`
		76	`341, # TUTORIAL (TUT)`
		77	`142, # SYDNEY (SYD)`
		78	`182 , # ROME (ROM)`
		79	`6 , # GMPTE/PCL (GMP)`
		80	`521, # NSW CLUB CARD`
		81	`221, # NZ STAGE COACH (NZS)`
395	dpurdie	82	`82, # LVS`
		83	`42, # SFO`
		84	`641, # BCC Releaeses`
		85	`62, # OSLO`
		86	`4, # Singapore`
		87	`441, # Tas`
		88	`102, # Ventura`
394	dpurdie	89	`);`
		90	`my @excludeReleases = ( 20424, # MASS_REF (MAS) > test`
395	dpurdie	91	`# RJACK 9043, # TECHNOLOGY GROUP > Development Environment - For Test Setup`
		92	`# RJACK 14383, # TECHNOLOGY GROUP > eBrio TDS`
		93	`# RJACK 20463, # TECHNOLOGY GROUP > TPIT - BackOffice Linux build`
		94	`# RJACK 14603, # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]`
394	dpurdie	95	`#9263, # TECHNOLOGY GROUP > Buildtool DEVI&TEST`
		96	`22163, # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey`
		97	`19483, # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]`
		98	`20403, # SEATTLE (SEA) > Phase 2 - I19 [backup]`
		99	`20983, # ??? May have been deleted`
395	dpurdie	100	`13083, # TECHNOLOGY GROUP > TRACS`
		101	`15224, # 64Bit Solaris Test`
		102
394	dpurdie	103	`);`
		104
		105	`my @excludeBomProjects = (`
		106	`4, # SINGAPORE (SG)`
		107	`6, # GMPTE/PCL (GMP)`
		108	`42, # SAN FRANCISCO (SFO)`
		109	`62, # OSLO (OSO)`
		110	`82, # LAS VEGAS (LVS)`
		111	`102, # VENTURA (VC)`
404	dpurdie	112	`# 122, # VASTTRAFIK (VTK)`
394	dpurdie	113	`142, # SYDNEY (SYD)`
		114	`162, # WASHINGTON (WDC)`
404	dpurdie	115	`# 164, # SEATTLE (SEA)`
394	dpurdie	116	`182, # ROME (ROM)`
404	dpurdie	117	`# 202, # STOCKHOLM (SLS)`
		118	`# 221 # NZ STAGE COACH (NZS)`
		119	`# 261 # VÄSTTRAFIK PRODUCTION (VTProd)`
		120	`# 301 # BEIJING (BEI)`
394	dpurdie	121	`321, # SAN FRANCISCO PRODUCTION (SFOProd)`
404	dpurdie	122	`# 361 # UK STAGE COACH (SSW) Historical`
		123	`# 401 # SEATTLE INTEGRATION (SEA Int)`
		124	`# 421 # UK STAGE COACH PRODUCTION (SSWProd)`
394	dpurdie	125	`441, # COTRAL`
		126	`461, # TASMANIA DEMO (MFCS)`
404	dpurdie	127	`# 481 # TECHNOLOGY GROUP`
		128	`# 501 # UK Certification (UKCert)`
		129	`# 503 # UK SOUTHWEST TRAINS (SWT)`
		130	`# 521 # UKSP`
		131	`# 541 # UK BUS HOPS (SBH)`
		132	`# 561 # NSW Club Card (NCC)`
		133	`# 581 # UK Projects`
		134	`# 601 # GLOBAL PRODUCT MGMT(GPM)`
394	dpurdie	135	`621, # NEW DEHLI (NDL)`
404	dpurdie	136	`# 641 # TRACS Projects`
		137	`# 701 # BANGKOK (BKK)`
		138	`# 721, # CAPE TOWN`
394	dpurdie	139	`);`
		140
		141	`my @includeBomProjects = (`
		142	`361, # UK STAGE COACH (SSW) Historical`
		143	`421, # UK STAGE COACH PRODUCTION (SSWProd)`
		144	`501, # UK Certification (UKCert)`
		145	`503, # UK SOUTHWEST TRAINS (SWT)`
		146	`521, # UKSP`
		147	`541, # UK BUS HOPS (SBH)`
		148	`581, # UK Projects`
		149	`641, # TRACS Projects`
		150	`);`
		151
		152
		153	`my %sillyVersions =`
		154	`(`
		155	`'2b6' => '2.6.0.cots',`
		156	`'1.0b2' => '1.0.2.cots',`
		157	`'1.6.x' => '1.6.0.cots',`
		158	`'3.5beta12.5' => '3.5.12.5.cots',`
395	dpurdie	159	`'1.0b1.1.mas' => '1.1.1.mas',`
394	dpurdie	160	`);`
		161
		162	`my %suffixFixup = (`
		163	`'.sf' => '.sfo',`
		164	`'.vt' => '.vtk',`
		165	`'.lv' => '.lvs',`
		166	`'.was' => '.wdc',`
		167	`'.uk.1' => '.uk',`
		168	`'.ssts.demo' => '.ssts',`
		169	`'.u244.syd' => '.syd',`
		170	`'.pxxx.sea' => '.sea',`
		171	`'.pxxx.syd' => '.syd',`
		172	`'.pxxx.sydddd' => '.syd',`
		173	`'.oslo' => '.oso',`
		174	`);`
		175
		176	`#-------------------------------------------------------------------------------`
		177	`# Function : Main Entry`
		178	`#`
		179	`# Description :`
		180	`#`
		181	`# Inputs :`
		182	`#`
		183	`# Returns :`
		184	`#`
		185	`my $result = GetOptions (`
		186	`"help+" => \$opt_help, # flag, multiple use allowed`
		187	`"manual" => \$opt_manual, # flag`
		188	`"verbose+" => \$opt_verbose, # flag`
		189	`"test:s" => \$opt_test, # Test a version string`
		190	`"limit:n" => \$opt_limit, #`
		191	`"quick" => \$opt_quick, # Don't look for indirects`
		192	`'mode:s' => \$opt_mode, # Mode of operation`
395	dpurdie	193	`'sbom!' => \$opt_sbom, # Include Sboms`
394	dpurdie	194	`);`
		195
		196	`#`
		197	`# Process help and manual options`
		198	`#`
		199	`pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 \|\| ! $result);`
		200	`pod2usage(-verbose => 1) if ($opt_help == 2 );`
		201	`pod2usage(-verbose => 2) if ($opt_manual \|\| ($opt_help > 2));`
		202	`ErrorConfig( 'name' =>'CC2SVN_GENDATA' );`
		203
		204	`if ( $opt_test )`
		205	`{`
		206	`my @results = massageVersion( $opt_test, 'DummyName' );`
		207	`Message ("Version", $opt_test, @results);`
		208	`exit 1;`
		209	`}`
		210
		211	`#`
		212	`# Set up the mode`
		213	`# Must be specified`
		214	`#`
		215	`if ( $opt_mode eq 'all' ) {`
		216	`$doAllReleases = 1;`
		217	`$doIncludeOnly = 0;`
		218
		219	`} elsif ( $opt_mode eq 'hops' ) {`
		220	`$doAllReleases = 0;`
		221	`$doIncludeOnly = 1;`
		222
		223	`} elsif ( $opt_mode eq 'standard' ) {`
		224	`$doAllReleases = 0;`
		225	`$doIncludeOnly = 0;`
		226
		227	`} else {`
		228	`Error ("Mode not specified: all, hops, standard");`
		229	`}`
		230
		231	`#`
		232	`# Extract information from Deployment Manager`
		233	`#`
395	dpurdie	234	`if ( $opt_sbom )`
394	dpurdie	235	`{`
395	dpurdie	236	`Message ("Get BOMs");`
		237	`getBoms();`
		238
		239	`Message ("Get SBOM Info");`
		240	`getOSIDforBOMID($_) foreach keys %sboms;`
		241
		242	`Message ("SBOMs : " . scalar @sbomNeeded);`
		243	`Message ("get SBOM Details");`
		244	`getSBOMDetails($_) foreach ( @sbomNeeded );`
		245
		246	`#`
		247	`# Locate packages associated with the base install for each os`
		248	`#`
		249	`Message ("get Base Install Packages");`
		250	`foreach my $base_env_id ( sort keys %os_env_list )`
		251	`{`
		252	`getPackagesforBaseInstall( $base_env_id );`
		253	`}`
		254
		255	`#`
		256	`# Determine all the top level packages in the BOM`
		257	`#`
		258	`Message ("get Top Level BOM Packages");`
		259	`foreach my $os_id ( sort keys %os_id_list )`
		260	`{`
		261	`getPackages_by_osid( $os_id );`
		262	`}`
		263	`Message ("SBOM PackageVersions : " . scalar keys %sbom_pvid);`
		264	`#DebugDumpData("PVID", \%sbom_pvid );`
394	dpurdie	265	`}`
395	dpurdie	266	`else`
394	dpurdie	267	`{`
395	dpurdie	268	`Message ("SBOM Information not included");`
394	dpurdie	269	`}`
		270	`GetAllPackageNames();`
		271	`getReleaseDetails();`
		272	`getPkgDetailsByRTAG_ID();`
395	dpurdie	273	`my ($pcount, $vcount) = countPackages();`
		274	`print "Directly referenced Packages: $pcount Versions: $vcount\n";`
394	dpurdie	275	`LocateStrays() unless ($opt_quick);`
395	dpurdie	276	`($pcount, $vcount) = countPackages();`
		277	`print "Indirectly referenced Packages: $pcount Versions: $vcount\n";`
396	dpurdie	278	`processData();`
394	dpurdie	279	`outputData();`
		280
		281	`if ( $opt_verbose > 1 )`
		282	`{`
		283	`print "=========================================================================\n";`
		284	`DebugDumpData("Releases", \%Releases);`
		285	`print "=========================================================================\n";`
		286	`DebugDumpData("Packages", \%Packages );`
		287	`print "=========================================================================\n";`
		288	`DebugDumpData("Suffixes", \%Suffixes );`
		289	`}`
		290
395	dpurdie	291	`($pcount, $vcount) = countPackages();`
		292	`print "Total References Packages: $pcount Versions: $vcount\n";`
394	dpurdie	293	`exit;`
		294
		295
		296	`#-------------------------------------------------------------------------------`
		297	`# Function : getBoms`
		298	`#`
		299	`# Description : Get all the BOM Id's and parent project IDs`
		300	`# Also get base_env_id's where they exist`
		301	`#`
		302	`# Inputs :`
		303	`#`
		304	`# Returns :`
		305	`#`
		306	`sub getBoms`
		307	`{`
		308	`my $foundDetails = 0;`
		309	`my (@row);`
		310	`Verbose ("getBoms");`
		311	`connectDM(\$DM_DB) unless ($DM_DB);`
		312
		313	`my $m_sqlstr = "SELECT ".`
		314	`"p.PROJ_ID,".`
		315	`"p.PROJ_NAME,".`
		316	`"br.BRANCH_ID,".`
		317	`"bm.BOM_ID".`
		318	`" FROM DEPLOYMENT_MANAGER.DM_PROJECTS p, " .`
		319	`"DEPLOYMENT_MANAGER.BRANCHES br, ".`
		320	`"DEPLOYMENT_MANAGER.BOMS bm ".`
		321	`" WHERE p.PROJ_ID = br.PROJ_ID ".`
		322	`"AND br.BRANCH_ID = bm.BRANCH_ID";`
		323
		324	`my $sth = $DM_DB->prepare($m_sqlstr);`
		325	`if ( defined($sth) )`
		326	`{`
		327	`if ( $sth->execute( ) )`
		328	`{`
		329	`if ( $sth->rows )`
		330	`{`
		331	`while ( @row = $sth->fetchrow_array )`
		332	`{`
		333	`#print "----@row\n";`
		334	`my $project_id = $row[0];`
		335	`my $name = $row[1];`
		336	`my $bom_id = $row[3];`
		337
395	dpurdie	338	`if ( exists $sboms{$bom_id} )`
394	dpurdie	339	`{`
		340	`print "---- BAD: Multiple BOM IDS\n";`
		341	`}`
		342
395	dpurdie	343	`$sboms{$bom_id}{project_id} = $project_id;`
		344	`$sboms{$bom_id}{project_name} = $name;`
394	dpurdie	345	`$foundDetails = 1;`
		346	`}`
		347	`}`
		348	`$sth->finish();`
		349	`}`
		350	`else`
		351	`{`
		352	`Error("getBoms:Execute failure: $m_sqlstr" );`
		353	`}`
		354	`}`
		355	`else`
		356	`{`
		357	`Error("getBoms:Prepare failure" );`
		358	`}`
		359
		360	`Warnng("getBoms:No BOM Information Found" ) unless $foundDetails;`
		361
395	dpurdie	362	`# DebugDumpData("sboms", \%sboms );`
394	dpurdie	363	`}`
		364	`#-------------------------------------------------------------------------------`
		365	`# Function : getOSIDforBOMID`
		366	`#`
		367	`# Description : Get all the os_id's associated with a BOMID`
		368	`# Also get base_env_id's where they exist`
		369	`#`
		370	`# Inputs : $bom_id - BOM to process`
		371	`#`
		372	`# Returns :`
		373	`#`
		374	`sub getOSIDforBOMID`
		375	`{`
		376	`my ($bom_id) = @_;`
		377	`my $foundDetails = 0;`
		378	`my (@row);`
404	dpurdie	379	`print("getOSIDforBOMID: $bom_id\n");`
		380	`Verbose ("getOSIDforBOMID: $bom_id");`
394	dpurdie	381	`connectDM(\$DM_DB) unless ($DM_DB);`
		382
395	dpurdie	383	`my $project_id = $sboms{$bom_id}{project_id};`
394	dpurdie	384	`#print "getOSIDforBOMID: $bom_id, $project_id\n";`
		385	`if ( $doIncludeOnly )`
		386	`{`
		387	`unless ( grep {$_ eq $project_id} @includeBomProjects)`
		388	`{`
404	dpurdie	389	`#print "Ignoring $bom_id, $project_id\n";`
394	dpurdie	390	`return;`
		391	`}`
		392	`}`
		393	`else`
		394	`{`
		395	`if ( grep {$_ eq $project_id} @excludeBomProjects)`
		396	`{`
		397	`#print "Ignoring $bom_id\n";`
		398	`return;`
		399	`}`
		400	`}`
		401
395	dpurdie	402	`#`
		403	`# Save for later`
		404	`#`
		405	`push @sbomNeeded, $bom_id;`
404	dpurdie	406	`#print "Processing getOSIDforBOMID: $bom_id, $project_id\n";`
395	dpurdie	407
394	dpurdie	408	`my $m_sqlstr = "SELECT distinct bc.BOM_ID, os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .`
		409	`" FROM DEPLOYMENT_MANAGER.OPERATING_SYSTEMS os, " .`
		410	`"DEPLOYMENT_MANAGER.BOM_CONTENTS bc, ".`
		411	`"DEPLOYMENT_MANAGER.NETWORK_NODES nn, ".`
		412	`"DEPLOYMENT_MANAGER.OS_BASE_ENV obe" .`
		413	`" WHERE bc.BOM_ID = $bom_id ".`
		414	`"AND bc.NODE_ID = os.NODE_ID ".`
		415	`"AND nn.NODE_ID = os.NODE_ID ".`
		416	`"AND obe.OS_ID (+) = os.OS_ID ";`
		417
		418	`my $sth = $DM_DB->prepare($m_sqlstr);`
		419	`if ( defined($sth) )`
		420	`{`
		421	`if ( $sth->execute( ) )`
		422	`{`
		423	`if ( $sth->rows )`
		424	`{`
		425	`while ( @row = $sth->fetchrow_array )`
		426	`{`
		427	`#print "----@row\n";`
		428	`Verbose ("OS_ID: ".join (',',@row) );`
		429	`$sboms{$row[0]}{needed} = 1;`
		430	`$os_id_list{$row[1]}{bom_id} = $row[0];`
		431	`$os_id_list{$row[1]}{os_name} = $row[2];`
		432	`$os_id_list{$row[1]}{node_name} = $row[3];`
		433
		434	`if ( defined $row[4] )`
		435	`{`
		436	`$os_env_list{$row[4]}{needed} = 1;`
		437	`$os_env_list{$row[4]}{os_id}{$row[1]} = 1;`
		438	`}`
		439
		440	`$foundDetails = 1;`
		441	`}`
		442	`}`
		443	`$sth->finish();`
		444	`}`
		445	`else`
		446	`{`
		447	`Error("getOSIDforBOMID:Execute failure" );`
		448	`}`
		449	`}`
		450	`else`
		451	`{`
		452	`Error("getOSIDforBOMID:Prepare failure" );`
		453	`}`
		454
		455	`Warning("getOSIDforBOMID:No OS Information Found: Project:$project_id BOM:$bom_id" ) unless $foundDetails;`
		456
		457	`}`
		458
		459	`#-------------------------------------------------------------------------------`
		460	`# Function : getSBOMDetails`
		461	`#`
		462	`# Description : Get some details about the SBOM`
		463	`# Used for descriptive text`
		464	`#`
		465	`# Inputs : $bom_id - BOM to process`
		466	`#`
		467	`# Returns :`
		468	`#`
		469	`sub getSBOMDetails`
		470	`{`
		471	`my ($bom_id) = @_;`
		472	`my $foundDetails = 0;`
		473	`my (@row);`
		474
		475	`Verbose ("getSBOMDetails: $bom_id");`
		476	`connectDM(\$DM_DB) unless ($DM_DB);`
		477
404	dpurdie	478	`my $m_sqlstr = "SELECT distinct ".`
		479	`" dp.PROJ_NAME ,".`
		480	`" bn.BOM_NAME, ".`
		481	`" br.BRANCH_NAME, ".`
		482	`" bm.BOM_VERSION, ".`
		483	`" bm.BOM_LIFECYCLE" .`
		484	`" FROM ".`
		485	`" DEPLOYMENT_MANAGER.BOMS bm, ".`
		486	`" DEPLOYMENT_MANAGER.BOM_NAMES bn, ".`
		487	`" DEPLOYMENT_MANAGER.BRANCHES br, ".`
		488	`" DEPLOYMENT_MANAGER.DM_PROJECTS dp" .`
		489	`" WHERE bm.BOM_ID = $bom_id ".`
		490	`" AND bm.BOM_NAME_ID = bn.BOM_NAME_ID ".`
		491	`" AND bm.BRANCH_ID = br.BRANCH_ID ".`
		492	`" AND br.PROJ_ID = dp.PROJ_ID";`
394	dpurdie	493
		494	`my $sth = $DM_DB->prepare($m_sqlstr);`
		495	`if ( defined($sth) )`
		496	`{`
		497	`if ( $sth->execute( ) )`
		498	`{`
		499	`if ( $sth->rows )`
		500	`{`
		501	`while ( @row = $sth->fetchrow_array )`
		502	`{`
395	dpurdie	503	`# $sboms{$bom_id}{sbom_project} = $row[0];`
394	dpurdie	504	`$sboms{$bom_id}{sbom_name} = $row[1];`
		505	`$sboms{$bom_id}{sbom_branch} = $row[2];`
		506	`$sboms{$bom_id}{sbom_version} = $row[3] . '.' . $row[4];`
		507	`$foundDetails = 1;`
		508	`}`
		509	`}`
		510	`$sth->finish();`
		511	`}`
		512	`else`
		513	`{`
		514	`Error("getSBOMDetails:Execute failure", $m_sqlstr );`
		515	`}`
		516	`}`
		517	`else`
		518	`{`
		519	`Error("getSBOMDetails:Prepare failure" );`
		520	`}`
		521
		522	`Error("getSBOMDetails:No OS Information Found" ) unless $foundDetails;`
		523
		524	`}`
		525
		526	`#-------------------------------------------------------------------------------`
		527	`# Function : getPackagesforBaseInstall`
		528	`#`
		529	`# Description : Get all the packages for a given base install`
		530	`#`
		531	`# Inputs :`
		532	`#`
		533	`# Returns :`
		534	`#`
		535
		536	`sub getPackagesforBaseInstall`
		537	`{`
		538	`my ($base_env_id) = @_;`
		539	`my $foundDetails = 0;`
		540	`my (@row);`
		541
		542	`connectDM(\$DM_DB) unless ($DM_DB);`
		543
		544	`# First get details from pv_id`
		545
404	dpurdie	546	`my $m_sqlstr = "SELECT DISTINCT ".`
		547	`" bec.PROD_ID, ".`
		548	`" pkg.pkg_name, ".`
		549	`" pv.pkg_version, ".`
		550	`" pkg.pkg_id, ".`
		551	`" pv.pv_id" .`
		552	`" FROM ".`
		553	`" RELEASE_MANAGER.PACKAGES pkg, ".`
		554	`" RELEASE_MANAGER.PACKAGE_VERSIONS pv, ".`
		555	`# " DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd, ".`
		556	`" DEPLOYMENT_MANAGER.BASE_ENV_CONTENTS bec".`
		557	`" WHERE bec.BASE_ENV_ID = $base_env_id ".`
		558	`" AND bec.PROD_ID (+)= pv.PV_ID ".`
		559	`" AND pv.pkg_id = pkg.pkg_id";`
394	dpurdie	560
		561	`my $sth = $DM_DB->prepare($m_sqlstr);`
		562	`if ( defined($sth) )`
		563	`{`
		564	`if ( $sth->execute( ) )`
		565	`{`
		566	`if ( $sth->rows )`
		567	`{`
		568	`while ( @row = $sth->fetchrow_array )`
		569	`{`
		570	`Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );`
		571
		572	`my $pv_id = $row[0];`
		573	`my $name = $row[1] \|\| 'BadName';`
		574	`my $ver = $row[2] \|\| 'BadVer';`
		575
		576	`$sbom_pvid{$pv_id}{pkg_name} =$name;`
		577	`$sbom_pvid{$pv_id}{pkg_ver} = $ver;`
		578
404	dpurdie	579	`push @{$Packages{$pv_id}{sbomBase}}, $base_env_id;`
		580
394	dpurdie	581	`push @StrayPackages, $pv_id;`
		582
		583	`foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )`
		584	`{`
		585	`$sbom_pvid{$pv_id}{os_id}{$os_id} = 2;`
		586	`}`
		587	`}`
		588	`}`
		589	`$sth->finish();`
		590	`}`
		591	`else`
		592	`{`
		593	`Error ("getPackagesforBaseInstall: Execute error");`
		594	`}`
		595	`}`
		596	`else`
		597	`{`
		598	`Error("getPackagesforBaseInstall:Prepare failure" );`
		599	`}`
		600	`}`
		601
		602	`#-------------------------------------------------------------------------------`
		603	`# Function : getPackages_by_osid`
		604	`#`
		605	`# Description : Get all the packages used by a given os_id`
		606	`#`
		607	`# Inputs :`
		608	`#`
		609	`# Returns :`
		610	`#`
		611
		612	`sub getPackages_by_osid`
		613	`{`
		614	`my ($os_id) =@_;`
		615	`my $foundDetails = 0;`
		616	`my (@row);`
		617
		618	`connectDM(\$DM_DB) unless ($DM_DB);`
		619
		620	`# First get details from pv_id`
		621
404	dpurdie	622	`my $m_sqlstr = "SELECT osc.*, ".`
		623	`" pkg.pkg_name, ".`
		624	`" pv.pkg_version, ".`
		625	`" pd.IS_REJECTED, ".`
		626	`" pv.IS_PATCH,".`
		627	`" pv.IS_OBSOLETE, ".`
		628	`" pkg.pkg_id,".`
		629	`" pv.pv_id" .`
		630	`" FROM RELEASE_MANAGER.PACKAGES pkg, ".`
		631	`" RELEASE_MANAGER.PACKAGE_VERSIONS pv, ".`
		632	`" DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd,".`
394	dpurdie	633	`"(" .`
404	dpurdie	634	`" SELECT ".`
		635	`" osc.seq_num, ".`
		636	`" osc.prod_id".`
		637	`" FROM ".`
		638	`" DEPLOYMENT_MANAGER.os_contents osc".`
394	dpurdie	639	`" WHERE osc.os_id = $os_id" .`
		640	`" ) osc" .`
		641	`" WHERE pd.PROD_ID (+)= pv.PV_ID" .`
		642	`" AND pv.pkg_id = pkg.pkg_id" .`
		643	`" AND osc.PROD_ID = pv.pv_id" .`
		644	`" ORDER BY osc.SEQ_NUM desc" ;`
		645
		646	`my $sth = $DM_DB->prepare($m_sqlstr);`
		647	`if ( defined($sth) )`
		648	`{`
		649	`if ( $sth->execute( ) )`
		650	`{`
		651	`if ( $sth->rows )`
		652	`{`
404	dpurdie	653	`$foundDetails = 1;`
394	dpurdie	654	`while ( @row = $sth->fetchrow_array )`
		655	`{`
404	dpurdie	656	`print ("SBOM Package:".join (',',@row). "\n" );`
394	dpurdie	657	`Verbose ("SBOM Package:".join (',',@row) );`
		658	`my $pv_id = $row[8];`
		659	`unless ( exists $sbom_pvid{$pv_id} )`
		660	`{`
		661	`my $name = $row[2] \|\| 'BadName';`
		662	`my $ver = $row[3] \|\| 'BadVer';`
		663
		664	`$sbom_pvid{$pv_id}{pkg_name} =$name;`
		665	`$sbom_pvid{$pv_id}{pkg_ver} = $ver;`
		666
404	dpurdie	667	`push @{$Packages{$pv_id}{sbomOsidUsed}}, $os_id;`
394	dpurdie	668	`$Packages{$pv_id}{sbomOsid} = 1;`
		669	`push @StrayPackages, $pv_id;`
		670
		671
		672	`}`
		673	`$sbom_pvid{$pv_id}{os_id}{$os_id} = 1;`
		674	`}`
		675	`}`
		676	`$sth->finish();`
		677	`}`
		678	`}`
		679	`else`
		680	`{`
		681	`Error("getPackages_by_osid:Prepare failure" );`
		682	`}`
404	dpurdie	683
		684	`Error ("getPackages_by_osid: Nothing found for os_id: $os_id ")`
		685	`unless ( $foundDetails );`
394	dpurdie	686	`}`
		687
		688	`#-------------------------------------------------------------------------------`
		689	`# Function : getReleaseDetails`
		690	`#`
		691	`# Description : Determine all candiate releases`
		692	`#`
		693	`# Inputs :`
		694	`#`
		695	`# Returns :`
		696	`#`
		697	`sub getReleaseDetails`
		698	`{`
		699	`my (@row);`
		700
		701	`# if we are not or cannot connect then return 0 as we have not found anything`
		702	`connectRM(\$RM_DB) unless $RM_DB;`
		703
		704	`# First get all packages that are referenced in a Release`
		705	`# This will only get the top level packages`
		706	`# From non-archived releases`
		707
		708	`my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .`
		709	`" FROM release_manager.release_tags rt, release_manager.projects prj" .`
		710	`" WHERE prj.PROJ_ID = rt.PROJ_ID " .`
395	dpurdie	711	`# " AND rt.official != 'A' ".`
		712	`# " AND rt.official != 'Y'" .`
394	dpurdie	713	`" order by prj.PROJ_NAME";`
		714	`my $sth = $RM_DB->prepare($m_sqlstr);`
		715	`if ( defined($sth) )`
		716	`{`
		717	`if ( $sth->execute( ) )`
		718	`{`
		719	`# print "--- Execute\n";`
		720	`if ( $sth->rows )`
		721	`{`
		722	`# print "--- Execute ROWS\n";`
		723	`while ( @row = $sth->fetchrow_array )`
		724	`{`
		725	`my $rtag_id =$row[3];`
		726	`my $proj_id = $row[2];`
		727
		728	`$Releases{$rtag_id}{pName} = $row[0];`
		729	`$Releases{$rtag_id}{name} = $row[1];`
		730	`$Releases{$rtag_id}{proj_id} = $proj_id;`
		731	`$Releases{$rtag_id}{rtag_id} = $rtag_id;`
		732	`$Releases{$rtag_id}{official} = $row[4];`
		733
		734	`unless ( $doAllReleases )`
		735	`{`
		736	`if (grep {$_ eq $proj_id} @excludeProjects) {`
		737	`$Releases{$rtag_id}{excluded} = 'E';`
		738	`}`
		739
		740	`if (grep {$_ eq $rtag_id} @excludeReleases) {`
		741	`$Releases{$rtag_id}{excluded} = 'E';`
		742	`}`
		743	`}`
		744
		745	`if ( $doIncludeOnly )`
		746	`{`
		747
		748	`if (grep {$_ eq $proj_id} @includedProjects)`
		749	`{`
		750	`delete $Releases{$rtag_id}{excluded};`
		751	`}`
		752	`else`
		753	`{`
		754	`$Releases{$rtag_id}{excluded} = 'E';`
		755	`}`
		756
		757	`if (grep {$_ eq $rtag_id} @includedReleases)`
		758	`{`
		759	`delete $Releases{$rtag_id}{excluded};`
		760	`}`
		761	`}`
		762
		763	`unshift @row, $Releases{$rtag_id}{excluded} \|\| ' ';`
		764	`print join (',',@row), "\n" if ($opt_verbose);`
		765	`}`
		766	`}`
		767	`# print "--- Finish\n";`
		768	`$sth->finish();`
		769	`}`
		770	`else`
		771	`{`
		772	`Error("Execute failure: $m_sqlstr", $sth->errstr() );`
		773	`}`
		774	`}`
		775	`else`
		776	`{`
		777	`Error("Prepare failure" );`
		778	`}`
		779	`}`
		780
		781
		782	`sub getPkgDetailsByPVID`
		783	`{`
		784	`my ($pv_id) = @_;`
		785	`my (@row);`
		786
		787	`#`
		788	`# Only do once`
		789	`#`
		790	`return if ( exists $Packages{$pv_id}{name} );`
		791
		792	`# if we are not or cannot connect then return 0 as we have not found anything`
		793	`connectRM(\$RM_DB) unless $RM_DB;`
		794
		795	`my $m_sqlstr = "SELECT" .`
		796	`" pv.PV_ID, ". #[0]`
		797	`" pkg.PKG_NAME, ". #[1]`
		798	`" pv.PKG_VERSION, ". #[2]`
		799	`" pv.DLOCKED," . #[3]`
		800	`" release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), ". #[4]`
		801	`" pv.PKG_ID," . #[5]`
		802	`" pv.MODIFIED_STAMP ". #[6]`
		803	`" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".`
		804	`" RELEASE_MANAGER.PACKAGES pkg ".`
		805	`" WHERE pv.PV_ID = \'$pv_id\' ".`
		806	`" AND pv.PKG_ID = pkg.PKG_ID" ;`
		807	`my $sth = $RM_DB->prepare($m_sqlstr);`
		808	`if ( defined($sth) )`
		809	`{`
		810	`if ( $sth->execute( ) )`
		811	`{`
		812	`# print "--- Execute\n";`
		813	`if ( $sth->rows )`
		814	`{`
		815	`# print "--- Execute ROWS\n";`
		816	`while ( @row = $sth->fetchrow_array )`
		817	`{`
		818	`print join (',',@row), "\n" if ($opt_verbose);`
		819
		820	`my $pvid = $row[0];`
		821	`$Packages{$pvid}{name} = $row[1];`
		822	`$Packages{$pvid}{version} = $row[2];`
		823	`$Packages{$pvid}{locked} = $row[3];`
		824	`$row[4] =~ tr~\\/~/~;`
		825	`$Packages{$pvid}{vcstag} = $row[4];`
		826	`$Packages{$pvid}{pkgid} = $row[5];`
		827	`# $Packages{$pvid}{tlp} = 1;`
		828	`($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );`
		829	`$Suffixes{$Packages{$pvid}{suffix}}++;`
		830	`$Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);`
		831	`}`
		832	`}`
		833	`# print "--- Finish\n";`
		834	`$sth->finish();`
		835	`}`
		836	`else`
		837	`{`
		838	`Error("getPkgDetailsByPVID:Execute failure: $m_sqlstr", $sth->errstr() );`
		839	`}`
		840	`}`
		841	`else`
		842	`{`
		843	`Error("getPkgDetailsByPVID:Prepare failure" );`
		844	`}`
		845	`}`
		846
		847
		848	`sub getPkgDetailsByRTAG_ID`
		849	`{`
		850	`my (@row);`
		851	`my $excludes = '';`
		852	`my $count = 0;`
		853
		854	`# if we are not or cannot connect then return 0 as we have not found anything`
		855	`connectRM(\$RM_DB) unless $RM_DB;`
		856
		857	`Message ("Extract toplevel dependencies");`
		858
		859	`# First get all packages that are referenced in a Release`
		860	`# This will only get the top level packages`
		861	`# From non-archived releases`
		862
		863	`unless ($doAllReleases)`
		864	`{`
		865	`foreach ( @excludeProjects )`
		866	`{`
		867	`$excludes .= " AND prj.PROJ_ID != $_ ";`
		868	`}`
		869	`foreach ( @excludeReleases )`
		870	`{`
		871	`$excludes .= " AND rt.RTAG_ID != $_ ";`
		872	`}`
		873	`}`
		874
		875	`my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.DLOCKED" .`
		876	`" , release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), pv.PKG_ID" .`
		877	`" , rt.RTAG_ID, rmv.VIEW_NAME, pv.MODIFIED_STAMP, prj.PROJ_ID" .`
		878	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv,".`
		879	`" RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .`
		880	`" , release_manager.views rmv" .`
		881	`" WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .`
		882	`" AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .`
		883	`" AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .`
395	dpurdie	884	`# " AND rt.official != 'A'" .`
		885	`# " AND rt.official != 'Y' " .`
394	dpurdie	886	`$excludes .`
		887	`" order by pkg.PKG_NAME";`
		888	`my $sth = $RM_DB->prepare($m_sqlstr);`
		889	`if ( defined($sth) )`
		890	`{`
		891	`if ( $sth->execute( ) )`
		892	`{`
		893	`# print "--- Execute\n";`
		894	`if ( $sth->rows )`
		895	`{`
		896	`# print "--- Execute ROWS\n";`
		897	`while ( @row = $sth->fetchrow_array )`
		898	`{`
		899	`print join (',',@row), "\n" if ($opt_verbose);`
		900	`my $pvid = $row[0];`
		901	`unless ( exists $Packages{$pvid}{name} )`
		902	`{`
		903	`$Packages{$pvid}{name} = $row[1];`
		904	`$Packages{$pvid}{version} = $row[2];`
		905	`$Packages{$pvid}{locked} = $row[3];`
		906	`$row[4] =~ tr~\\/~/~;`
		907	`$Packages{$pvid}{vcstag} = $row[4];`
		908	`$Packages{$pvid}{pkgid} = $row[5];`
		909	`$Packages{$pvid}{tlp} = 1;`
		910	`($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );`
		911	`$Suffixes{$Packages{$pvid}{suffix}}++;`
		912
		913	`push @StrayPackages, $pvid;`
		914	`}`
		915
		916	`my $rtag_id = $row[6];`
		917	`push @{$Packages{$pvid}{release}}, $rtag_id;`
		918	`$Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );`
		919
		920	`$Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);`
		921
		922	`my $proj_id = $row[9];`
396	dpurdie	923	`push @{$Packages{$pvid}{projects}}, $proj_id`
		924	`unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});`
394	dpurdie	925
		926	`if ( $doIncludeOnly )`
		927	`{`
		928	`if (grep {$_ eq $proj_id} @includedProjects)`
		929	`{`
		930	`$Packages{$pvid}{NamedProject} = 1;`
		931	`}`
		932	`if (grep {$_ eq $rtag_id} @includedReleases)`
		933	`{`
404	dpurdie	934	`$Packages{$pvid}{NamedProject} = 2;`
394	dpurdie	935	`}`
		936	`}`
		937	`else`
		938	`{`
404	dpurdie	939	`$Packages{$pvid}{NamedProject} = 3;`
394	dpurdie	940	`}`
		941
		942
		943	`if ( $opt_limit )`
		944	`{`
		945	`last if ( $count++ > $opt_limit );`
		946	`}`
		947	`}`
		948	`}`
		949	`# print "--- Finish\n";`
		950	`$sth->finish();`
		951	`}`
		952	`else`
		953	`{`
		954	`Error("Execute failure: $m_sqlstr", $sth->errstr() );`
		955	`}`
		956	`}`
		957	`else`
		958	`{`
		959	`Error("Prepare failure" );`
		960	`}`
		961	`}`
		962
		963	`#-------------------------------------------------------------------------------`
		964	`# Function : GetDepends`
		965	`#`
		966	`# Description :`
		967	`#`
		968	`# Inputs : $pvid`
		969	`#`
		970	`# Returns :`
		971	`#`
		972	`sub GetDepends`
		973	`{`
		974	`my ($pv_id ) = @_;`
		975
		976	`#`
		977	`# Ensure we have package information`
		978	`#`
		979	`getPkgDetailsByPVID( $pv_id );`
		980	`return if ( $Packages{$pv_id}{depend} );`
		981	`$Packages{$pv_id}{depend} = 1;`
		982
		983	`#`
		984	`# Now extract the package dependacies`
		985	`# There may not be any`
		986	`#`
		987	`my $m_sqlstr = "SELECT ".`
		988	`" pd.PV_ID, ".`
		989	`" pd.DPV_ID " .`
		990	`" FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".`
		991	`" WHERE pd.PV_ID = \'$pv_id\'";`
		992	`my $sth = $RM_DB->prepare($m_sqlstr);`
		993	`if ( defined($sth) )`
		994	`{`
		995	`if ( $sth->execute( ) )`
		996	`{`
		997	`if ( $sth->rows )`
		998	`{`
		999	`while ( my @row = $sth->fetchrow_array )`
		1000	`{`
		1001	`my $pvid = $row[0];`
		1002	`my $dpvid = $row[1];`
		1003	`push @StrayPackages, $dpvid;`
		1004	`push @{$Packages{$dpvid}{usedBy}}, $pvid;`
		1005	`}`
		1006	`}`
		1007	`$sth->finish();`
		1008	`}`
		1009	`else`
		1010	`{`
		1011	`Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );`
		1012	`}`
		1013	`}`
		1014	`else`
		1015	`{`
		1016	`Error("GetDepends:Prepare failure" );`
		1017	`}`
		1018	`}`
		1019
		1020	`#-------------------------------------------------------------------------------`
		1021	`# Function : GetAllPackageNames`
		1022	`#`
		1023	`# Description :`
		1024	`#`
		1025	`# Inputs : None`
		1026	`#`
		1027	`# Returns :`
		1028	`#`
		1029	`sub GetAllPackageNames`
		1030	`{`
		1031	`# if we are not or cannot connect then return 0 as we have not found anything`
		1032	`connectRM(\$RM_DB) unless $RM_DB;`
		1033
		1034	`#`
		1035	`# Now extract all the package names`
		1036	`#`
		1037	`my $m_sqlstr = "SELECT pkg.PKG_ID, pkg.PKG_NAME" .`
		1038	`" FROM RELEASE_MANAGER.PACKAGES pkg";`
		1039	`my $sth = $RM_DB->prepare($m_sqlstr);`
		1040	`if ( defined($sth) )`
		1041	`{`
		1042	`if ( $sth->execute( ) )`
		1043	`{`
		1044	`if ( $sth->rows )`
		1045	`{`
		1046	`while ( my @row = $sth->fetchrow_array )`
		1047	`{`
		1048	`my $id = $row[0];`
		1049	`my $name = $row[1];`
		1050	`next unless ( $id );`
		1051	`$AllPackages{$id} = $name;`
		1052	`}`
		1053	`}`
		1054	`$sth->finish();`
		1055	`}`
		1056	`else`
		1057	`{`
		1058	`Error("GetAllPackageNames:Execute failure" );`
		1059	`}`
		1060	`}`
		1061	`else`
		1062	`{`
		1063	`Error("GetAllPackageNames:Prepare failure" );`
		1064	`}`
		1065	`}`
		1066
		1067	`#-------------------------------------------------------------------------------`
		1068	`# Function : massageVersion`
		1069	`#`
		1070	`# Description : Process a version number and return usful bits`
		1071	`#`
		1072	`# Inputs : Version Number`
		1073	`# Package Name - debug only`
		1074	`#`
		1075	`# Returns : An array`
		1076	`# suffix`
		1077	`# multipart version string useful for text comparisons`
		1078	`#`
		1079	`sub massageVersion`
		1080	`{`
		1081	`my ($version, $name) = @_;`
		1082	`my ($major, $minor, $patch, $build, $suffix);`
		1083	`my $result;`
		1084	`my $buildVersion;`
		1085	`my $isaRipple;`
		1086	`my $isaWIP;`
		1087	`$build = 0;`
		1088
		1089	`#print "--- $name, $version\n";`
		1090	`$version =~ s~^_~~;`
		1091	`$version =~ s~^\Q${name}\E_~~;`
		1092
		1093	`#`
		1094	`# Pre-massage some silly ones`
		1095	`#`
		1096	`if ( exists $sillyVersions{$version} ) {`
		1097	`$version = $sillyVersions{$version};`
		1098	`}`
395	dpurdie	1099
		1100	`if ( $name eq 'ReleaseName' ) {`
		1101	`$version =~ s~[a-z]~.~g;`
		1102	`$version =~ s~\.+~.~g;`
		1103	`$version =~ s~\.$~~g`
		1104	`}`
		1105
394	dpurdie	1106	`#`
		1107	`# xxxxxxxxx.nnnn.cots`
		1108	`#`
		1109	`if ( $version =~ m~(.*)\.cots$~ ) {`
		1110	`my $cots_base = $1;`
		1111	`$suffix = '.cots';`
		1112	`if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )`
		1113	`{`
		1114	`$result = $1 . sprintf (".%4.4d", $2) . $suffix;`
		1115	`}`
		1116	`else`
		1117	`{`
		1118	`$result = $cots_base . '.0000.cots';`
		1119	`}`
		1120	`}`
		1121	`#`
		1122	`# Convert version into full form for comparisions`
		1123	`# nnn.nnn.nnn.[p]nnn.xxx`
		1124	`# nnn.nnn.nnn.[p]nnn-xxx`
		1125	`# nnn.nnn.nnn-[p]nnn.xxx`
		1126	`# nnn.nnn.nnn-[p]nnn-xxx`
		1127	`# nnn.nnn.nnn[p]nnn-xxx`
		1128	`# Don't flag as ripples - they are patches`
		1129	`#`
		1130	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {`
		1131	`$major = $1;`
		1132	`$minor = $2;`
		1133	`$patch = $3;`
		1134	`$build = $4;`
		1135	`$suffix = defined $6 ? ".$6" : '';`
		1136	`$isaRipple = 0;`
		1137	`}`
		1138	`#`
		1139	`# nn.nnn.nnnnn.xxx`
		1140	`# nn.nnn.nnnnn-xxx`
		1141	`# nnn.nnn.nnnx.xxx`
		1142	`# Don't flag as ripples - they are patches`
		1143	`#`
		1144	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {`
		1145	`$major = $1;`
		1146	`$minor = $2;`
		1147	`$patch = $3;`
		1148	`if ( length( $patch) >= 4 )`
		1149	`{`
		1150	`$build = substr( $patch, -3 ,3);`
		1151	`$patch = substr( $patch, 0 ,length($patch)-3);`
		1152	`}`
		1153	`$suffix = defined $5 ? ".$5" : '';`
		1154	`}`
		1155
		1156	`#`
		1157	`# nnn.nnn.nnn`
		1158	`# nnn.nnn-nnn`
		1159	`# nnn.nnn_nnn`
		1160	`#`
		1161	`elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {`
		1162	`$major = $1;`
		1163	`$minor = $2;`
		1164	`$patch = $3;`
		1165	`$suffix = '';`
		1166	`}`
		1167
		1168	`#`
		1169	`# nnn.nnn.nnn.nnn`
		1170	`# nnn.nnn.nnn-nnn`
		1171	`# nnn.nnn.nnn_nnn`
		1172	`#`
		1173	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {`
		1174	`$major = $1;`
		1175	`$minor = $2;`
		1176	`$patch = $3;`
		1177	`$build = $4;`
		1178	`$suffix = '';`
		1179	`$isaRipple = 0;`
		1180	`}`
		1181
		1182
		1183	`#`
		1184	`# nnn.nnn`
		1185	`#`
		1186	`elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {`
		1187	`$major = $1;`
		1188	`$minor = $2;`
		1189	`$patch = 0;`
		1190	`$suffix = '';`
		1191	`}`
		1192	`#`
		1193	`# nnn.nnn.xxx`
		1194	`#`
		1195	`elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {`
		1196	`$major = $1;`
		1197	`$minor = $2;`
		1198	`$patch = 0;`
		1199	`$suffix = $3;`
		1200	`}`
		1201
		1202	`#`
		1203	`# nnn.nnn.nnnz`
		1204	`#`
		1205	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {`
		1206	`$major = $1;`
		1207	`$minor = $2;`
		1208	`$patch = $3;`
		1209	`$build = ord($4) - ord('a');`
		1210	`$suffix = '.cots';`
		1211	`$isaRipple = 0;`
		1212	`}`
		1213	`#`
		1214	`# ???REV=???`
		1215	`#`
		1216	`elsif ( $version =~ m~REV=~ ) {`
		1217	`$suffix = '.cots';`
		1218	`$result = $version . '.0000.cots';`
		1219	`}`
		1220
		1221	`#`
		1222	`# Wip Packages`
		1223	`# (nnnnnn).xxx`
		1224	`# Should be essential, but want to sort very low`
		1225	`#`
		1226	`elsif ($version =~ m~$(.)$(\..)?~) {`
		1227	`$suffix = $2 \|\| '';`
		1228	`$result = "000.000.000.000$suffix";`
		1229	`$isaWIP = 1;`
		1230	`}`
		1231
		1232	`#`
		1233	`# !current`
		1234	`#`
		1235	`elsif ($version eq '!current' \|\| $version eq 'current_$USER' \|\| $version eq 'current' \|\| $version eq 'beta' \|\| $version eq 'latest' \|\| $version eq 'beta.cr' \|\| $version eq 'CREATE') {`
		1236	`$suffix = '';`
		1237	`$result = "000.000.000.000$suffix";`
		1238	`$isaWIP = 1;`
		1239	`}`
		1240
		1241	`#`
		1242	`# Also WIP: FINRUN.103649.BEI.WIP`
		1243	`elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {`
		1244	`$suffix = lc($1);`
		1245	`$result = "000.000.000.000$suffix";`
		1246	`$isaWIP = 1;`
		1247	`}`
		1248
		1249	`#`
		1250	`# Also ERGOFSSLS190100_015`
		1251	`# Don't flag as a ripple`
		1252	`elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {`
		1253	`$major = $1;`
		1254	`$minor = $2;`
		1255	`$patch = $3;`
		1256	`$build = $4;`
		1257	`$suffix = $5 \|\| '.sls';`
		1258	`$isaRipple = 0;`
		1259	`}`
		1260
		1261	`#`
		1262	`# Stuff we don't yet handle`
		1263	`#`
		1264	`else {`
		1265	`Warning ("Unknown version number: $name,$version");`
		1266	`$version =~ m~(\.\w+)$~;`
		1267	`$suffix = $1 \|\| '';`
		1268	`$result = $version;`
		1269	`}`
		1270
		1271	`$isaRipple = ($build > 0) unless defined $isaRipple;`
		1272	`unless ( $result )`
		1273	`{`
		1274	`# Major and minor of 99.99 are normally funny versions`
		1275	`# Don't make important decisions on them`
		1276	`#`
		1277	`if (defined $major && defined $minor && $major == 99 && $minor == 99 )`
		1278	`{`
		1279	`$major = 0;`
		1280	`$minor = 0;`
		1281	`$patch = 0;`
		1282	`}`
		1283
		1284	`$result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix \|\| '.0000');`
		1285	`$buildVersion = [ $major, $minor, $patch, $build ];`
		1286	`}`
		1287
		1288	`$suffix = lc( $suffix );`
		1289	`if ( exists $suffixFixup{$suffix} )`
		1290	`{`
		1291	`$suffix = $suffixFixup{$suffix} ;`
		1292	`}`
		1293
		1294	`return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );`
		1295	`}`
		1296
		1297
		1298	`#-------------------------------------------------------------------------------`
		1299	`# Function : LocateStrays`
		1300	`#`
		1301	`# Description :`
		1302	`#`
		1303	`# Inputs :`
		1304	`#`
		1305	`# Returns :`
		1306	`#`
		1307	`sub LocateStrays`
		1308	`{`
		1309	`Message ("Locate indirectly referenced packages");`
		1310	`while ( $#StrayPackages >= 0 )`
		1311	`{`
		1312	`my $pv_id = pop @StrayPackages;`
		1313
		1314	`next if ( exists $Packages{$pv_id}{done} );`
		1315	`#print "... ",$#StrayPackages,"\n";`
		1316	`GetDepends( $pv_id);`
		1317	`$Packages{$pv_id}{done} = 1;`
		1318	`}`
		1319	`}`
		1320
		1321	`#-------------------------------------------------------------------------------`
395	dpurdie	1322	`# Function : countPackages`
		1323	`#`
		1324	`# Description :`
		1325	`#`
		1326	`# Inputs :`
		1327	`#`
		1328	`# Returns : Number of packages and number oof versions`
		1329	`#`
		1330	`sub countPackages`
		1331	`{`
		1332	`my $v = 0;`
		1333	`my $p = 0;`
		1334	`my %names;`
		1335
		1336	`foreach ( keys %Packages )`
		1337	`{`
		1338	`my $name = $Packages{$_}{name};`
		1339	`next unless ( $name );`
		1340	`$names{$name} = 1;`
		1341	`$v++;`
		1342	`}`
		1343
		1344	`$p = keys %names;`
		1345
		1346	`return $p,$v;`
		1347
		1348	`}`
		1349
		1350	`#-------------------------------------------------------------------------------`
396	dpurdie	1351	`# Function : processData`
394	dpurdie	1352	`#`
396	dpurdie	1353	`# Description : Process data before its written out`
		1354	`# Remove a few packages that we do not want to now about`
		1355	`# Determine Reason that a version is in the list`
		1356	`# Finish taging packages in NamedProject`
394	dpurdie	1357	`#`
		1358	`# Inputs :`
		1359	`#`
		1360	`# Returns :`
		1361	`#`
396	dpurdie	1362	`sub processData`
394	dpurdie	1363	`{`
		1364	`foreach ( keys %Packages )`
		1365	`{`
		1366	`delete $Packages{$_}{done};`
		1367	`next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );`
		1368
		1369	`if ($Packages{$_}{name} eq 'Activestate Perl - Solaris')`
		1370	`{`
		1371	`delete $Packages{$_};`
		1372	`next;`
		1373	`}`
		1374
		1375	`if ( $Packages{$_}{name} =~ m/^CSW/ \|\| $Packages{$_}{name} =~ m/^Solaris$/)`
		1376	`{`
		1377	`delete $Packages{$_};`
		1378	`next;`
		1379	`}`
		1380
		1381	`if ( $Packages{$_}{name} =~ m/^jats_/)`
		1382	`{`
		1383	`delete $Packages{$_};`
		1384	`next;`
		1385	`}`
396	dpurdie	1386
		1387	`#`
		1388	`# Determine why version is here`
		1389	`# tpl - Top Level Package from a Release`
		1390	`# sbom - Included because of an sbom`
		1391	`#`
		1392	`# tplDepend - Used by a TLP`
		1393	`# sbomDepend - Used by an SBOM`
		1394	`#`
		1395	`# Where there are multiple reasons for inclusion a tlp is more`
		1396	`# significant than a sbom`
		1397	`#`
		1398	`#`
		1399	`if ( exists $Packages{$_}{'tlp'}) {`
		1400	`$Packages{$_}{Reason} = 'tlp';`
		1401
		1402	`} elsif ( exists $Packages{$_}{'sbomBase'}) {`
		1403	`$Packages{$_}{Reason} = 'sbom';`
		1404
		1405	`} elsif ( exists $Packages{$_}{'sbomOsid'}) {`
		1406	`$Packages{$_}{Reason} = 'sbom';`
		1407
		1408	`} else {`
		1409	`my $reason;`
		1410	`my %usedBy;`
		1411	`my @examineThese = @{$Packages{$_}{'usedBy'}};`
		1412	`while ( @examineThese )`
		1413	`{`
		1414	`my $pvid = pop @examineThese;`
		1415	`next if ( $usedBy{$pvid} );`
		1416
		1417	`if ( exists $Packages{$pvid}{Reason} )`
		1418	`{`
		1419	`$reason = $Packages{$pvid}{Reason};`
		1420
		1421	`} elsif ( exists $Packages{$pvid}{'tlp'}) {`
		1422	`$reason = 'tlpDepend';`
		1423	`last;`
		1424
		1425	`} elsif ( exists $Packages{$pvid}{'sbomBase'}) {`
		1426	`$reason = 'sbomDepend';`
		1427
		1428	`} elsif ( exists $Packages{$pvid}{'sbomOsid'}) {`
		1429	`$reason = 'sbomDepend';`
		1430	`}`
		1431
		1432	`push @examineThese, @{$Packages{$pvid}{'usedBy'}}`
		1433	`if (exists $Packages{$pvid}{'usedBy'});`
		1434	`}`
		1435
		1436	`if ( $reason )`
		1437	`{`
		1438	`$Packages{$_}{Reason} = $reason;`
		1439	`}`
		1440	`else`
		1441	`{`
		1442	`Message ("Don't know why I'm here: $_, $Packages{$_}{name} $Packages{$_}{'version'}");`
		1443	`}`
		1444	`}`
		1445
		1446	`#`
		1447	`# Catch packages that are dependents of NamedProject's`
		1448	`#`
		1449	`if ( $doIncludeOnly )`
		1450	`{`
		1451	`if ( exists $Packages{$_}{'sbomBase'} \|\| exists $Packages{$_}{'sbomOsid'} )`
		1452	`{`
404	dpurdie	1453	`$Packages{$_}{NamedProject} = 4;`
396	dpurdie	1454	`}`
		1455
		1456	`unless ( $Packages{$_}{NamedProject} )`
		1457	`{`
		1458	`my $named;`
		1459	`my %usedBy;`
		1460
		1461	`if ( exists $Packages{$_}{'usedBy'})`
		1462	`{`
		1463	`my @examineThese = @{$Packages{$_}{'usedBy'}};`
		1464	`while ( @examineThese )`
		1465	`{`
		1466	`my $pvid = pop @examineThese;`
		1467	`next if ( $usedBy{$pvid} );`
		1468
		1469	`if ( $Packages{$pvid}{NamedProject} )`
		1470	`{`
		1471	`$named = 1;`
		1472	`last;`
		1473	`}`
		1474
		1475	`push @examineThese, @{$Packages{$pvid}{'usedBy'}}`
		1476	`if (exists $Packages{$pvid}{'usedBy'});`
		1477	`}`
404	dpurdie	1478	`$Packages{$_}{NamedProject} = 5`
396	dpurdie	1479	`if ( $named );`
		1480	`}`
		1481	`# else`
		1482	`# {`
		1483	`# Warning("Not Named and not usedBy: $Packages{$_}{name} $Packages{$_}{'version'}");`
		1484	`# }`
		1485	`}`
		1486	`}`
		1487	`else`
		1488	`{`
404	dpurdie	1489	`$Packages{$_}{NamedProject} = 6;`
396	dpurdie	1490	`}`
394	dpurdie	1491	`}`
396	dpurdie	1492	`}`
394	dpurdie	1493
396	dpurdie	1494	`#-------------------------------------------------------------------------------`
		1495	`# Function : outputData`
		1496	`#`
		1497	`# Description : Write out data in a form to allow post processing`
		1498	`#`
		1499	`# Inputs :`
		1500	`#`
		1501	`# Returns :`
		1502	`#`
		1503	`sub outputData`
		1504	`{`
		1505	`my $file = "cc2svn.raw.txt";`
		1506	`Message ("Create: $file");`
		1507	`my $fh = ConfigurationFile::New( $file );`
		1508
394	dpurdie	1509	`$fh->DumpData(`
396	dpurdie	1510	`"\n# Releases.\n#\n",`
		1511	`"ScmReleases", \%Releases );`
		1512
		1513	`$fh->DumpData(`
394	dpurdie	1514	`"\n# Packages.\n#\n",`
		1515	`"ScmPackages", \%Packages );`
		1516
		1517	`$fh->DumpData(`
		1518	`"\n# Suffixes.\n#\n",`
		1519	`"ScmSuffixes", \%Suffixes );`
		1520
		1521	`$fh->DumpData(`
		1522	`"\n# All Package Names.\n#\n",`
		1523	`"ScmAllPackages", \%AllPackages );`
		1524
		1525	`#`
		1526	`# Just for debug`
		1527	`#`
395	dpurdie	1528	`#`
		1529	`# Remove unused SBOMs`
		1530	`#`
		1531	`my %AllBomProjects;`
		1532	`foreach ( keys %sboms )`
		1533	`{`
		1534	`if ( $sboms{$_}{needed} )`
		1535	`{`
		1536	`my $project_id = $sboms{$_}{project_id};`
		1537	`$AllBomProjects{$project_id}{project_name} = $sboms{$_}{project_name};`
		1538	`next;`
		1539	`}`
		1540	`delete $sboms{$_};`
		1541	`}`
		1542
		1543	`$fh->DumpData("\n# All Bom Projects.\n#\n", "ScmAllBomProjects", \%AllBomProjects );`
394	dpurdie	1544	`$fh->DumpData("\n# All SBOMS.\n#\n", "ScmSboms", \%sboms );`
404	dpurdie	1545
		1546	`$fh->DumpData("\n# All os_id_list.\n#\n", "ScmOsIdList", \%os_id_list );`
		1547	`$fh->DumpData("\n# All os_env_list.\n#\n", "ScmOsEnvList", \%os_env_list );`
		1548	`$fh->DumpData("\n# All sbom_pvid.\n#\n", "ScmSbomPVID", \%sbom_pvid );`
394	dpurdie	1549
		1550	`#`
		1551	`# Close out the file`
		1552	`#`
		1553	`$fh->Close();`
		1554
		1555	`# #`
		1556	`# # Split up package data into small files for easy consumption`
		1557	`# #`
		1558	`#`
		1559	`# foreach ( keys %Packages )`
		1560	`# {`
		1561	`# my $file = "cc2svn.raw.${_}.txt";`
		1562	`# Message ("Create: $file");`
		1563	`# my $fh = ConfigurationFile::New( $file );`
		1564	`#`
		1565	`# $fh->DumpData(`
		1566	`# "\n# Releases.\n#\n",`
		1567	`# "ScmReleases", \$Packages{$_} );`
		1568	`# $fh->Close();`
		1569	`# }`
		1570
		1571	`}`
		1572
		1573
		1574	`#-------------------------------------------------------------------------------`
		1575	`# Documentation`
		1576	`#`
		1577
		1578	`=pod`
		1579
		1580	`=for htmltoc SYSUTIL::cc2svn::`
		1581
		1582	`=head1 NAME`
		1583
		1584	`cc2svn_gendata - Extract CC2SVN Essential Package Data from Release Manager`
		1585
		1586	`=head1 SYNOPSIS`
		1587
		1588	`jats cc2svn_gendata [options]`
		1589
		1590	`Options:`
		1591	`-help - brief help message`
		1592	`-help -help - Detailed help message`
		1593	`-man - Full documentation`
		1594	`-test=version - Test a version string, then exit`
		1595	`-limit=n - Limit packages processed. Test only`
395	dpurdie	1596	`-mode=xxx - Set Mode: all, hops, standard`
		1597	`-[no]sbom - Include SBOM versions. Default: Yes`
394	dpurdie	1598
		1599	`=head1 OPTIONS`
		1600
		1601	`=over 8`
		1602
		1603	`=item B<-help>`
		1604
		1605	`Print a brief help message and exits.`
		1606
		1607	`=item B<-help -help>`
		1608
		1609	`Print a detailed help message with an explanation for each option.`
		1610
		1611	`=item B<-man>`
		1612
		1613	`Prints the manual page and exits.`
		1614
		1615	`=item B<-test=version>`
		1616
		1617	`Examine a package version string and report how the tool will parse it.`
		1618
		1619	`=item B<-limit=n>`
		1620
		1621	`Limit the number of packages processed by the tool. This is only used to`
		1622	`simplify testing of the program`
		1623
		1624	`=back`
		1625
		1626	`=head1 DESCRIPTION`
		1627
		1628	`This program is a tool used in the conversion of ClearCase VOBS to subversion.`
		1629	`It will:`
		1630
		1631	`=over 8`
		1632
		1633	`=item *`
		1634
		1635	`Determine all Releases in Release manager and mark those that`
		1636	`are to be excluded.`
		1637
		1638	`=item *`
		1639
		1640	`Determine all the package-versions used by the releases that are`
		1641	`not excluded. These are called 'direct' dependencies.`
		1642
		1643	`=item *`
		1644
		1645	`Recursively find all the dependent packages of all packages. New package`
		1646	`versions are called 'indirect' dependencies. They are buried. This process can`
		1647	`take several minutes.`
		1648
		1649	`=back`
		1650
		1651	`The data collected is dumped into a text file for later processing.`
		1652
		1653	`=cut`
		1654

Subversion Repositories DevTools

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