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

Subversion Repositories DevTools

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