WebSVN – DevTools – Blame – /core_devl/branches/gitBuilder/TOOLS/LOCAL/cc2svn_gendata_sbom.pl

Rev	Author	Line No.	Line
394	dpurdie	1	`########################################################################`
		2	`# Copyright (C) 1998-2012 Vix Technology, All rights reserved`
		3	`#`
		4	`# Module name : cc2svn_gendata.pl`
		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 = '';`
395	dpurdie	40	`my $opt_sbom = 1;`
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)`
		112	`# 122, # VASTTRAFIK (VTK)`
		113	`142, # SYDNEY (SYD)`
		114	`162, # WASHINGTON (WDC)`
		115	`# 164, # SEATTLE (SEA)`
		116	`182, # ROME (ROM)`
		117	`# 202, # STOCKHOLM (SLS)`
		118	`# 221, # NZ STAGE COACH (NZS)`
		119	`# 261, # VÄSTTRAFIK PRODUCTION (VTProd)`
		120	`# 301, # BEIJING (BEI)`
		121	`321, # SAN FRANCISCO PRODUCTION (SFOProd)`
		122	`# 361, # UK STAGE COACH (SSW) Historical`
		123	`# 401, # SEATTLE INTEGRATION (SEA Int)`
		124	`# 421, # UK STAGE COACH PRODUCTION (SSWProd)`
		125	`441, # COTRAL`
		126	`461, # TASMANIA DEMO (MFCS)`
		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)`
		135	`621, # NEW DEHLI (NDL)`
		136	`# 641, # TRACS Projects`
		137	`# 701, # BANGKOK (BKK)`
		138	`# 721, # CAPE TOWN`
		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);`
		379	`Verbose ("getOSIDforBOMID");`
		380	`connectDM(\$DM_DB) unless ($DM_DB);`
		381
395	dpurdie	382	`my $project_id = $sboms{$bom_id}{project_id};`
394	dpurdie	383	`#print "getOSIDforBOMID: $bom_id, $project_id\n";`
		384	`if ( $doIncludeOnly )`
		385	`{`
		386	`unless ( grep {$_ eq $project_id} @includeBomProjects)`
		387	`{`
		388	`return;`
		389	`}`
		390	`}`
		391	`else`
		392	`{`
		393	`if ( grep {$_ eq $project_id} @excludeBomProjects)`
		394	`{`
		395	`#print "Ignoring $bom_id\n";`
		396	`return;`
		397	`}`
		398	`}`
		399
395	dpurdie	400	`#`
		401	`# Save for later`
		402	`#`
		403	`push @sbomNeeded, $bom_id;`
		404
394	dpurdie	405	`my $m_sqlstr = "SELECT distinct bc.BOM_ID, os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .`
		406	`" FROM DEPLOYMENT_MANAGER.OPERATING_SYSTEMS os, " .`
		407	`"DEPLOYMENT_MANAGER.BOM_CONTENTS bc, ".`
		408	`"DEPLOYMENT_MANAGER.NETWORK_NODES nn, ".`
		409	`"DEPLOYMENT_MANAGER.OS_BASE_ENV obe" .`
		410	`" WHERE bc.BOM_ID = $bom_id ".`
		411	`"AND bc.NODE_ID = os.NODE_ID ".`
		412	`"AND nn.NODE_ID = os.NODE_ID ".`
		413	`"AND obe.OS_ID (+) = os.OS_ID ";`
		414
		415	`my $sth = $DM_DB->prepare($m_sqlstr);`
		416	`if ( defined($sth) )`
		417	`{`
		418	`if ( $sth->execute( ) )`
		419	`{`
		420	`if ( $sth->rows )`
		421	`{`
		422	`while ( @row = $sth->fetchrow_array )`
		423	`{`
		424	`#print "----@row\n";`
		425	`Verbose ("OS_ID: ".join (',',@row) );`
		426	`$sboms{$row[0]}{needed} = 1;`
		427	`$os_id_list{$row[1]}{bom_id} = $row[0];`
		428	`$os_id_list{$row[1]}{os_name} = $row[2];`
		429	`$os_id_list{$row[1]}{node_name} = $row[3];`
		430
		431	`if ( defined $row[4] )`
		432	`{`
		433	`$os_env_list{$row[4]}{needed} = 1;`
		434	`$os_env_list{$row[4]}{os_id}{$row[1]} = 1;`
		435	`}`
		436
		437	`$foundDetails = 1;`
		438	`}`
		439	`}`
		440	`$sth->finish();`
		441	`}`
		442	`else`
		443	`{`
		444	`Error("getOSIDforBOMID:Execute failure" );`
		445	`}`
		446	`}`
		447	`else`
		448	`{`
		449	`Error("getOSIDforBOMID:Prepare failure" );`
		450	`}`
		451
		452	`Warning("getOSIDforBOMID:No OS Information Found: Project:$project_id BOM:$bom_id" ) unless $foundDetails;`
		453
		454	`}`
		455
		456	`#-------------------------------------------------------------------------------`
		457	`# Function : getSBOMDetails`
		458	`#`
		459	`# Description : Get some details about the SBOM`
		460	`# Used for descriptive text`
		461	`#`
		462	`# Inputs : $bom_id - BOM to process`
		463	`#`
		464	`# Returns :`
		465	`#`
		466	`sub getSBOMDetails`
		467	`{`
		468	`my ($bom_id) = @_;`
		469	`my $foundDetails = 0;`
		470	`my (@row);`
		471
		472	`Verbose ("getSBOMDetails: $bom_id");`
		473	`connectDM(\$DM_DB) unless ($DM_DB);`
		474
		475	`my $m_sqlstr = "SELECT distinct dp.PROJ_NAME ,bn.BOM_NAME, br.BRANCH_NAME, bm.BOM_VERSION, bm.BOM_LIFECYCLE" .`
		476	`" FROM DEPLOYMENT_MANAGER.BOMS bm, DEPLOYMENT_MANAGER.BOM_NAMES bn, DEPLOYMENT_MANAGER.BRANCHES br, DEPLOYMENT_MANAGER.DM_PROJECTS dp" .`
		477	`" 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";`
		478
		479	`my $sth = $DM_DB->prepare($m_sqlstr);`
		480	`if ( defined($sth) )`
		481	`{`
		482	`if ( $sth->execute( ) )`
		483	`{`
		484	`if ( $sth->rows )`
		485	`{`
		486	`while ( @row = $sth->fetchrow_array )`
		487	`{`
395	dpurdie	488	`# $sboms{$bom_id}{sbom_project} = $row[0];`
394	dpurdie	489	`$sboms{$bom_id}{sbom_name} = $row[1];`
		490	`$sboms{$bom_id}{sbom_branch} = $row[2];`
		491	`$sboms{$bom_id}{sbom_version} = $row[3] . '.' . $row[4];`
		492	`$foundDetails = 1;`
		493	`}`
		494	`}`
		495	`$sth->finish();`
		496	`}`
		497	`else`
		498	`{`
		499	`Error("getSBOMDetails:Execute failure", $m_sqlstr );`
		500	`}`
		501	`}`
		502	`else`
		503	`{`
		504	`Error("getSBOMDetails:Prepare failure" );`
		505	`}`
		506
		507	`Error("getSBOMDetails:No OS Information Found" ) unless $foundDetails;`
		508
		509	`}`
		510
		511	`#-------------------------------------------------------------------------------`
		512	`# Function : getPackagesforBaseInstall`
		513	`#`
		514	`# Description : Get all the packages for a given base install`
		515	`#`
		516	`# Inputs :`
		517	`#`
		518	`# Returns :`
		519	`#`
		520
		521	`sub getPackagesforBaseInstall`
		522	`{`
		523	`my ($base_env_id) = @_;`
		524	`my $foundDetails = 0;`
		525	`my (@row);`
		526
		527	`connectDM(\$DM_DB) unless ($DM_DB);`
		528
		529	`# First get details from pv_id`
		530
		531	`my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .`
		532	`" FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd, DEPLOYMENT_MANAGER.BASE_ENV_CONTENTS bec".`
		533	`" WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";`
		534
		535	`my $sth = $DM_DB->prepare($m_sqlstr);`
		536	`if ( defined($sth) )`
		537	`{`
		538	`if ( $sth->execute( ) )`
		539	`{`
		540	`if ( $sth->rows )`
		541	`{`
		542	`while ( @row = $sth->fetchrow_array )`
		543	`{`
		544	`Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );`
		545
		546	`my $pv_id = $row[0];`
		547	`my $name = $row[1] \|\| 'BadName';`
		548	`my $ver = $row[2] \|\| 'BadVer';`
		549
		550	`$sbom_pvid{$pv_id}{pkg_name} =$name;`
		551	`$sbom_pvid{$pv_id}{pkg_ver} = $ver;`
		552
		553	`push @{$Packages{$pv_id}{sbomBase}}, $pv_id;`
		554	`push @StrayPackages, $pv_id;`
		555
		556	`foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )`
		557	`{`
		558	`$sbom_pvid{$pv_id}{os_id}{$os_id} = 2;`
		559	`}`
		560	`}`
		561	`}`
		562	`$sth->finish();`
		563	`}`
		564	`else`
		565	`{`
		566	`Error ("getPackagesforBaseInstall: Execute error");`
		567	`}`
		568	`}`
		569	`else`
		570	`{`
		571	`Error("getPackagesforBaseInstall:Prepare failure" );`
		572	`}`
		573	`}`
		574
		575	`#-------------------------------------------------------------------------------`
		576	`# Function : getPackages_by_osid`
		577	`#`
		578	`# Description : Get all the packages used by a given os_id`
		579	`#`
		580	`# Inputs :`
		581	`#`
		582	`# Returns :`
		583	`#`
		584
		585	`sub getPackages_by_osid`
		586	`{`
		587	`my ($os_id) =@_;`
		588	`my $foundDetails = 0;`
		589	`my (@row);`
		590
		591	`connectDM(\$DM_DB) unless ($DM_DB);`
		592
		593	`# First get details from pv_id`
		594
		595	`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" .`
		596	`" FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd,".`
		597	`"(" .`
		598	`" SELECT osc.seq_num, osc.prod_id".`
		599	`" FROM DEPLOYMENT_MANAGER.os_contents osc".`
		600	`" WHERE osc.os_id = $os_id" .`
		601	`" ) osc" .`
		602	`" WHERE pd.PROD_ID (+)= pv.PV_ID" .`
		603	`" AND pv.pkg_id = pkg.pkg_id" .`
		604	`" AND osc.PROD_ID = pv.pv_id" .`
		605	`" ORDER BY osc.SEQ_NUM desc" ;`
		606
		607	`my $sth = $DM_DB->prepare($m_sqlstr);`
		608	`if ( defined($sth) )`
		609	`{`
		610	`if ( $sth->execute( ) )`
		611	`{`
		612	`if ( $sth->rows )`
		613	`{`
		614	`while ( @row = $sth->fetchrow_array )`
		615	`{`
		616	`Verbose ("SBOM Package:".join (',',@row) );`
		617	`my $pv_id = $row[8];`
		618	`unless ( exists $sbom_pvid{$pv_id} )`
		619	`{`
		620	`my $name = $row[2] \|\| 'BadName';`
		621	`my $ver = $row[3] \|\| 'BadVer';`
		622
		623	`$sbom_pvid{$pv_id}{pkg_name} =$name;`
		624	`$sbom_pvid{$pv_id}{pkg_ver} = $ver;`
		625
		626	`push @{$Packages{$pv_id}{sbomOsid}}, $pv_id;`
		627	`$Packages{$pv_id}{sbomOsid} = 1;`
		628	`push @StrayPackages, $pv_id;`
		629
		630
		631	`}`
		632	`$sbom_pvid{$pv_id}{os_id}{$os_id} = 1;`
		633	`}`
		634	`}`
		635	`$sth->finish();`
		636	`}`
		637	`}`
		638	`else`
		639	`{`
		640	`Error("getPackages_by_osid:Prepare failure" );`
		641	`}`
		642	`}`
		643
		644	`#-------------------------------------------------------------------------------`
		645	`# Function : getReleaseDetails`
		646	`#`
		647	`# Description : Determine all candiate releases`
		648	`#`
		649	`# Inputs :`
		650	`#`
		651	`# Returns :`
		652	`#`
		653	`sub getReleaseDetails`
		654	`{`
		655	`my (@row);`
		656
		657	`# if we are not or cannot connect then return 0 as we have not found anything`
		658	`connectRM(\$RM_DB) unless $RM_DB;`
		659
		660	`# First get all packages that are referenced in a Release`
		661	`# This will only get the top level packages`
		662	`# From non-archived releases`
		663
		664	`my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .`
		665	`" FROM release_manager.release_tags rt, release_manager.projects prj" .`
		666	`" WHERE prj.PROJ_ID = rt.PROJ_ID " .`
395	dpurdie	667	`# " AND rt.official != 'A' ".`
		668	`# " AND rt.official != 'Y'" .`
394	dpurdie	669	`" order by prj.PROJ_NAME";`
		670	`my $sth = $RM_DB->prepare($m_sqlstr);`
		671	`if ( defined($sth) )`
		672	`{`
		673	`if ( $sth->execute( ) )`
		674	`{`
		675	`# print "--- Execute\n";`
		676	`if ( $sth->rows )`
		677	`{`
		678	`# print "--- Execute ROWS\n";`
		679	`while ( @row = $sth->fetchrow_array )`
		680	`{`
		681	`my $rtag_id =$row[3];`
		682	`my $proj_id = $row[2];`
		683
		684	`$Releases{$rtag_id}{pName} = $row[0];`
		685	`$Releases{$rtag_id}{name} = $row[1];`
		686	`$Releases{$rtag_id}{proj_id} = $proj_id;`
		687	`$Releases{$rtag_id}{rtag_id} = $rtag_id;`
		688	`$Releases{$rtag_id}{official} = $row[4];`
		689
		690	`unless ( $doAllReleases )`
		691	`{`
		692	`if (grep {$_ eq $proj_id} @excludeProjects) {`
		693	`$Releases{$rtag_id}{excluded} = 'E';`
		694	`}`
		695
		696	`if (grep {$_ eq $rtag_id} @excludeReleases) {`
		697	`$Releases{$rtag_id}{excluded} = 'E';`
		698	`}`
		699	`}`
		700
		701	`if ( $doIncludeOnly )`
		702	`{`
		703
		704	`if (grep {$_ eq $proj_id} @includedProjects)`
		705	`{`
		706	`delete $Releases{$rtag_id}{excluded};`
		707	`}`
		708	`else`
		709	`{`
		710	`$Releases{$rtag_id}{excluded} = 'E';`
		711	`}`
		712
		713	`if (grep {$_ eq $rtag_id} @includedReleases)`
		714	`{`
		715	`delete $Releases{$rtag_id}{excluded};`
		716	`}`
		717	`}`
		718
		719	`unshift @row, $Releases{$rtag_id}{excluded} \|\| ' ';`
		720	`print join (',',@row), "\n" if ($opt_verbose);`
		721	`}`
		722	`}`
		723	`# print "--- Finish\n";`
		724	`$sth->finish();`
		725	`}`
		726	`else`
		727	`{`
		728	`Error("Execute failure: $m_sqlstr", $sth->errstr() );`
		729	`}`
		730	`}`
		731	`else`
		732	`{`
		733	`Error("Prepare failure" );`
		734	`}`
		735	`}`
		736
		737
		738	`sub getPkgDetailsByPVID`
		739	`{`
		740	`my ($pv_id) = @_;`
		741	`my (@row);`
		742
		743	`#`
		744	`# Only do once`
		745	`#`
		746	`return if ( exists $Packages{$pv_id}{name} );`
		747
		748	`# if we are not or cannot connect then return 0 as we have not found anything`
		749	`connectRM(\$RM_DB) unless $RM_DB;`
		750
		751	`my $m_sqlstr = "SELECT" .`
		752	`" pv.PV_ID, ". #[0]`
		753	`" pkg.PKG_NAME, ". #[1]`
		754	`" pv.PKG_VERSION, ". #[2]`
		755	`" pv.DLOCKED," . #[3]`
		756	`" release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), ". #[4]`
		757	`" pv.PKG_ID," . #[5]`
		758	`" pv.MODIFIED_STAMP ". #[6]`
		759	`" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".`
		760	`" RELEASE_MANAGER.PACKAGES pkg ".`
		761	`" WHERE pv.PV_ID = \'$pv_id\' ".`
		762	`" AND pv.PKG_ID = pkg.PKG_ID" ;`
		763	`my $sth = $RM_DB->prepare($m_sqlstr);`
		764	`if ( defined($sth) )`
		765	`{`
		766	`if ( $sth->execute( ) )`
		767	`{`
		768	`# print "--- Execute\n";`
		769	`if ( $sth->rows )`
		770	`{`
		771	`# print "--- Execute ROWS\n";`
		772	`while ( @row = $sth->fetchrow_array )`
		773	`{`
		774	`print join (',',@row), "\n" if ($opt_verbose);`
		775
		776	`my $pvid = $row[0];`
		777	`$Packages{$pvid}{name} = $row[1];`
		778	`$Packages{$pvid}{version} = $row[2];`
		779	`$Packages{$pvid}{locked} = $row[3];`
		780	`$row[4] =~ tr~\\/~/~;`
		781	`$Packages{$pvid}{vcstag} = $row[4];`
		782	`$Packages{$pvid}{pkgid} = $row[5];`
		783	`# $Packages{$pvid}{tlp} = 1;`
		784	`($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );`
		785	`$Suffixes{$Packages{$pvid}{suffix}}++;`
		786	`$Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);`
		787	`}`
		788	`}`
		789	`# print "--- Finish\n";`
		790	`$sth->finish();`
		791	`}`
		792	`else`
		793	`{`
		794	`Error("getPkgDetailsByPVID:Execute failure: $m_sqlstr", $sth->errstr() );`
		795	`}`
		796	`}`
		797	`else`
		798	`{`
		799	`Error("getPkgDetailsByPVID:Prepare failure" );`
		800	`}`
		801	`}`
		802
		803
		804	`sub getPkgDetailsByRTAG_ID`
		805	`{`
		806	`my (@row);`
		807	`my $excludes = '';`
		808	`my $count = 0;`
		809
		810	`# if we are not or cannot connect then return 0 as we have not found anything`
		811	`connectRM(\$RM_DB) unless $RM_DB;`
		812
		813	`Message ("Extract toplevel dependencies");`
		814
		815	`# First get all packages that are referenced in a Release`
		816	`# This will only get the top level packages`
		817	`# From non-archived releases`
		818
		819	`unless ($doAllReleases)`
		820	`{`
		821	`foreach ( @excludeProjects )`
		822	`{`
		823	`$excludes .= " AND prj.PROJ_ID != $_ ";`
		824	`}`
		825	`foreach ( @excludeReleases )`
		826	`{`
		827	`$excludes .= " AND rt.RTAG_ID != $_ ";`
		828	`}`
		829	`}`
		830
		831	`my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.DLOCKED" .`
		832	`" , release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), pv.PKG_ID" .`
		833	`" , rt.RTAG_ID, rmv.VIEW_NAME, pv.MODIFIED_STAMP, prj.PROJ_ID" .`
		834	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv,".`
		835	`" RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .`
		836	`" , release_manager.views rmv" .`
		837	`" WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .`
		838	`" AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .`
		839	`" AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .`
395	dpurdie	840	`# " AND rt.official != 'A'" .`
		841	`# " AND rt.official != 'Y' " .`
394	dpurdie	842	`$excludes .`
		843	`" order by pkg.PKG_NAME";`
		844	`my $sth = $RM_DB->prepare($m_sqlstr);`
		845	`if ( defined($sth) )`
		846	`{`
		847	`if ( $sth->execute( ) )`
		848	`{`
		849	`# print "--- Execute\n";`
		850	`if ( $sth->rows )`
		851	`{`
		852	`# print "--- Execute ROWS\n";`
		853	`while ( @row = $sth->fetchrow_array )`
		854	`{`
		855	`print join (',',@row), "\n" if ($opt_verbose);`
		856	`my $pvid = $row[0];`
		857	`unless ( exists $Packages{$pvid}{name} )`
		858	`{`
		859	`$Packages{$pvid}{name} = $row[1];`
		860	`$Packages{$pvid}{version} = $row[2];`
		861	`$Packages{$pvid}{locked} = $row[3];`
		862	`$row[4] =~ tr~\\/~/~;`
		863	`$Packages{$pvid}{vcstag} = $row[4];`
		864	`$Packages{$pvid}{pkgid} = $row[5];`
		865	`$Packages{$pvid}{tlp} = 1;`
		866	`($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );`
		867	`$Suffixes{$Packages{$pvid}{suffix}}++;`
		868
		869	`push @StrayPackages, $pvid;`
		870	`}`
		871
		872	`my $rtag_id = $row[6];`
		873	`push @{$Packages{$pvid}{release}}, $rtag_id;`
		874	`$Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );`
		875
		876	`$Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);`
		877
		878	`my $proj_id = $row[9];`
396	dpurdie	879	`push @{$Packages{$pvid}{projects}}, $proj_id`
		880	`unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});`
394	dpurdie	881
		882	`if ( $doIncludeOnly )`
		883	`{`
		884	`if (grep {$_ eq $proj_id} @includedProjects)`
		885	`{`
		886	`$Packages{$pvid}{NamedProject} = 1;`
		887	`}`
		888	`if (grep {$_ eq $rtag_id} @includedReleases)`
		889	`{`
		890	`$Packages{$pvid}{NamedProject} = 1;`
		891	`}`
		892	`}`
		893	`else`
		894	`{`
		895	`$Packages{$pvid}{NamedProject} = 1;`
		896	`}`
		897
		898
		899	`if ( $opt_limit )`
		900	`{`
		901	`last if ( $count++ > $opt_limit );`
		902	`}`
		903	`}`
		904	`}`
		905	`# print "--- Finish\n";`
		906	`$sth->finish();`
		907	`}`
		908	`else`
		909	`{`
		910	`Error("Execute failure: $m_sqlstr", $sth->errstr() );`
		911	`}`
		912	`}`
		913	`else`
		914	`{`
		915	`Error("Prepare failure" );`
		916	`}`
		917	`}`
		918
		919	`#-------------------------------------------------------------------------------`
		920	`# Function : GetDepends`
		921	`#`
		922	`# Description :`
		923	`#`
		924	`# Inputs : $pvid`
		925	`#`
		926	`# Returns :`
		927	`#`
		928	`sub GetDepends`
		929	`{`
		930	`my ($pv_id ) = @_;`
		931
		932	`#`
		933	`# Ensure we have package information`
		934	`#`
		935	`getPkgDetailsByPVID( $pv_id );`
		936	`return if ( $Packages{$pv_id}{depend} );`
		937	`$Packages{$pv_id}{depend} = 1;`
		938
		939	`#`
		940	`# Now extract the package dependacies`
		941	`# There may not be any`
		942	`#`
		943	`my $m_sqlstr = "SELECT ".`
		944	`" pd.PV_ID, ".`
		945	`" pd.DPV_ID " .`
		946	`" FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".`
		947	`" WHERE pd.PV_ID = \'$pv_id\'";`
		948	`my $sth = $RM_DB->prepare($m_sqlstr);`
		949	`if ( defined($sth) )`
		950	`{`
		951	`if ( $sth->execute( ) )`
		952	`{`
		953	`if ( $sth->rows )`
		954	`{`
		955	`while ( my @row = $sth->fetchrow_array )`
		956	`{`
		957	`my $pvid = $row[0];`
		958	`my $dpvid = $row[1];`
		959	`push @StrayPackages, $dpvid;`
		960	`push @{$Packages{$dpvid}{usedBy}}, $pvid;`
		961	`}`
		962	`}`
		963	`$sth->finish();`
		964	`}`
		965	`else`
		966	`{`
		967	`Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );`
		968	`}`
		969	`}`
		970	`else`
		971	`{`
		972	`Error("GetDepends:Prepare failure" );`
		973	`}`
		974	`}`
		975
		976	`#-------------------------------------------------------------------------------`
		977	`# Function : GetAllPackageNames`
		978	`#`
		979	`# Description :`
		980	`#`
		981	`# Inputs : None`
		982	`#`
		983	`# Returns :`
		984	`#`
		985	`sub GetAllPackageNames`
		986	`{`
		987	`# if we are not or cannot connect then return 0 as we have not found anything`
		988	`connectRM(\$RM_DB) unless $RM_DB;`
		989
		990	`#`
		991	`# Now extract all the package names`
		992	`#`
		993	`my $m_sqlstr = "SELECT pkg.PKG_ID, pkg.PKG_NAME" .`
		994	`" FROM RELEASE_MANAGER.PACKAGES pkg";`
		995	`my $sth = $RM_DB->prepare($m_sqlstr);`
		996	`if ( defined($sth) )`
		997	`{`
		998	`if ( $sth->execute( ) )`
		999	`{`
		1000	`if ( $sth->rows )`
		1001	`{`
		1002	`while ( my @row = $sth->fetchrow_array )`
		1003	`{`
		1004	`my $id = $row[0];`
		1005	`my $name = $row[1];`
		1006	`next unless ( $id );`
		1007	`$AllPackages{$id} = $name;`
		1008	`}`
		1009	`}`
		1010	`$sth->finish();`
		1011	`}`
		1012	`else`
		1013	`{`
		1014	`Error("GetAllPackageNames:Execute failure" );`
		1015	`}`
		1016	`}`
		1017	`else`
		1018	`{`
		1019	`Error("GetAllPackageNames:Prepare failure" );`
		1020	`}`
		1021	`}`
		1022
		1023	`#-------------------------------------------------------------------------------`
		1024	`# Function : massageVersion`
		1025	`#`
		1026	`# Description : Process a version number and return usful bits`
		1027	`#`
		1028	`# Inputs : Version Number`
		1029	`# Package Name - debug only`
		1030	`#`
		1031	`# Returns : An array`
		1032	`# suffix`
		1033	`# multipart version string useful for text comparisons`
		1034	`#`
		1035	`sub massageVersion`
		1036	`{`
		1037	`my ($version, $name) = @_;`
		1038	`my ($major, $minor, $patch, $build, $suffix);`
		1039	`my $result;`
		1040	`my $buildVersion;`
		1041	`my $isaRipple;`
		1042	`my $isaWIP;`
		1043	`$build = 0;`
		1044
		1045	`#print "--- $name, $version\n";`
		1046	`$version =~ s~^_~~;`
		1047	`$version =~ s~^\Q${name}\E_~~;`
		1048
		1049	`#`
		1050	`# Pre-massage some silly ones`
		1051	`#`
		1052	`if ( exists $sillyVersions{$version} ) {`
		1053	`$version = $sillyVersions{$version};`
		1054	`}`
395	dpurdie	1055
		1056	`if ( $name eq 'ReleaseName' ) {`
		1057	`$version =~ s~[a-z]~.~g;`
		1058	`$version =~ s~\.+~.~g;`
		1059	`$version =~ s~\.$~~g`
		1060	`}`
		1061
394	dpurdie	1062	`#`
		1063	`# xxxxxxxxx.nnnn.cots`
		1064	`#`
		1065	`if ( $version =~ m~(.*)\.cots$~ ) {`
		1066	`my $cots_base = $1;`
		1067	`$suffix = '.cots';`
		1068	`if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )`
		1069	`{`
		1070	`$result = $1 . sprintf (".%4.4d", $2) . $suffix;`
		1071	`}`
		1072	`else`
		1073	`{`
		1074	`$result = $cots_base . '.0000.cots';`
		1075	`}`
		1076	`}`
		1077	`#`
		1078	`# Convert version into full form for comparisions`
		1079	`# nnn.nnn.nnn.[p]nnn.xxx`
		1080	`# nnn.nnn.nnn.[p]nnn-xxx`
		1081	`# nnn.nnn.nnn-[p]nnn.xxx`
		1082	`# nnn.nnn.nnn-[p]nnn-xxx`
		1083	`# nnn.nnn.nnn[p]nnn-xxx`
		1084	`# Don't flag as ripples - they are patches`
		1085	`#`
		1086	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {`
		1087	`$major = $1;`
		1088	`$minor = $2;`
		1089	`$patch = $3;`
		1090	`$build = $4;`
		1091	`$suffix = defined $6 ? ".$6" : '';`
		1092	`$isaRipple = 0;`
		1093	`}`
		1094	`#`
		1095	`# nn.nnn.nnnnn.xxx`
		1096	`# nn.nnn.nnnnn-xxx`
		1097	`# nnn.nnn.nnnx.xxx`
		1098	`# Don't flag as ripples - they are patches`
		1099	`#`
		1100	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {`
		1101	`$major = $1;`
		1102	`$minor = $2;`
		1103	`$patch = $3;`
		1104	`if ( length( $patch) >= 4 )`
		1105	`{`
		1106	`$build = substr( $patch, -3 ,3);`
		1107	`$patch = substr( $patch, 0 ,length($patch)-3);`
		1108	`}`
		1109	`$suffix = defined $5 ? ".$5" : '';`
		1110	`}`
		1111
		1112	`#`
		1113	`# nnn.nnn.nnn`
		1114	`# nnn.nnn-nnn`
		1115	`# nnn.nnn_nnn`
		1116	`#`
		1117	`elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {`
		1118	`$major = $1;`
		1119	`$minor = $2;`
		1120	`$patch = $3;`
		1121	`$suffix = '';`
		1122	`}`
		1123
		1124	`#`
		1125	`# nnn.nnn.nnn.nnn`
		1126	`# nnn.nnn.nnn-nnn`
		1127	`# nnn.nnn.nnn_nnn`
		1128	`#`
		1129	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {`
		1130	`$major = $1;`
		1131	`$minor = $2;`
		1132	`$patch = $3;`
		1133	`$build = $4;`
		1134	`$suffix = '';`
		1135	`$isaRipple = 0;`
		1136	`}`
		1137
		1138
		1139	`#`
		1140	`# nnn.nnn`
		1141	`#`
		1142	`elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {`
		1143	`$major = $1;`
		1144	`$minor = $2;`
		1145	`$patch = 0;`
		1146	`$suffix = '';`
		1147	`}`
		1148	`#`
		1149	`# nnn.nnn.xxx`
		1150	`#`
		1151	`elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {`
		1152	`$major = $1;`
		1153	`$minor = $2;`
		1154	`$patch = 0;`
		1155	`$suffix = $3;`
		1156	`}`
		1157
		1158	`#`
		1159	`# nnn.nnn.nnnz`
		1160	`#`
		1161	`elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {`
		1162	`$major = $1;`
		1163	`$minor = $2;`
		1164	`$patch = $3;`
		1165	`$build = ord($4) - ord('a');`
		1166	`$suffix = '.cots';`
		1167	`$isaRipple = 0;`
		1168	`}`
		1169	`#`
		1170	`# ???REV=???`
		1171	`#`
		1172	`elsif ( $version =~ m~REV=~ ) {`
		1173	`$suffix = '.cots';`
		1174	`$result = $version . '.0000.cots';`
		1175	`}`
		1176
		1177	`#`
		1178	`# Wip Packages`
		1179	`# (nnnnnn).xxx`
		1180	`# Should be essential, but want to sort very low`
		1181	`#`
		1182	`elsif ($version =~ m~$(.)$(\..)?~) {`
		1183	`$suffix = $2 \|\| '';`
		1184	`$result = "000.000.000.000$suffix";`
		1185	`$isaWIP = 1;`
		1186	`}`
		1187
		1188	`#`
		1189	`# !current`
		1190	`#`
		1191	`elsif ($version eq '!current' \|\| $version eq 'current_$USER' \|\| $version eq 'current' \|\| $version eq 'beta' \|\| $version eq 'latest' \|\| $version eq 'beta.cr' \|\| $version eq 'CREATE') {`
		1192	`$suffix = '';`
		1193	`$result = "000.000.000.000$suffix";`
		1194	`$isaWIP = 1;`
		1195	`}`
		1196
		1197	`#`
		1198	`# Also WIP: FINRUN.103649.BEI.WIP`
		1199	`elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {`
		1200	`$suffix = lc($1);`
		1201	`$result = "000.000.000.000$suffix";`
		1202	`$isaWIP = 1;`
		1203	`}`
		1204
		1205	`#`
		1206	`# Also ERGOFSSLS190100_015`
		1207	`# Don't flag as a ripple`
		1208	`elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {`
		1209	`$major = $1;`
		1210	`$minor = $2;`
		1211	`$patch = $3;`
		1212	`$build = $4;`
		1213	`$suffix = $5 \|\| '.sls';`
		1214	`$isaRipple = 0;`
		1215	`}`
		1216
		1217	`#`
		1218	`# Stuff we don't yet handle`
		1219	`#`
		1220	`else {`
		1221	`Warning ("Unknown version number: $name,$version");`
		1222	`$version =~ m~(\.\w+)$~;`
		1223	`$suffix = $1 \|\| '';`
		1224	`$result = $version;`
		1225	`}`
		1226
		1227	`$isaRipple = ($build > 0) unless defined $isaRipple;`
		1228	`unless ( $result )`
		1229	`{`
		1230	`# Major and minor of 99.99 are normally funny versions`
		1231	`# Don't make important decisions on them`
		1232	`#`
		1233	`if (defined $major && defined $minor && $major == 99 && $minor == 99 )`
		1234	`{`
		1235	`$major = 0;`
		1236	`$minor = 0;`
		1237	`$patch = 0;`
		1238	`}`
		1239
		1240	`$result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix \|\| '.0000');`
		1241	`$buildVersion = [ $major, $minor, $patch, $build ];`
		1242	`}`
		1243
		1244	`$suffix = lc( $suffix );`
		1245	`if ( exists $suffixFixup{$suffix} )`
		1246	`{`
		1247	`$suffix = $suffixFixup{$suffix} ;`
		1248	`}`
		1249
		1250	`return ($suffix, $result, $isaRipple, $isaWIP, $buildVersion );`
		1251	`}`
		1252
		1253
		1254	`#-------------------------------------------------------------------------------`
		1255	`# Function : LocateStrays`
		1256	`#`
		1257	`# Description :`
		1258	`#`
		1259	`# Inputs :`
		1260	`#`
		1261	`# Returns :`
		1262	`#`
		1263	`sub LocateStrays`
		1264	`{`
		1265	`Message ("Locate indirectly referenced packages");`
		1266	`while ( $#StrayPackages >= 0 )`
		1267	`{`
		1268	`my $pv_id = pop @StrayPackages;`
		1269
		1270	`next if ( exists $Packages{$pv_id}{done} );`
		1271	`#print "... ",$#StrayPackages,"\n";`
		1272	`GetDepends( $pv_id);`
		1273	`$Packages{$pv_id}{done} = 1;`
		1274	`}`
		1275	`}`
		1276
		1277	`#-------------------------------------------------------------------------------`
395	dpurdie	1278	`# Function : countPackages`
		1279	`#`
		1280	`# Description :`
		1281	`#`
		1282	`# Inputs :`
		1283	`#`
		1284	`# Returns : Number of packages and number oof versions`
		1285	`#`
		1286	`sub countPackages`
		1287	`{`
		1288	`my $v = 0;`
		1289	`my $p = 0;`
		1290	`my %names;`
		1291
		1292	`foreach ( keys %Packages )`
		1293	`{`
		1294	`my $name = $Packages{$_}{name};`
		1295	`next unless ( $name );`
		1296	`$names{$name} = 1;`
		1297	`$v++;`
		1298	`}`
		1299
		1300	`$p = keys %names;`
		1301
		1302	`return $p,$v;`
		1303
		1304	`}`
		1305
		1306	`#-------------------------------------------------------------------------------`
396	dpurdie	1307	`# Function : processData`
394	dpurdie	1308	`#`
396	dpurdie	1309	`# Description : Process data before its written out`
		1310	`# Remove a few packages that we do not want to now about`
		1311	`# Determine Reason that a version is in the list`
		1312	`# Finish taging packages in NamedProject`
394	dpurdie	1313	`#`
		1314	`# Inputs :`
		1315	`#`
		1316	`# Returns :`
		1317	`#`
396	dpurdie	1318	`sub processData`
394	dpurdie	1319	`{`
		1320	`foreach ( keys %Packages )`
		1321	`{`
		1322	`delete $Packages{$_}{done};`
		1323	`next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );`
		1324
		1325	`if ($Packages{$_}{name} eq 'Activestate Perl - Solaris')`
		1326	`{`
		1327	`delete $Packages{$_};`
		1328	`next;`
		1329	`}`
		1330
		1331	`if ( $Packages{$_}{name} =~ m/^CSW/ \|\| $Packages{$_}{name} =~ m/^Solaris$/)`
		1332	`{`
		1333	`delete $Packages{$_};`
		1334	`next;`
		1335	`}`
		1336
		1337	`if ( $Packages{$_}{name} =~ m/^jats_/)`
		1338	`{`
		1339	`delete $Packages{$_};`
		1340	`next;`
		1341	`}`
396	dpurdie	1342
		1343	`#`
		1344	`# Determine why version is here`
		1345	`# tpl - Top Level Package from a Release`
		1346	`# sbom - Included because of an sbom`
		1347	`#`
		1348	`# tplDepend - Used by a TLP`
		1349	`# sbomDepend - Used by an SBOM`
		1350	`#`
		1351	`# Where there are multiple reasons for inclusion a tlp is more`
		1352	`# significant than a sbom`
		1353	`#`
		1354	`#`
		1355	`if ( exists $Packages{$_}{'tlp'}) {`
		1356	`$Packages{$_}{Reason} = 'tlp';`
		1357
		1358	`} elsif ( exists $Packages{$_}{'sbomBase'}) {`
		1359	`$Packages{$_}{Reason} = 'sbom';`
		1360
		1361	`} elsif ( exists $Packages{$_}{'sbomOsid'}) {`
		1362	`$Packages{$_}{Reason} = 'sbom';`
		1363
		1364	`} else {`
		1365	`my $reason;`
		1366	`my %usedBy;`
		1367	`my @examineThese = @{$Packages{$_}{'usedBy'}};`
		1368	`while ( @examineThese )`
		1369	`{`
		1370	`my $pvid = pop @examineThese;`
		1371	`next if ( $usedBy{$pvid} );`
		1372
		1373	`if ( exists $Packages{$pvid}{Reason} )`
		1374	`{`
		1375	`$reason = $Packages{$pvid}{Reason};`
		1376
		1377	`} elsif ( exists $Packages{$pvid}{'tlp'}) {`
		1378	`$reason = 'tlpDepend';`
		1379	`last;`
		1380
		1381	`} elsif ( exists $Packages{$pvid}{'sbomBase'}) {`
		1382	`$reason = 'sbomDepend';`
		1383
		1384	`} elsif ( exists $Packages{$pvid}{'sbomOsid'}) {`
		1385	`$reason = 'sbomDepend';`
		1386	`}`
		1387
		1388	`push @examineThese, @{$Packages{$pvid}{'usedBy'}}`
		1389	`if (exists $Packages{$pvid}{'usedBy'});`
		1390	`}`
		1391
		1392	`if ( $reason )`
		1393	`{`
		1394	`$Packages{$_}{Reason} = $reason;`
		1395	`}`
		1396	`else`
		1397	`{`
		1398	`Message ("Don't know why I'm here: $_, $Packages{$_}{name} $Packages{$_}{'version'}");`
		1399	`}`
		1400	`}`
		1401
		1402	`#`
		1403	`# Catch packages that are dependents of NamedProject's`
		1404	`#`
		1405	`if ( $doIncludeOnly )`
		1406	`{`
		1407	`if ( exists $Packages{$_}{'sbomBase'} \|\| exists $Packages{$_}{'sbomOsid'} )`
		1408	`{`
		1409	`$Packages{$_}{NamedProject} = 1;`
		1410	`}`
		1411
		1412	`unless ( $Packages{$_}{NamedProject} )`
		1413	`{`
		1414	`my $named;`
		1415	`my %usedBy;`
		1416
		1417	`if ( exists $Packages{$_}{'usedBy'})`
		1418	`{`
		1419	`my @examineThese = @{$Packages{$_}{'usedBy'}};`
		1420	`while ( @examineThese )`
		1421	`{`
		1422	`my $pvid = pop @examineThese;`
		1423	`next if ( $usedBy{$pvid} );`
		1424
		1425	`if ( $Packages{$pvid}{NamedProject} )`
		1426	`{`
		1427	`$named = 1;`
		1428	`last;`
		1429	`}`
		1430
		1431	`push @examineThese, @{$Packages{$pvid}{'usedBy'}}`
		1432	`if (exists $Packages{$pvid}{'usedBy'});`
		1433	`}`
		1434	`$Packages{$_}{NamedProject} = 1`
		1435	`if ( $named );`
		1436	`}`
		1437	`# else`
		1438	`# {`
		1439	`# Warning("Not Named and not usedBy: $Packages{$_}{name} $Packages{$_}{'version'}");`
		1440	`# }`
		1441	`}`
		1442	`}`
		1443	`else`
		1444	`{`
		1445	`$Packages{$_}{NamedProject} = 1;`
		1446	`}`
394	dpurdie	1447	`}`
396	dpurdie	1448	`}`
394	dpurdie	1449
396	dpurdie	1450	`#-------------------------------------------------------------------------------`
		1451	`# Function : outputData`
		1452	`#`
		1453	`# Description : Write out data in a form to allow post processing`
		1454	`#`
		1455	`# Inputs :`
		1456	`#`
		1457	`# Returns :`
		1458	`#`
		1459	`sub outputData`
		1460	`{`
		1461	`my $file = "cc2svn.raw.txt";`
		1462	`Message ("Create: $file");`
		1463	`my $fh = ConfigurationFile::New( $file );`
		1464
394	dpurdie	1465	`$fh->DumpData(`
396	dpurdie	1466	`"\n# Releases.\n#\n",`
		1467	`"ScmReleases", \%Releases );`
		1468
		1469	`$fh->DumpData(`
394	dpurdie	1470	`"\n# Packages.\n#\n",`
		1471	`"ScmPackages", \%Packages );`
		1472
		1473	`$fh->DumpData(`
		1474	`"\n# Suffixes.\n#\n",`
		1475	`"ScmSuffixes", \%Suffixes );`
		1476
		1477	`$fh->DumpData(`
		1478	`"\n# All Package Names.\n#\n",`
		1479	`"ScmAllPackages", \%AllPackages );`
		1480
		1481	`#`
		1482	`# Just for debug`
		1483	`#`
395	dpurdie	1484	`#`
		1485	`# Remove unused SBOMs`
		1486	`#`
		1487	`my %AllBomProjects;`
		1488	`foreach ( keys %sboms )`
		1489	`{`
		1490	`if ( $sboms{$_}{needed} )`
		1491	`{`
		1492	`my $project_id = $sboms{$_}{project_id};`
		1493	`$AllBomProjects{$project_id}{project_name} = $sboms{$_}{project_name};`
		1494	`next;`
		1495	`}`
		1496	`delete $sboms{$_};`
		1497	`}`
		1498
		1499	`$fh->DumpData("\n# All Bom Projects.\n#\n", "ScmAllBomProjects", \%AllBomProjects );`
394	dpurdie	1500	`$fh->DumpData("\n# All SBOMS.\n#\n", "ScmSboms", \%sboms );`
395	dpurdie	1501	`# $fh->DumpData("\n# All os_id_list.\n#\n", "ScmOsIdList", \%os_id_list );`
		1502	`# $fh->DumpData("\n# All os_env_list.\n#\n", "ScmOsEnvList", \%os_env_list );`
		1503	`# $fh->DumpData("\n# All sbom_pvid.\n#\n", "ScmSbomPVID", \%sbom_pvid );`
394	dpurdie	1504
		1505	`#`
		1506	`# Close out the file`
		1507	`#`
		1508	`$fh->Close();`
		1509
		1510	`# #`
		1511	`# # Split up package data into small files for easy consumption`
		1512	`# #`
		1513	`#`
		1514	`# foreach ( keys %Packages )`
		1515	`# {`
		1516	`# my $file = "cc2svn.raw.${_}.txt";`
		1517	`# Message ("Create: $file");`
		1518	`# my $fh = ConfigurationFile::New( $file );`
		1519	`#`
		1520	`# $fh->DumpData(`
		1521	`# "\n# Releases.\n#\n",`
		1522	`# "ScmReleases", \$Packages{$_} );`
		1523	`# $fh->Close();`
		1524	`# }`
		1525
		1526	`}`
		1527
		1528
		1529	`#-------------------------------------------------------------------------------`
		1530	`# Documentation`
		1531	`#`
		1532
		1533	`=pod`
		1534
		1535	`=for htmltoc SYSUTIL::cc2svn::`
		1536
		1537	`=head1 NAME`
		1538
		1539	`cc2svn_gendata - Extract CC2SVN Essential Package Data from Release Manager`
		1540
		1541	`=head1 SYNOPSIS`
		1542
		1543	`jats cc2svn_gendata [options]`
		1544
		1545	`Options:`
		1546	`-help - brief help message`
		1547	`-help -help - Detailed help message`
		1548	`-man - Full documentation`
		1549	`-test=version - Test a version string, then exit`
		1550	`-limit=n - Limit packages processed. Test only`
395	dpurdie	1551	`-mode=xxx - Set Mode: all, hops, standard`
		1552	`-[no]sbom - Include SBOM versions. Default: Yes`
394	dpurdie	1553
		1554	`=head1 OPTIONS`
		1555
		1556	`=over 8`
		1557
		1558	`=item B<-help>`
		1559
		1560	`Print a brief help message and exits.`
		1561
		1562	`=item B<-help -help>`
		1563
		1564	`Print a detailed help message with an explanation for each option.`
		1565
		1566	`=item B<-man>`
		1567
		1568	`Prints the manual page and exits.`
		1569
		1570	`=item B<-test=version>`
		1571
		1572	`Examine a package version string and report how the tool will parse it.`
		1573
		1574	`=item B<-limit=n>`
		1575
		1576	`Limit the number of packages processed by the tool. This is only used to`
		1577	`simplify testing of the program`
		1578
		1579	`=back`
		1580
		1581	`=head1 DESCRIPTION`
		1582
		1583	`This program is a tool used in the conversion of ClearCase VOBS to subversion.`
		1584	`It will:`
		1585
		1586	`=over 8`
		1587
		1588	`=item *`
		1589
		1590	`Determine all Releases in Release manager and mark those that`
		1591	`are to be excluded.`
		1592
		1593	`=item *`
		1594
		1595	`Determine all the package-versions used by the releases that are`
		1596	`not excluded. These are called 'direct' dependencies.`
		1597
		1598	`=item *`
		1599
		1600	`Recursively find all the dependent packages of all packages. New package`
		1601	`versions are called 'indirect' dependencies. They are buried. This process can`
		1602	`take several minutes.`
		1603
		1604	`=back`
		1605
		1606	`The data collected is dumped into a text file for later processing.`
		1607
		1608	`=cut`
		1609

Subversion Repositories DevTools

(root)/core_devl/branches/gitBuilder/TOOLS/LOCAL/cc2svn_gendata_sbom.pl – Rev 396