WebSVN – DevTools – Blame – /core_devl/branches/gitBuilder/TOOLS/escrow.pl

Rev	Author	Line No.	Line
227	dpurdie	1	`########################################################################`
281	dpurdie	2	`# Copyright ( C ) 2009 ERG Limited, All rights reserved`
227	dpurdie	3	`#`
281	dpurdie	4	`# Module name : escrow.pl`
227	dpurdie	5	`# Module type : Makefile system`
281	dpurdie	6	`# Compiler(s) : Perl`
		7	`# Environment(s): jats build system`
227	dpurdie	8	`#`
		9	`# Description : Determine packages from an SBOM for escrow purposes`
		10	`# For a given bom_id determine all used packages`
		11	`# Create various bits of useful information`
		12	`# Extract commands`
		13	`# Build Order`
		14	`# Depenendency Info`
		15	`# Bad Packages`
		16	`#`
		17	`#......................................................................#`
		18
255	dpurdie	19	`require 5.006_001;`
227	dpurdie	20	`use strict;`
		21	`use warnings;`
		22	`use JatsEnv;`
		23	`use JatsError;`
		24	`use JatsSystem;`
		25	`use JatsRmApi;`
		26	`use DBI;`
		27	`use Getopt::Long;`
		28	`use Pod::Usage; # required for help support`
		29	`use Storable qw (dclone);`
		30
		31	`#`
		32	`# Config Options`
		33	`#`
		34	`my $VERSION = "1.0.0"; # Update this`
		35	`my $opt_help = 0;`
		36	`my $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbose`
		37	`my $opt_sbom_id;`
		38	`my $opt_rtag_id;`
		39	`my $opt_test = 0;`
		40	`my $opt_patch = 1;`
		41	`my $opt_extract;`
233	dpurdie	42	`my $opt_rootpkg;`
295	dpurdie	43	`my $opt_rootpkg_version;`
227	dpurdie	44
		45	`#`
		46	`# Data Base Interface`
		47	`#`
		48	`my $RM_DB;`
		49	`my $DM_DB;`
		50
		51	`#`
		52	`# Global variables`
		53	`#`
		54	`my %os_id_list; # os_id in the SBOM`
		55	`my %os_env_list; # OS Environments`
		56	`my %pv_id; # Packages in the SBOM`
		57	`my %Package; # Per Package information`
		58	`my %Release; # Release information`
		59	`my %Release_pvid; # Release info`
		60	`my @StrayPackages; # Non-top level packages`
		61	`my @create_list; # List of files created`
		62	`my $fpref = "sbom"; # Sbom Prefix`
		63	`our $GBE_RM_URL;`
		64	`our $GBE_DM_URL;`
295	dpurdie	65	`my $sbom_name;`
		66	`my $sbom_branch;`
		67	`my $sbom_project;`
		68	`my $sbom_version;`
		69	`my $rtag_release;`
		70	`my $rtag_project;`
227	dpurdie	71
		72	`#`
		73	`# Constants, that should be variable`
		74	`#`
		75	`my $rm_base = "/dependencies.asp?pv_id=";`
		76	`my $dm_base = "/OsDefault.asp?bom_id=BOMID&os_id=";`
		77
		78	`#`
		79	`# Build types. Should be populated from a table`
		80	`#`
		81	`my %BM_ID = (`
		82	`1 => "Solaris",`
		83	`2 => "Win32",`
		84	`3 => "Linux",`
		85	`4 => "Generic",`
		86	`);`
		87
		88	`my %BSA_ID = (`
		89	`1 => "Jats Debug",`
		90	`2 => "Jats Prod",`
		91	`3 => "Jats Debug+Prod",`
		92	`4 => "Ant Java 1.4",`
		93	`5 => "Ant Java 1.5",`
		94	`6 => "Ant Java 1.6",`
		95	`);`
		96
		97	`#`
		98	`# Packages to be ignored`
		99	`#`
		100	`my %ignore;`
		101	`my %patch;`
		102
		103
		104	`#-------------------------------------------------------------------------------`
		105	`# Function : Main`
		106	`#`
		107	`# Description : Main entry point`
		108	`# Parse user options`
		109	`#`
		110	`# Inputs :`
		111	`#`
		112	`# Returns :`
		113	`#`
		114
		115	`my $result = GetOptions (`
281	dpurdie	116	`"help:+" => \$opt_help, # flag, multiple use allowed`
		117	`"manual:3" => \$opt_help, # flag, multiple use allowed`
		118	`"verbose:+" => \$opt_verbose, # flag`
227	dpurdie	119	`"sbomid=s" => \$opt_sbom_id, # string`
279	dpurdie	120	`"sbom_id=s" => \$opt_sbom_id, # string`
227	dpurdie	121	`"rtagid=s" => \$opt_rtag_id, # string`
279	dpurdie	122	`"rtag_id=s" => \$opt_rtag_id, # string`
233	dpurdie	123	`"rootpackage=s" => \$opt_rootpkg, # String`
227	dpurdie	124	`"ignore=s", => sub{my ($a,$i) = @_; $ignore{$i} = 0 },`
		125	`"test!" => \$opt_test, #[no]flag`
		126	`"patch!" => \$opt_patch, #[no]flag`
		127	`"extract=s" => \$opt_extract, # Name of file`
		128	`);`
		129
		130	`#`
		131	`# Process help and manual options`
		132	`#`
		133	`pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 \|\| ! $result);`
		134	`pod2usage(-verbose => 1) if ($opt_help == 2 );`
281	dpurdie	135	`pod2usage(-verbose => 2) if ($opt_help > 2);`
227	dpurdie	136
		137	`ErrorConfig( 'name' => 'ESCROW',`
		138	`'verbose' => $opt_verbose );`
		139
		140	`#`
		141	`# Sanity test`
		142	`#`
281	dpurdie	143	`unless ( $opt_rtag_id \|\| $opt_sbom_id \|\| $opt_extract \|\| $#ARGV >= 1)`
227	dpurdie	144	`{`
		145	`Error ("Need sbomid and/or rtagid, or -extract",`
		146	`"Example: -sbomid=13543, for NZS Phase-1",`
		147	`"Example: -sbomid=13543 -rtagid=xxxx, for NZS Phase-1, comapred against given release",`
		148	`"Example: -rtagid=2362, for Sydney R1/R2",`
235	dpurdie	149	`"Example: -rtagid=8843 -root=StockholmSBOM",`
281	dpurdie	150	`"Example: PackageName PackageVersion, for extracting a single package",`
227	dpurdie	151	`)`
		152	`}`
		153
		154	`#`
		155	`# The extract option is special`
		156	`# It places the progam in a different mode`
		157	`#`
		158	`if ( $opt_extract )`
		159	`{`
		160	`Error ("Cannot mix -extract with sbomid or rtagid" )`
281	dpurdie	161	`if ( $opt_rtag_id \|\| $opt_sbom_id \|\| $#ARGV >= 0 );`
227	dpurdie	162
287	dpurdie	163	`Error ("Cannot use -nopatch or -ignore with -extract")`
		164	`if ( ! $opt_patch \|\| keys %ignore );`
		165
227	dpurdie	166	`extract_files();`
		167	`exit (0);`
		168	`}`
		169
		170	`Warning ("No sbomid provided. Output based an a Release") unless ( $opt_sbom_id );`
		171	`$dm_base =~ s~BOMID~$opt_sbom_id~ if ($opt_sbom_id);`
		172	`$fpref = "release" unless ( $opt_sbom_id );`
		173
		174	`#`
		175	`# Import essential EnvVars`
		176	`#`
		177	`EnvImport('GBE_RM_URL');`
		178	`EnvImport('GBE_DM_URL');`
		179
		180	`$rm_base = $GBE_RM_URL . $rm_base;`
		181	`$dm_base = $::GBE_DM_URL . $dm_base;`
		182
		183	`if ( $opt_sbom_id )`
		184	`{`
		185	`#`
		186	`# Determines the OS_ID's for the bom`
		187	`#`
		188	`getOSIDforBOMID($opt_sbom_id);`
295	dpurdie	189	`getSBOMDetails($opt_sbom_id);`
227	dpurdie	190
		191	`#`
		192	`# Locate packages associated with the base install for each os`
		193	`#`
		194	`foreach my $base_env_id ( sort keys %os_env_list )`
		195	`{`
		196	`getPackagesforBaseInstall( $base_env_id );`
		197	`}`
		198
		199	`#`
		200	`# Determine all the top level packages in the BOM`
		201	`#`
		202	`foreach my $os_id ( sort keys %os_id_list )`
		203	`{`
		204	`getPackages_by_osid( $os_id );`
		205	`}`
		206
		207	`#`
		208	`# For each Top Level Package determine the dependent packages`
		209	`#`
281	dpurdie	210	`getPkgDetailsForPVIDs (keys %pv_id);`
285	dpurdie	211	`LocateStrays(0);`
227	dpurdie	212
		213	`#`
		214	`# Determine packages in a given Release`
		215	`#`
		216	`if ( $opt_rtag_id )`
		217	`{`
		218	`getPkgDetailsByRTAG_ID( $opt_rtag_id );`
		219	`}`
		220	`}`
281	dpurdie	221	`elsif ( $opt_rtag_id )`
227	dpurdie	222	`{`
		223	`getPkgDetailsByRTAG_ID( $opt_rtag_id );`
233	dpurdie	224	`if ( $opt_rootpkg )`
227	dpurdie	225	`{`
233	dpurdie	226	`#`
		227	`# Base the report on a single package in a release`
		228	`# Determine the package`
		229	`#`
		230	`Error ("Root Package not found: $opt_rootpkg") unless ( exists $Release{$opt_rootpkg} );`
		231	`my @root_vers = keys %{$Release{$opt_rootpkg}};`
		232	`Error ("Multiple versions of Root Package: $opt_rootpkg", @root_vers ) if ( $#root_vers > 0 );`
295	dpurdie	233	`$opt_rootpkg_version = $root_vers[0];`
		234	`Message("Root Package: $opt_rootpkg, " . $opt_rootpkg_version);`
233	dpurdie	235
295	dpurdie	236	`getPkgDetailsByPV_ID( $Release{$opt_rootpkg}{$opt_rootpkg_version}{pv_id} );`
227	dpurdie	237	`}`
233	dpurdie	238	`else`
		239	`{`
281	dpurdie	240	`getPkgDetailsForPVIDs (keys %Release_pvid);`
233	dpurdie	241	`}`
		242	`LocateStrays(1);`
227	dpurdie	243	`}`
281	dpurdie	244	`elsif ( $#ARGV >= 1 )`
		245	`{`
		246	`#`
		247	`# Locate package and dependents`
		248	`# Convert package name into a PVID`
		249	`#`
		250	`my $pv_id = getPkgDetailsByName( @ARGV );`
		251	`Error ("Cannot locate package by name and version: @ARGV")`
		252	`unless ( $pv_id );`
227	dpurdie	253
281	dpurdie	254	`#`
		255	`# Set package as the root package`
		256	`$opt_rootpkg = $ARGV[0];`
295	dpurdie	257	`$opt_rootpkg_version = $ARGV[1];`
281	dpurdie	258	`getPkgDetailsByPV_ID( $pv_id );`
		259	`LocateStrays(2);`
		260	`}`
		261	`else`
		262	`{`
		263	`Error ("Don't know what to do with common line arguments provided");`
		264	`}`
227	dpurdie	265
281	dpurdie	266
227	dpurdie	267	`#`
		268	`# Remove packages to be ignored`
		269	`#`
		270	`foreach my $pkg ( keys %ignore )`
		271	`{`
		272	`delete $Package{$pkg};`
		273	`}`
		274
		275	`##`
		276	`## Display a list of all packages found so far`
		277	`##`
		278	`#foreach my $name ( sort keys %Package )`
		279	`#{`
		280	`# foreach my $ver ( sort keys %{$Package{$name}} )`
		281	`# {`
		282	`#`
		283	`# my $label = $Package{$name}{$ver}{label} \|\| '';`
		284	`# my $path = $Package{$name}{$ver}{path} \|\| '';`
		285	`#`
		286	`# printf ("%30s %15s %45s %s\n", $name, $ver, $label, $path );`
		287	`# }`
		288	`#}`
		289
		290	`#`
		291	`# Generate output files`
		292	`# 1) Jats extract commands`
		293	`# 2) Error list`
		294	`my $file;`
		295	`$file = "${fpref}_extract.txt";`
		296	`push @create_list, $file;`
		297	`open (JE, ">$file" ) \|\| Error ("Cannot create $file");`
		298
		299	`$file = "${fpref}_status.txt";`
		300	`push @create_list, $file;`
		301
		302	`open (ST, ">$file" ) \|\| Error("Cannot create $file");`
		303	`print ST "Cannot build:\n";`
		304
		305	`foreach my $name ( sort keys %Package )`
		306	`{`
		307	`foreach my $ver ( sort keys %{$Package{$name}} )`
		308	`{`
		309
		310	`my $label = $Package{$name}{$ver}{label} \|\| '';`
		311	`my $path = $Package{$name}{$ver}{path} \|\| '';`
		312	`my $mtest = exists ($Package{$name}{$ver}{build} ) \|\| '0';`
		313	`my @reason1; # can't extract files`
		314	`my @reason2; # Others`
		315
		316	`push @reason1, 'No Label' unless ( $label );`
		317	`push @reason1, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i \|\| $label =~ s~^na$~~i );`
		318
		319	`push @reason1, 'No Source Path' unless ( $path );`
		320	`push @reason1, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i \|\| $path =~ m~^na$~i );`
		321	`push @reason1, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ \|\| $path =~ m~^dpkg_archive~ );`
		322	`push @reason1, 'Bad Path, http' if ( $path =~ m~^http:~i );`
		323	`push @reason1, 'Bad Path, Drive' if ( $path =~ m~^[A-Za-z]\:~ );`
		324	`push @reason1, 'Bad Path, UNC' if ( $path =~ m~^//~ );`
		325	`push @reason1, 'Bad Path, Relative' unless ( $path =~ m~^/~ );`
		326
		327
		328	`push @reason2, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );`
		329
		330	`unless ( @reason1 )`
		331	`{`
		332	`my $vname = "$name $ver";`
		333	`$vname =~ s~ ~_~g;`
		334	`$vname =~ s~__~~g;`
		335
243	dpurdie	336	`print JE "jats extract -extractfiles \"-view=$vname\" \"-label=$label\" \"-path=$path\" -root=. -noprefix\n";`
227	dpurdie	337	`}`
		338
		339	`if ( @reason1 \|\| @reason2 )`
		340	`{`
		341	`$Package{$name}{$ver}{bad_extract} = [@reason1, @reason2];`
		342	`printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;`
		343	`}`
		344	`}`
		345	`}`
		346
		347	`close (JE);`
		348	`close (ST);`
		349
		350	`#`
		351	`# Generate build order info`
		352	`#`
		353	`BuildOrder();`
		354
		355	`#`
		356	`# Generate HTML depenedancy information and other useful stuff`
		357	`#`
		358	`GenerateHTML();`
241	dpurdie	359	`GenerateHTMLLodgement();`
227	dpurdie	360
		361
		362	`#`
		363	`# Display names of files created`
		364	`#`
		365	`foreach my $file ( sort @create_list )`
		366	`{`
		367	`Message ("Created: $file");`
		368	`}`
		369	`exit;`
		370
		371
		372	`#-------------------------------------------------------------------------------`
295	dpurdie	373	`# Function : getSBOMDetails`
		374	`#`
		375	`# Description : Get some details about the SBOM`
		376	`# Used fro descriptive text`
		377	`#`
		378	`# Inputs : $bom_id - BOM to process`
		379	`#`
		380	`# Returns :`
		381	`#`
		382	`sub getSBOMDetails`
		383	`{`
		384	`my ($bom_id) = @_;`
		385	`my $foundDetails = 0;`
		386	`my (@row);`
		387	`Verbose ("getSBOMDetails");`
		388	`connectDM(\$DM_DB) unless ($DM_DB);`
		389
		390	`my $m_sqlstr = "SELECT distinct dp.PROJ_NAME ,bn.BOM_NAME, br.BRANCH_NAME, bm.BOM_VERSION, bm.BOM_LIFECYCLE" .`
		391	`" FROM DEPLOYMENT_MANAGER.BOMS bm, DEPLOYMENT_MANAGER.BOM_NAMES bn, DEPLOYMENT_MANAGER.BRANCHES br, DEPLOYMENT_MANAGER.DM_PROJECTS dp" .`
		392	`" 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";`
		393
		394	`my $sth = $DM_DB->prepare($m_sqlstr);`
		395	`if ( defined($sth) )`
		396	`{`
		397	`if ( $sth->execute( ) )`
		398	`{`
		399	`if ( $sth->rows )`
		400	`{`
		401	`while ( @row = $sth->fetchrow_array )`
		402	`{`
		403	`$sbom_project = $row[0];`
		404	`$sbom_name = $row[1];`
		405	`$sbom_branch = $row[2];`
		406	`$sbom_version = $row[3] . '.' . $row[4];`
		407	`$foundDetails = 1;`
		408	`}`
		409	`}`
		410	`$sth->finish();`
		411	`}`
		412	`else`
		413	`{`
		414	`Error("getSBOMDetails:Execute failure", $m_sqlstr );`
		415	`}`
		416	`}`
		417	`else`
		418	`{`
		419	`Error("getSBOMDetails:Prepare failure" );`
		420	`}`
		421
		422	`Error("getSBOMDetails:No OS Information Found" ) unless $foundDetails;`
		423
		424	`}`
		425
		426	`#-------------------------------------------------------------------------------`
		427	`# Function : getReleaseDetails`
		428	`#`
		429	`# Description : Get some details about the Release`
		430	`# Used fro descriptive text`
		431	`#`
		432	`# Inputs : $rtag_id - RTAG_ID to process`
		433	`#`
		434	`# Returns :`
		435	`#`
		436	`sub getReleaseDetails`
		437	`{`
		438	`my ($rtag_id) = @_;`
		439	`my $foundDetails = 0;`
		440	`my (@row);`
		441	`Verbose ("getReleaseDetails");`
		442	`connectDM(\$DM_DB) unless ($DM_DB);`
		443
		444	`my $m_sqlstr = "SELECT distinct rt.RTAG_NAME, pr.PROJ_NAME" .`
		445	`" FROM RELEASE_MANAGER.RELEASE_TAGS rt, RELEASE_MANAGER.PROJECTS pr" .`
		446	`" WHERE rt.RTAG_ID = $rtag_id AND rt.PROJ_ID = pr.PROJ_ID";`
		447
		448	`my $sth = $DM_DB->prepare($m_sqlstr);`
		449	`if ( defined($sth) )`
		450	`{`
		451	`if ( $sth->execute( ) )`
		452	`{`
		453	`if ( $sth->rows )`
		454	`{`
		455	`while ( @row = $sth->fetchrow_array )`
		456	`{`
		457	`$rtag_release = $row[0];`
		458	`$rtag_project = $row[1];`
		459	`$foundDetails = 1;`
		460	`}`
		461	`}`
		462	`$sth->finish();`
		463	`}`
		464	`else`
		465	`{`
		466	`Error("getReleaseDetails:Execute failure", $m_sqlstr );`
		467	`}`
		468	`}`
		469	`else`
		470	`{`
		471	`Error("getReleaseDetails:Prepare failure" );`
		472	`}`
		473
		474	`Error("getReleaseDetails:No OS Information Found" ) unless $foundDetails;`
		475
		476	`}`
		477
		478
		479
		480	`#-------------------------------------------------------------------------------`
227	dpurdie	481	`# Function : getOSIDforBOMID`
		482	`#`
		483	`# Description : Get all the os_id's associated with a BOMID`
		484	`#`
		485	`# Inputs : $bom_id - BOM to process`
		486	`#`
		487	`# Returns :`
		488	`#`
		489
		490	`sub getOSIDforBOMID`
		491	`{`
		492	`my ($bom_id) = @_;`
		493	`my $foundDetails = 0;`
		494	`my (@row);`
233	dpurdie	495	`Verbose ("getOSIDforBOMID");`
227	dpurdie	496	`connectDM(\$DM_DB) unless ($DM_DB);`
		497
		498	`my $m_sqlstr = "SELECT distinct os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .`
289	dpurdie	499	`" FROM DEPLOYMENT_MANAGER.OPERATING_SYSTEMS os, DEPLOYMENT_MANAGER.BOM_CONTENTS bc, DEPLOYMENT_MANAGER.NETWORK_NODES nn, DEPLOYMENT_MANAGER.OS_BASE_ENV obe" .`
227	dpurdie	500	`" WHERE bc.BOM_ID = $bom_id AND bc.NODE_ID = os.NODE_ID AND nn.NODE_ID = os.NODE_ID AND obe.OS_ID = os.OS_ID ";`
		501
		502	`my $sth = $DM_DB->prepare($m_sqlstr);`
		503	`if ( defined($sth) )`
		504	`{`
		505	`if ( $sth->execute( ) )`
		506	`{`
		507	`if ( $sth->rows )`
		508	`{`
		509	`while ( @row = $sth->fetchrow_array )`
		510	`{`
		511	`Verbose ("OS_ID: ".join (',',@row) );`
		512	`$os_id_list{$row[0]}{os_name} = $row[1];`
		513	`$os_id_list{$row[0]}{node_name} = $row[2];`
		514
		515	`$os_env_list{$row[3]}{needed} = 1;`
		516	`$os_env_list{$row[3]}{os_id}{$row[0]} = 1;`
233	dpurdie	517
		518	`$foundDetails = 1;`
227	dpurdie	519	`}`
		520	`}`
		521	`$sth->finish();`
		522	`}`
233	dpurdie	523	`else`
		524	`{`
		525	`Error("getOSIDforBOMID:Execute failure" );`
		526	`}`
227	dpurdie	527	`}`
		528	`else`
		529	`{`
		530	`Error("getOSIDforBOMID:Prepare failure" );`
		531	`}`
233	dpurdie	532
		533	`Error("getOSIDforBOMID:No OS Information Found" ) unless $foundDetails;`
		534
227	dpurdie	535	`}`
		536
		537	`#-------------------------------------------------------------------------------`
		538	`# Function : getPackagesforBaseInstall`
		539	`#`
		540	`# Description : Get all the packages for a given base install`
		541	`#`
		542	`# Inputs :`
		543	`#`
		544	`# Returns :`
		545	`#`
		546
		547	`sub getPackagesforBaseInstall`
		548	`{`
		549	`my ($base_env_id) =@_;`
		550	`my $foundDetails = 0;`
		551	`my (@row);`
		552
		553	`connectDM(\$DM_DB) unless ($DM_DB);`
		554
		555	`# First get details from pv_id`
		556
		557	`my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .`
289	dpurdie	558	`" FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd, DEPLOYMENT_MANAGER.BASE_ENV_CONTENTS bec".`
227	dpurdie	559	`" WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";`
		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	`$pv_id{$pv_id}{pkg_name} =$name;`
		577	`$pv_id{$pv_id}{pkg_ver} = $ver;`
		578	`foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )`
		579	`{`
		580	`$pv_id{$pv_id}{os_id}{$os_id} = 2;`
		581	`}`
		582	`}`
		583	`}`
		584	`$sth->finish();`
		585	`}`
		586	`else`
		587	`{`
		588	`Error ("getPackagesforBaseInstall: Execute error");`
		589	`}`
		590	`}`
		591	`else`
		592	`{`
		593	`Error("getPackagesforBaseInstall:Prepare failure" );`
		594	`}`
		595
		596	`}`
		597
		598
		599	`#-------------------------------------------------------------------------------`
		600	`# Function : getPackages_by_osid`
		601	`#`
		602	`# Description : Get all the packages used by a given os_id`
		603	`#`
		604	`# Inputs :`
		605	`#`
		606	`# Returns :`
		607	`#`
		608
		609	`my $count = 0;`
		610	`sub getPackages_by_osid`
		611	`{`
		612	`my ($os_id) =@_;`
		613	`my $foundDetails = 0;`
		614	`my (@row);`
		615
		616	`connectDM(\$DM_DB) unless ($DM_DB);`
		617
		618	`# First get details from pv_id`
		619
		620	`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" .`
289	dpurdie	621	`" FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd,".`
227	dpurdie	622	`"(" .`
		623	`" SELECT osc.seq_num, osc.prod_id".`
289	dpurdie	624	`" FROM DEPLOYMENT_MANAGER.os_contents osc".`
227	dpurdie	625	`" WHERE osc.os_id = $os_id" .`
		626	`" ) osc" .`
		627	`" WHERE pd.PROD_ID (+)= pv.PV_ID" .`
		628	`" AND pv.pkg_id = pkg.pkg_id" .`
		629	`" AND osc.PROD_ID = pv.pv_id" .`
		630	`" ORDER BY osc.SEQ_NUM desc" ;`
		631
		632	`my $sth = $DM_DB->prepare($m_sqlstr);`
		633	`if ( defined($sth) )`
		634	`{`
		635	`if ( $sth->execute( ) )`
		636	`{`
		637	`if ( $sth->rows )`
		638	`{`
		639	`while ( @row = $sth->fetchrow_array )`
		640	`{`
		641	`next if ( $opt_test && ++$count > 2 );`
		642	`Verbose ("SBOM Package:".join (',',@row) );`
		643	`my $pv_id = $row[8];`
		644	`my $name = $row[2] \|\| 'BadName';`
		645	`my $ver = $row[3] \|\| 'BadVer';`
		646
		647	`$pv_id{$pv_id}{pkg_name} =$name;`
		648	`$pv_id{$pv_id}{pkg_ver} = $ver;`
		649	`$pv_id{$pv_id}{os_id}{$os_id} = 1;`
		650	`}`
		651	`}`
		652	`$sth->finish();`
		653	`}`
		654	`}`
		655	`else`
		656	`{`
		657	`Error("getPackages_by_osid:Prepare failure" );`
		658	`}`
		659	`}`
		660
		661	`#-------------------------------------------------------------------------------`
		662	`# Function : getPkgDetailsByPV_ID`
		663	`#`
		664	`# Description : Populate the Packages structure given a PV_ID`
		665	`# Called for each package in the SBOM`
		666	`#`
		667	`# Inputs : PV_ID - Package Unique Identifier`
		668	`#`
		669	`# Returns : Populates Package`
		670	`#`
		671	`sub getPkgDetailsByPV_ID`
		672	`{`
		673	`my ($PV_ID) = @_;`
		674	`my $foundDetails = 0;`
		675	`my (@row);`
		676
		677	`connectRM(\$RM_DB) unless ($RM_DB);`
		678
		679	`# First get details from pv_id`
		680
241	dpurdie	681	`my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.PKG_LABEL, pv.SRC_PATH, pv.IS_DEPLOYABLE, pbi.BSA_ID, pbi.BM_ID, PV_DESCRIPTION" .`
289	dpurdie	682	`" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_BUILD_INFO pbi" .`
227	dpurdie	683	`" WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";`
		684
		685	`my $sth = $RM_DB->prepare($m_sqlstr);`
		686	`if ( defined($sth) )`
		687	`{`
		688	`if ( $sth->execute( ) )`
		689	`{`
		690	`if ( $sth->rows )`
		691	`{`
		692	`while ( @row = $sth->fetchrow_array )`
		693	`{`
		694	`my $pv_id = $row[0];`
		695	`my $name = $row[1];`
		696	`my $ver = $row[2];`
		697	`my $label = $row[3] \|\| '';`
		698	`my $path = $row[4] \|\| '';`
		699	`my $deployable = $row[5];`
		700	`my $build_info = $row[6] \|\| '';`
		701	`my $build_mach = $row[7] \|\| '';`
241	dpurdie	702	`my $description = $row[8] \|\| '';`
227	dpurdie	703
		704	`#`
		705	`# BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5`
		706	`# BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic`
		707	`#`
		708
		709
		710	`#`
		711	`# Does it look like a patch`
		712	`# We may want to ignore it.`
		713	`#`
		714	`my $patch = "";`
		715	`unless ( $opt_patch )`
		716	`{`
		717	`if ( $ver =~ m~\.p\d+.\w+$~ )`
		718	`{`
		719	`$patch = "Patch";`
		720	`$patch{$name} = 0`
		721	`unless ( exists $patch{$name} );`
		722	`$patch{$name}++;`
		723	`}`
		724	`}`
		725	`Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch");`
		726	`next if ( $patch );`
		727
		728
		729	`if ( exists $ignore{$name} )`
		730	`{`
		731	`Verbose2( " Ignoring: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch\n");`
		732	`$ignore{$name}++;`
		733	`last;`
		734	`}`
		735
229	dpurdie	736	`$path =~ tr~\\/~/~;`
227	dpurdie	737
		738	`$Package{$name}{$ver}{pvid} = $PV_ID;`
		739	`$Package{$name}{$ver}{done} = 1;`
		740	`$Package{$name}{$ver}{base} = 1;`
		741	`$Package{$name}{$ver}{deployable} = 1 if ($deployable);`
		742	`$Package{$name}{$ver}{label} = $label;`
		743	`$Package{$name}{$ver}{path} = $path;`
		744	`$Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;`
241	dpurdie	745	`$Package{$name}{$ver}{description} = $description;`
227	dpurdie	746
		747	`GetDepends( $pv_id, $name, $ver );`
		748
		749	`}`
		750	`}`
		751	`else`
		752	`{`
		753	`Warning ("No Package details for: PVID: $PV_ID");`
		754	`}`
		755	`$sth->finish();`
		756	`}`
		757	`else`
		758	`{`
		759	`Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );`
		760	`}`
		761	`}`
		762	`else`
		763	`{`
		764	`Error("Prepare failure" );`
		765	`}`
		766	`}`
		767
		768	`#-------------------------------------------------------------------------------`
281	dpurdie	769	`# Function : getPkgDetailsByName`
		770	`#`
		771	`# Description : Determine the PVID for a given package name and version`
		772	`#`
		773	`# Inputs : $pname - Package name`
		774	`# $pver - Package Version`
		775	`#`
		776	`# Returns :`
		777	`#`
		778
		779	`sub getPkgDetailsByName`
		780	`{`
		781	`my ($pname, $pver) = @_;`
		782	`my $pv_id;`
		783	`my (@row);`
		784
		785	`connectRM(\$RM_DB) unless ($RM_DB);`
		786
		787	`# First get details for a given package version`
		788
		789	`my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .`
289	dpurdie	790	`" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .`
281	dpurdie	791	`" WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";`
		792	`my $sth = $RM_DB->prepare($m_sqlstr);`
		793	`if ( defined($sth) )`
		794	`{`
		795	`if ( $sth->execute( ) )`
		796	`{`
		797	`if ( $sth->rows )`
		798	`{`
		799	`while ( @row = $sth->fetchrow_array )`
		800	`{`
		801	`$pv_id = $row[0];`
		802	`my $name = $row[1];`
		803	`my $ver = $row[2];`
		804	`Verbose( "getPkgDetailsByName :PV_ID= $pv_id");`
		805	`}`
		806	`}`
		807	`$sth->finish();`
		808	`}`
		809	`}`
		810	`else`
		811	`{`
		812	`Error("Prepare failure" );`
		813	`}`
		814	`return $pv_id;`
		815	`}`
		816
		817	`#-------------------------------------------------------------------------------`
		818	`# Function : getPkgDetailsForPVIDs`
		819	`#`
		820	`# Description : Get all package details by PVID, from a list of PVIDs`
		821	`#`
		822	`# Inputs : List of PVID's to process`
		823	`#`
		824	`# Returns : Nothing`
		825	`#`
		826	`sub getPkgDetailsForPVIDs`
		827	`{`
		828
		829	`my $count = 0;`
		830	`foreach my $pv_id ( @_ )`
		831	`{`
		832	`next if ( $opt_test && ++$count > 2 );`
		833	`getPkgDetailsByPV_ID( $pv_id);`
		834	`}`
		835	`}`
		836
		837	`#-------------------------------------------------------------------------------`
227	dpurdie	838	`# Function : GetDepends`
		839	`#`
		840	`# Description : Extract the dependancies for a given package version`
		841	`#`
		842	`# Inputs : $pvid`
		843	`#`
		844	`# Returns :`
		845	`#`
		846	`sub GetDepends`
		847	`{`
		848	`my ($pv_id, $pname, $pver ) = @_;`
		849
		850	`connectRM(\$RM_DB) unless ($RM_DB);`
		851
		852	`#`
		853	`# Now extract the package dependacies`
		854	`#`
		855	`my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .`
289	dpurdie	856	`" FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .`
227	dpurdie	857	`" WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";`
		858	`my $sth = $RM_DB->prepare($m_sqlstr);`
		859	`if ( defined($sth) )`
		860	`{`
		861	`if ( $sth->execute( ) )`
		862	`{`
		863	`if ( $sth->rows )`
		864	`{`
		865	`my %depends;`
		866	`while ( my @row = $sth->fetchrow_array )`
		867	`{`
		868	`#print "$pname $pver ===== @row\n";`
		869	`my $name = $row[0];`
		870	`my $ver = $row[1];`
		871
		872	`Verbose2( " Depends: $name, $ver");`
		873
		874	`$depends{$name,$ver} = 1;`
		875	`$Package{$name}{$ver}{usedby}{$pname,$pver} = 1;`
		876
		877	`unless ( exists $Package{$name}{$ver}{done} )`
		878	`{`
		879	`my @DATA = ($name, $ver, $row[2]);`
		880	`push @StrayPackages, \@DATA;`
		881	`}`
		882	`}`
		883	`$Package{$pname}{$pver}{depends} = \%depends;`
		884	`}`
		885	`$sth->finish();`
		886	`}`
		887	`}`
		888	`else`
		889	`{`
		890	`Error("GetDepends:Prepare failure" );`
		891	`}`
		892	`}`
		893
		894	`#-------------------------------------------------------------------------------`
		895	`# Function : getPkgDetailsByRTAG_ID`
		896	`#`
233	dpurdie	897	`# Description : Extract all the packages for a given rtag_id`
227	dpurdie	898	`#`
		899	`# Inputs : RTAG_ID`
		900	`#`
		901	`# Returns :`
		902	`#`
		903
		904	`sub getPkgDetailsByRTAG_ID`
		905	`{`
233	dpurdie	906	`my ($RTAG_ID) = @_;`
227	dpurdie	907	`my $foundDetails = 0;`
		908	`my (@row);`
		909
		910	`connectRM(\$RM_DB);`
		911
		912	`# First get details from pv_id`
		913
		914	`my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION".`
289	dpurdie	915	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .`
227	dpurdie	916	`" WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";`
		917	`my $sth = $RM_DB->prepare($m_sqlstr);`
		918	`if ( defined($sth) )`
		919	`{`
		920	`if ( $sth->execute( ) )`
		921	`{`
		922	`if ( $sth->rows )`
		923	`{`
		924	`while ( @row = $sth->fetchrow_array )`
		925	`{`
		926	`my $pv_id = $row[0];`
		927	`my $name = $row[1];`
		928	`my $ver = $row[2];`
		929	`Verbose ("getPkgDetailsByRTAG_ID: $RTAG_ID, $name, $ver, $pv_id");`
		930
		931	`$Release{$name}{$ver}{pv_id} = $pv_id;`
		932	`$Release_pvid{$pv_id} = 1;`
		933	`}`
		934	`}`
		935	`$sth->finish();`
		936	`}`
		937	`}`
		938	`else`
		939	`{`
		940	`Error("getPkgDetailsByRTAG_ID:Prepare failure" );`
		941	`}`
		942	`}`
		943
		944
		945	`#-------------------------------------------------------------------------------`
		946	`# Function : LocateStrays`
		947	`#`
		948	`# Description : Locate stray packages`
		949	`# These are packages that have not been defined by the`
		950	`# top level SBOM. These are not really stray`
		951	`#`
281	dpurdie	952	`# Inputs : $mode 2: No stray tagging`
		953	`# 0: Mark all as stray`
		954	`# 1: Don't mark packages as stray`
		955	`# if they are in releases hash`
		956	`# Returns : Nothing`
227	dpurdie	957	`#`
		958	`sub LocateStrays`
		959	`{`
233	dpurdie	960	`my ($mode) = @_;`
227	dpurdie	961	`while ( $#StrayPackages >= 0 )`
		962	`{`
		963	`my $DATA = pop @StrayPackages;`
		964	`my $name = $DATA->[0];`
		965	`my $ver = $DATA->[1];`
		966	`my $pv_id = $DATA->[2];`
		967
		968	`next if ( exists $Package{$name}{$ver}{done} );`
		969	`getPkgDetailsByPV_ID ( $pv_id );`
281	dpurdie	970
		971	`next if ( $mode > 1 );`
233	dpurdie	972	`if ( $mode )`
		973	`{`
		974	`next if ( exists $Release{$name}{$ver} );`
		975	`}`
227	dpurdie	976	`$Package{$name}{$ver}{stray} = 1;`
233	dpurdie	977	`#print "Stray: $pv_id, $name, $ver\n";`
227	dpurdie	978	`}`
		979	`}`
		980
		981	`#-------------------------------------------------------------------------------`
		982	`# Function : BuildOrder`
		983	`#`
		984	`# Description : Determine the order to build packages`
		985	`#`
		986	`# Inputs :`
		987	`#`
		988	`# Returns :`
		989	`#`
		990	`sub BuildOrder`
		991	`{`
		992	`foreach my $name ( keys %Package )`
		993	`{`
		994	`foreach my $ver ( keys %{$Package{$name}} )`
		995	`{`
		996	`AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );`
		997	`}`
		998	`}`
		999
		1000	`DetermineBuildOrder();`
		1001	`}`
		1002
		1003	`#-------------------------------------------------------------------------------`
		1004	`# Function : AddToBuildList`
		1005	`#`
		1006	`# Description : Add packages to a build list`
		1007	`#`
		1008	`# Inputs : PackageName`
		1009	`# PackageVersion`
		1010	`# Hash of dependancies`
		1011	`#`
		1012	`# Returns :`
		1013	`#`
		1014	`my %BuildList;`
		1015	`sub AddToBuildList`
		1016	`{`
		1017	`my ($name, $ver, $pdepends ) = @_;`
		1018
		1019	`Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};`
		1020
		1021	`#`
		1022	`# Clone dependancies as we will destroy the list as we process data`
		1023	`#`
		1024	`my $ref;`
		1025	`$ref = dclone ($pdepends ) if $pdepends;`
		1026	`$BuildList{$name,$ver}{depends} = $ref;`
		1027	`}`
		1028
		1029	`#-------------------------------------------------------------------------------`
		1030	`# Function : DetermineBuildOrder`
		1031	`#`
		1032	`# Description : Determine the build order`
		1033	`#`
		1034	`# Inputs :`
		1035	`#`
		1036	`# Returns :`
		1037	`#`
		1038	`sub DetermineBuildOrder`
		1039	`{`
		1040
		1041	`my $file = "${fpref}_buildinfo.txt";`
		1042	`push @create_list, $file;`
		1043
		1044	`open (BI, ">$file" ) \|\| Error ("Cannot create $file");`
		1045
		1046	`# DebugDumpData ("BuildList", \%BuildList); exit 1;`
		1047
		1048	`my $more = 1;`
		1049	`my $level = 0;`
		1050	`while ( $more )`
		1051	`{`
		1052	`my @build;`
		1053	`$level ++;`
		1054	`$more = 0;`
		1055	`foreach my $key ( keys %BuildList )`
		1056	`{`
		1057	`#`
		1058	`# Locate packges with no dependencies left`
		1059	`#`
		1060	`next if ( keys %{$BuildList{$key}{depends}} );`
		1061	`push @build, $key;`
		1062	`}`
		1063
		1064	`foreach my $build ( @build )`
		1065	`{`
		1066	`$more = 1;`
		1067	`delete $BuildList{$build};`
		1068	`my ($name, $ver) = split $;, $build;`
		1069
		1070	`my $label = $Package{$name}{$ver}{label} \|\| '';`
		1071	`my $path = $Package{$name}{$ver}{path} \|\| '';`
		1072	`$Package{$name}{$ver}{buildorder} = $level;`
		1073
		1074	`printf BI "Build(%2d): %40s %15s %-55s %s\n", $level, $name, $ver, $label, $path;`
		1075	`}`
		1076
		1077	`#`
		1078	`# Delete dependencies`
		1079	`#`
		1080	`foreach my $key ( keys %BuildList )`
		1081	`{`
		1082	`foreach my $build ( @build )`
		1083	`{`
		1084	`delete $BuildList{$key}{depends}->{$build};`
		1085	`}`
		1086	`}`
		1087	`}`
		1088	`close BI;`
		1089	`}`
		1090
		1091	`#-------------------------------------------------------------------------------`
		1092	`# Function : GenerateHTML`
		1093	`#`
		1094	`# Description : Generate Dependency information`
		1095	`# Generate a nive HTML dependancy table`
		1096	`# Shows DependOn and UsedBy`
		1097	`# Inputs :`
		1098	`#`
		1099	`# Returns :`
		1100	`#`
		1101
237	dpurdie	1102	`sub th`
		1103	`{`
		1104	`my ($text, $span) = @_;`
		1105
		1106	`my $string = '<th style="vertical-align: top;"';`
		1107	`$string .= " colspan=\"$span\"" if ( $span );`
		1108	`$string .= '>' . $text . '</th>' . "\n";`
		1109	`return $string;`
		1110	`}`
		1111
		1112	`sub thl`
		1113	`{`
		1114	`my ($text, $span) = @_;`
		1115
		1116	`my $string = '<th style="text-align: left;"';`
		1117	`$string .= " colspan=\"$span\"" if ( $span );`
		1118	`$string .= '>' . $text . '</th>' . "\n";`
		1119	`return $string;`
		1120	`}`
		1121
		1122
227	dpurdie	1123	`sub GenerateHTML`
		1124	`{`
		1125	`my $td = '<td style="vertical-align: top;">' . "\n";`
		1126	`my $tdr = '<td style="text-align: right;">';`
		1127
		1128	`my $file = "${fpref}_depends.html";`
		1129	`push @create_list, $file;`
		1130	`open (DP, ">$file" ) \|\| Error ("Cannot create $file");`
		1131
		1132	`#`
295	dpurdie	1133	`# Generate a header`
		1134	`#`
		1135	`print DP "<dl><dt><h1>Extraction Details</h1></dt>\n";`
		1136	`if ( $opt_sbom_id )`
		1137	`{`
		1138	`print DP "<dd>SBOM Base</dd>\n";`
		1139	`print DP "<dd>Project: $sbom_project</dd>\n";`
		1140	`print DP "<dd>BOM : $sbom_name</dd>\n";`
		1141	`print DP "<dd>Branch : $sbom_branch</dd>\n";`
		1142	`print DP "<dd>Version: $sbom_version</dd>\n";`
		1143	`print DP "<dd>SBOM ID: $opt_sbom_id</dd>\n";`
		1144	`}`
		1145
		1146	`if ( $opt_rtag_id )`
		1147	`{`
		1148	`getReleaseDetails($opt_rtag_id);`
		1149	`print DP "<dd>Release Base</dd>\n";`
		1150	`print DP "<dd>Project: $rtag_project</dd>\n";`
		1151	`print DP "<dd>Release: $rtag_release</dd>\n";`
		1152	`print DP "<dd>RTAG ID: $opt_rtag_id</dd>\n";`
		1153	`}`
		1154
		1155	`print DP "<dd>Root Package: $opt_rootpkg , $opt_rootpkg_version</dd>\n" if ($opt_rootpkg);`
		1156	`print DP "</dl>\n";`
		1157
		1158	`#`
227	dpurdie	1159	`# Generate an index`
		1160	`#`
		1161	`print DP "<dl><dt><h1>Index</h1></dt>\n";`
		1162	`print DP "<dd><a href=\"#Ignore\">Ignored Packages</a></dd>\n";`
		1163	`print DP "<dd><a href=\"#Depend\">Dependency Info</a></dd>\n";`
		1164	`print DP "<dd><a href=\"#Multi\">Multiple Package Version</a></dd>\n";`
233	dpurdie	1165	`print DP "<dd><a href=\"#Leaf\">Packages that have no parents</a></dd>\n";`
227	dpurdie	1166	`print DP "<dd><a href=\"#NoBuild\">Packages that cannot be built</a></dd>\n";`
237	dpurdie	1167	`print DP "<dd><a href=\"#Excess\">Excess Packages from Release: $opt_rtag_id</a></dd>\n" if ( $opt_rtag_id && ($opt_sbom_id \|\| $opt_rootpkg ));`
		1168	`print DP "<dd><a href=\"#Stray\">Required Packages, not part of the release</a></dd>\n" if ( $opt_rtag_id && ! ($opt_sbom_id \|\| $opt_rootpkg) );`
227	dpurdie	1169	`print DP "<dd><a href=\"#Inconsistent\">Packages in the Release, with inconsistent dependencies</a></dd>\n" if ( $opt_rtag_id && !$opt_sbom_id );`
		1170
		1171	`print DP "</dl>\n";`
		1172
		1173	`#`
		1174	`# Ignored Packages`
		1175	`#`
		1176	`print DP "<h1><a name=\"Ignore\">Ignored Packages</a></h1>\n";`
		1177
		1178	`print DP "The following package, and all dependents, have been ignored.<br><br>\n";`
		1179
		1180	`foreach my $name ( sort keys %ignore )`
		1181	`{`
		1182	`print DP "$name: $ignore{$name} versions<br>\n";`
		1183	`}`
		1184
		1185	`unless ( $opt_patch )`
		1186	`{`
		1187	`print DP "The following package have patches that have been ignored.<br><br>\n";`
		1188	`foreach my $name ( sort keys %patch )`
		1189	`{`
		1190	`print DP "$name: $patch{$name} patches<br>\n";`
		1191	`}`
		1192	`}`
		1193
		1194	`#`
		1195	`# Dependency Information`
		1196	`#`
		1197	`print DP "<h1><a name=\"Depend\">Dependency Info</a></h1>\n";`
		1198
		1199	`print DP "<table border=\"1\"><tbody>\n";`
		1200	`print DP "<tr>\n";`
237	dpurdie	1201	`print DP th("Package Dependency");`
		1202	`print DP th("Package Used by");`
		1203	`print DP th("Build Info");`
227	dpurdie	1204	`print DP "</tr>\n";`
237	dpurdie	1205	`my $package_count = 0;`
227	dpurdie	1206	`foreach my $name ( sort keys %Package )`
		1207	`{`
		1208	`foreach my $ver ( sort keys %{$Package{$name}} )`
		1209	`{`
		1210	`print DP "<tr>\n";`
237	dpurdie	1211	`$package_count++;`
227	dpurdie	1212	`#`
		1213	`# Depends On info`
		1214	`#`
		1215
		1216	`print DP $td;`
		1217	`my $anchor= "${name}_${ver}";`
		1218	`my $tag = "usedby_${name}_${ver}";`
		1219	`printf DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Depends on:</dt>\n", $name, $ver;`
		1220	`foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )`
		1221	`{`
		1222	`my ($dname, $dver) = split $;, $depend;`
		1223	`my $tag = "${dname}_${dver}";`
		1224	`printf DP " <dd><a href=\"#$tag\">%s %s</a></dd>\n", $dname, $dver;`
		1225	`}`
		1226	`print DP "</dl>\n";`
		1227	`print DP "</td>\n";`
		1228
		1229
		1230	`#`
		1231	`# Used By information`
		1232	`#`
		1233	`print DP $td;`
		1234	`$anchor= "usedby_${name}_${ver}";`
		1235	`$tag = "${name}_${ver}";`
		1236	`printf DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Used by:</dt>\n", $name, $ver;`
		1237	`foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )`
		1238	`{`
		1239	`my ($dname, $dver) = split $;, $depend;`
		1240	`my $tag = "usedby_${dname}_${dver}";`
		1241	`printf DP " <dd><a href=\"#$tag\">%s %s</a></dd>\n", $dname, $dver;`
		1242	`}`
		1243	`print DP "</dl>\n";`
		1244	`print DP "</td>\n";`
		1245
		1246	`#`
		1247	`# Build Info`
		1248	`#`
		1249	`print DP $td;`
		1250	`print DP "<table>";`
		1251	`my $stray = ( exists ($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );`
		1252
		1253	`my $pv_id = $Package{$name}{$ver}{pvid} \|\| 'No PVID';`
		1254	`my $pv_id_ref = $rm_base . $pv_id;`
		1255	`$pv_id_ref .= "&rtag_id=" . $opt_rtag_id if ($opt_rtag_id && !$stray);`
233	dpurdie	1256	`my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";`
227	dpurdie	1257
		1258	`printf DP "<tr>${tdr}Pvid:</td><td>%s</td></tr>\n", $pv_id_str;`
		1259	`printf DP "<tr>${tdr}Label:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{label} \|\| 'NoneProvided';`
		1260	`printf DP "<tr>${tdr}Path:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{path} \|\| 'NoneProvided';`
		1261
		1262	`my $order = 'Not Built';`
		1263	`my @machs;`
		1264
		1265	`if ( exists($Package{$name}{$ver}{build}) )`
		1266	`{`
		1267	`$order = $Package{$name}{$ver}{buildorder};`
		1268	`@machs = sort keys %{$Package{$name}{$ver}{build}};`
		1269	`}`
		1270	`else`
		1271	`{`
		1272	`my $tag = "notbuilt_${name}_${ver}";`
		1273	`$order = "<a href=\"#$tag\">Not Built</a>"`
		1274	`}`
		1275
		1276	`printf DP "<tr>${tdr}Build Order:</td><td>%s</td></tr>\n", $order;`
		1277
		1278	`my $text = "Build:";`
		1279	`foreach my $mach ( @machs )`
		1280	`{`
		1281	`my $type = $Package{$name}{$ver}{build}{$mach};`
		1282	`printf DP "<tr>${tdr}$text</td><td>%s %s</td></tr>\n", $BM_ID{$mach} \|\| "Unknown, $mach", $BSA_ID{$type} \|\| 'Unknown';`
		1283	`$text = '';`
		1284	`}`
		1285
		1286	`my $pvid = $Package{$name}{$ver}{pvid};`
		1287	`$text = "Deployed:";`
		1288	`foreach my $osid ( sort keys %{ $pv_id{$pvid}{os_id} } )`
		1289	`{`
		1290	`my $os_name = $os_id_list{$osid}{os_name};`
		1291	`my $node = $os_id_list{$osid}{node_name};`
		1292
		1293	`my $ref = $dm_base . $osid;`
		1294	`my $str = "<a href=\"$ref\">$node,($os_name)</a>";`
		1295
		1296
		1297	`printf DP "<tr>${tdr}$text</td><td>$str</td></tr>\n";`
		1298	`$text = '';`
		1299	`}`
		1300
		1301	`if ( $stray )`
		1302	`{`
		1303	`printf DP "<tr>${tdr}Stray:</td><td>Package included indirectly</td></tr>\n";`
		1304	`}`
		1305
		1306
		1307
		1308	`print DP "</table>";`
		1309	`print DP "</td>\n";`
		1310
		1311	`#`
		1312	`# End of Row`
		1313	`#`
		1314	`print DP "</tr>\n";`
		1315	`}`
		1316	`}`
237	dpurdie	1317	`print DP "<tr>\n";`
		1318	`print DP thl("Total Count: $package_count", 3);`
		1319	`print DP "</tr>\n";`
		1320
227	dpurdie	1321	`print DP "</tbody></table>\n";`
		1322
		1323
		1324	`#`
		1325	`# Multiple versions of a package`
		1326	`#`
		1327	`print DP "<h1><a name=\"Multi\">Multiple Package Versions</a></h1>\n";`
		1328	`print DP "<table border=\"1\"><tbody>\n";`
		1329	`print DP "<tr>\n";`
237	dpurdie	1330	`print DP th("Multiple Versions");`
227	dpurdie	1331	`print DP "</tr>\n";`
237	dpurdie	1332	`my $multiple_count = 0;`
227	dpurdie	1333	`foreach my $name ( sort keys %Package )`
		1334	`{`
		1335	`my @versions = keys %{$Package{$name}};`
		1336	`next unless ( $#versions > 0 );`
237	dpurdie	1337	`$multiple_count++;`
227	dpurdie	1338	`print DP "<tr>\n";`
		1339	`print DP $td;`
		1340	`printf DP "<dl><dt>$name</a> Versions:<dt>\n";`
		1341
		1342	`foreach my $ver ( sort @versions )`
		1343	`{`
		1344	`my $tag = "${name}_${ver}";`
		1345	`printf DP " <dd>";`
		1346	`printf DP "<a href=\"#$tag\">%s %s</a>\n", $name, $ver;`
		1347	`print DP " - Not in Release" if ($opt_rtag_id && $Package{$name}{$ver}{stray});`
		1348	`printf DP "</dd>\n", $name, $ver;`
		1349	`}`
		1350	`print DP "</dl>\n";`
		1351	`print DP "</td>\n";`
		1352	`print DP "</tr>\n";`
		1353	`}`
237	dpurdie	1354	`print DP "<tr>\n";`
		1355	`print DP thl("Total Count: $multiple_count");`
		1356	`print DP "</tr>\n";`
		1357
227	dpurdie	1358	`print DP "</tbody></table>\n";`
		1359
		1360
		1361	`#`
233	dpurdie	1362	`# Leaf Packages`
		1363	`#`
		1364	`print DP "<h1><a name=\"Leaf\">Packages that have no parents</a></h1>\n";`
		1365	`print DP "<table border=\"1\"><tbody>\n";`
		1366	`print DP "<tr>\n";`
237	dpurdie	1367	`print DP th("Leaf Packages");`
233	dpurdie	1368	`print DP "</tr>\n";`
237	dpurdie	1369	`my $leaf_count = 0;`
233	dpurdie	1370	`foreach my $name ( sort keys %Package )`
		1371	`{`
		1372	`foreach my $ver ( sort keys %{$Package{$name}} )`
		1373	`{`
		1374	`my @usedby = keys %{$Package{$name}{$ver}{usedby}};`
		1375	`next if ( @usedby );`
237	dpurdie	1376	`$leaf_count++;`
233	dpurdie	1377
		1378	`print DP "<tr>\n";`
		1379	`print DP $td;`
		1380
		1381	`my $tag = "${name}_${ver}";`
		1382
		1383	`printf DP "<dt><a href=\"#$tag\">%s %s</a>\n", $name, $ver;`
		1384
		1385	`print DP "</td>\n";`
		1386	`print DP "</tr>\n";`
		1387	`}`
		1388	`}`
237	dpurdie	1389	`print DP "<tr>\n";`
		1390	`print DP thl("Total Count: $leaf_count");`
		1391	`print DP "</tr>\n";`
233	dpurdie	1392	`print DP "</tbody></table>\n";`
		1393
		1394
		1395
		1396	`#`
227	dpurdie	1397	`# Packages that cannot be built`
		1398	`#`
		1399	`print DP "<h1><a name=\"NoBuild\">Packages that cannot be built</a></h1>\n";`
		1400	`print DP "<table border=\"1\"><tbody>\n";`
		1401	`print DP "<tr>\n";`
237	dpurdie	1402	`print DP th("Not Built");`
227	dpurdie	1403	`print DP "</tr>\n";`
233	dpurdie	1404	`my $no_build_count = 0;`
227	dpurdie	1405
		1406	`foreach my $name ( sort keys %Package )`
		1407	`{`
		1408	`my @versions = keys %{$Package{$name}};`
		1409	`foreach my $ver ( sort @versions )`
		1410	`{`
		1411	`next unless exists($Package{$name}{$ver}{bad_extract});`
233	dpurdie	1412	`$no_build_count++;`
227	dpurdie	1413	`my @reasons = @{$Package{$name}{$ver}{bad_extract}};`
		1414
		1415	`print DP "<tr><dl>\n";`
		1416	`print DP $td;`
		1417
		1418	`my $tag = "${name}_${ver}";`
		1419	`my $anchor = "notbuilt_${name}_${ver}";`
		1420
		1421	`printf DP "<dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a></dt>\n", $name, $ver;`
		1422	`foreach my $reason ( @reasons )`
		1423	`{`
		1424	`print DP "<dd>$reason</dd>\n";`
		1425	`}`
		1426
		1427
		1428	`print DP "</dl>\n";`
		1429	`print DP "</td>\n";`
		1430	`print DP "</tr>\n";`
		1431
		1432	`}`
		1433	`}`
233	dpurdie	1434	`print DP "<tr>\n";`
237	dpurdie	1435	`print DP thl("Total Count: $no_build_count");`
233	dpurdie	1436	`print DP "</tr>\n";`
		1437
227	dpurdie	1438	`print DP "</tbody></table>\n";`
		1439
		1440	`#`
		1441	`# Packages that are in a specified release, but not described by the SBOM`
		1442	`#`
237	dpurdie	1443	`if ( $opt_rtag_id && ($opt_sbom_id \|\| $opt_rootpkg) )`
227	dpurdie	1444	`{`
		1445	`print DP "<h1><a name=\"Excess\">Excess Packages from Release: $opt_rtag_id</a></h1>\n";`
		1446	`print DP "<table border=\"1\"><tbody>\n";`
		1447	`print DP "<tr>\n";`
237	dpurdie	1448	`print DP th("Excess Packages",3);`
227	dpurdie	1449	`print DP "</tr>\n";`
		1450
		1451	`print DP "<tr>\n";`
237	dpurdie	1452	`print DP th("Package");`
		1453	`print DP th("PVID");`
		1454	`print DP th("Used Package");`
227	dpurdie	1455	`print DP "</tr>\n";`
		1456
		1457	`my $were_found = 0;`
		1458	`my $not_found = 0;`
		1459	`foreach my $name ( sort keys %Release )`
		1460	`{`
		1461	`my @versions = keys %{$Release{$name}};`
		1462	`foreach my $ver ( sort @versions )`
		1463	`{`
		1464	`if (exists($Package{$name}{$ver}))`
		1465	`{`
		1466	`$were_found++;`
		1467	`next;`
		1468	`}`
		1469	`$not_found++;`
		1470
		1471	`print DP "<tr>\n";`
		1472	`print DP $td;`
		1473
		1474	`my $pv_id = $Release{$name}{$ver}{pv_id} \|\| 'No PVID';`
		1475	`my $pv_id_ref = $rm_base . $pv_id . "&rtag_id=" . $opt_rtag_id;`
233	dpurdie	1476	`my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";`
227	dpurdie	1477
		1478	`printf DP "$name $ver ", $name, $ver;`
		1479	`print DP "</td>\n";`
		1480
		1481	`print DP $td;`
		1482	`printf DP "Pvid: %s\n", $pv_id_str;`
		1483	`print DP "</td>\n";`
		1484
		1485	`print DP $td;`
		1486	`my @pver = keys %{$Package{$name}};`
		1487	`if (@pver)`
		1488	`{`
		1489	`printf DP "<dl><dt> Uses Versions:<dt>\n";`
		1490	`foreach my $ver ( sort @pver )`
		1491	`{`
		1492	`my $tag = "${name}_${ver}";`
		1493	`printf DP " <dd><a href=\"#$tag\">%s %s</a></dd>\n", $name, $ver;`
		1494	`}`
		1495	`print DP "</dl>\n";`
		1496	`}`
		1497	`else`
		1498	`{`
		1499	`printf DP "No Versions of this package used\n"`
		1500	`}`
		1501	`print DP "</td>\n";`
		1502
		1503
		1504	`print DP "</tr>\n";`
		1505	`}`
		1506	`}`
		1507
		1508	`print DP "<tr>\n";`
237	dpurdie	1509	`print DP thl("Packages found in SBOM: $were_found",3);`
227	dpurdie	1510	`print DP "</td>\n";`
		1511	`print DP "</tr>\n";`
		1512
		1513	`print DP "<tr>\n";`
237	dpurdie	1514	`print DP thl("Packages NOT found in SBOM: $not_found", 3);`
227	dpurdie	1515	`print DP "</td>\n";`
		1516	`print DP "</tr>\n";`
		1517
		1518	`print DP "</tbody></table>\n";`
		1519	`}`
		1520
		1521	`#`
		1522	`# Packages that are strays`
		1523	`# They are not top level packages in the release`
		1524	`#`
237	dpurdie	1525	`if ( $opt_rtag_id && ! ($opt_sbom_id \|\| $opt_rootpkg) )`
227	dpurdie	1526	`{`
		1527	`print DP "<h1><a name=\"Stray\">Required Packages, not part of the release</a></h1>\n";`
		1528	`print DP "<table border=\"1\"><tbody>\n";`
		1529	`print DP "<tr>\n";`
237	dpurdie	1530	`print DP th("Stray Packages",3);`
227	dpurdie	1531	`print DP "</tr>\n";`
		1532
		1533	`print DP "<tr>\n";`
237	dpurdie	1534	`print DP th("Inconsisient Package");`
		1535	`print DP th("PVID");`
		1536	`print DP th("Preferred Package");`
227	dpurdie	1537	`print DP "</tr>\n";`
237	dpurdie	1538	`my $stray_count = 0;`
227	dpurdie	1539
		1540	`foreach my $name ( sort keys %Package )`
		1541	`{`
		1542
		1543	`my @versions = keys %{$Package{$name}};`
		1544	`foreach my $ver ( sort @versions )`
		1545	`{`
		1546	`unless (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} )`
		1547	`{`
		1548	`next;`
		1549	`}`
		1550
		1551	`#`
		1552	`# Determine preferred package version(s)`
		1553	`# These will be those without a 'stray' tag`
		1554	`#`
		1555	`my @preferred = ();`
		1556	`foreach my $pver ( keys %{$Package{$name}} )`
		1557	`{`
		1558	`next if (exists($Package{$name}{$pver}{stray} ) && $Package{$name}{$pver}{stray} );`
		1559	`push @preferred, $pver;`
		1560	`}`
		1561
		1562	`print DP "<tr>\n";`
237	dpurdie	1563	`$stray_count++;`
227	dpurdie	1564
		1565	`#`
		1566	`# Package name and Used By information`
		1567	`#`
		1568	`print DP $td;`
		1569	`my $anchor= "usedby_${name}_${ver}";`
		1570	`my $tag = "${name}_${ver}";`
		1571	`printf DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Used by:</dt>\n", $name, $ver;`
		1572	`foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )`
		1573	`{`
		1574	`my ($dname, $dver) = split $;, $depend;`
		1575	`my $tag = "usedby_${dname}_${dver}";`
		1576	`printf DP " <dd><a href=\"#$tag\">%s %s</a></dd>\n", $dname, $dver;`
		1577	`}`
		1578	`print DP "</dl>\n";`
		1579	`print DP "</td>\n";`
		1580
		1581
		1582	`my $pv_id = $Package{$name}{$ver}{pvid} \|\| 'No PVID';`
		1583
		1584	`my $pv_id_ref = $rm_base . $pv_id;`
233	dpurdie	1585	`my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";`
227	dpurdie	1586
		1587	`print DP $td;`
		1588	`printf DP "Pvid: %s\n", $pv_id_str;`
		1589	`print DP "</td>\n";`
		1590
		1591	`#`
		1592	`# Insert Preferred package(s)`
		1593	`#`
		1594	`print DP $td;`
		1595	`print DP "<table>\n";`
		1596	`foreach my $pver ( sort @preferred )`
		1597	`{`
		1598	`my $tag = "${name}_${pver}";`
		1599	`printf DP "<tr><td><a href=\"#$tag\">%s %s</a></td></tr>\n", $name, $pver;`
		1600	`}`
		1601
		1602	`print DP "</table>\n";`
		1603	`print DP "</tr>\n";`
		1604
		1605	`}`
		1606	`}`
		1607
237	dpurdie	1608	`print DP "<tr>\n";`
		1609	`print DP thl("Total Count: $stray_count", 3);`
		1610	`print DP "</tr>\n";`
227	dpurdie	1611	`print DP "</tbody></table>\n";`
		1612	`}`
		1613
		1614	`#`
		1615	`# Packages that have components not in the release`
		1616	`# They are not top level packages in the release`
		1617	`#`
		1618	`if ( $opt_rtag_id && !$opt_sbom_id )`
		1619	`{`
		1620	`print DP "<h1><a name=\"Inconsistent\">Packages in the Release, with inconsistent dependencies</a></h1>\n";`
		1621	`print DP "<table border=\"1\"><tbody>\n";`
		1622
		1623	`print DP "<tr>\n";`
237	dpurdie	1624	`print DP th("Inconsisient Package");`
227	dpurdie	1625	`print DP "</tr>\n";`
237	dpurdie	1626	`my $inconsistent_count = 0;`
227	dpurdie	1627
		1628	`foreach my $name ( sort keys %Package )`
		1629	`{`
		1630
		1631	`my @versions = keys %{$Package{$name}};`
		1632	`foreach my $ver ( sort @versions )`
		1633	`{`
		1634	`#`
		1635	`# Ignore 'stray' packages`
		1636	`#`
		1637	`next if (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );`
		1638
		1639	`#`
		1640	`# Is it inconsitient`
		1641	`#`
		1642	`my $ok = 1;`
		1643	`foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )`
		1644	`{`
		1645	`my ($dname, $dver) = split $;, $depend;`
		1646	`if (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} )`
		1647	`{`
		1648	`$ok = 0;`
		1649	`last;`
		1650	`}`
		1651	`}`
		1652
		1653	`next if ( $ok );`
237	dpurdie	1654	`$inconsistent_count++;`
227	dpurdie	1655
		1656	`#`
		1657	`# Depends On info`
		1658	`#`
		1659
		1660	`print DP "<tr>\n";`
		1661	`print DP $td;`
		1662	`my $anchor= "${name}_${ver}";`
		1663	`my $tag = "usedby_${name}_${ver}";`
		1664	`printf DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Inconsistent::</dt>\n", $name, $ver;`
		1665	`foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )`
		1666	`{`
		1667	`my ($dname, $dver) = split $;, $depend;`
		1668	`next unless (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} );`
		1669
		1670	`my $tag = "${dname}_${dver}";`
		1671	`printf DP " <dd><a href=\"#$tag\">%s %s</a></dd>\n", $dname, $dver;`
		1672	`}`
		1673	`print DP "</dl>\n";`
		1674	`print DP "</td>\n";`
		1675	`print DP "<tr>\n";`
		1676
		1677	`}`
		1678	`}`
		1679
237	dpurdie	1680	`print DP "<tr>\n";`
		1681	`print DP thl("Total Count: $inconsistent_count");`
		1682	`print DP "</tr>\n";`
227	dpurdie	1683	`print DP "</tbody></table>\n";`
		1684	`}`
		1685
		1686	`close DP;`
		1687	`}`
		1688
		1689	`#-------------------------------------------------------------------------------`
241	dpurdie	1690	`# Function : GenerateHTMLLodgement`
		1691	`#`
		1692	`# Description : Simple document to describe packages`
		1693	`#`
		1694	`# Inputs :`
		1695	`#`
		1696	`# Returns :`
		1697	`#`
		1698	`sub GenerateHTMLLodgement`
		1699	`{`
		1700	`my $td = '<td style="vertical-align: top;">' . "\n";`
		1701
		1702	`my $file = "${fpref}_lodgement.html";`
		1703	`push @create_list, $file;`
		1704	`open (DP, ">$file" ) \|\| Error ("Cannot create $file");`
		1705
		1706	`#`
		1707	`# Package Information`
		1708	`#`
		1709	`print DP "<h1>Package Information</h1>\n";`
		1710
		1711	`print DP "<table border=\"1\"><tbody>\n";`
		1712	`print DP "<tr>\n";`
		1713	`print DP th("Name, Version");`
		1714	`print DP th("Dependencies");`
		1715	`print DP "</tr>\n";`
		1716	`my $package_count = 0;`
		1717	`foreach my $name ( sort keys %Package )`
		1718	`{`
		1719	`foreach my $ver ( sort keys %{$Package{$name}} )`
		1720	`{`
		1721	`print DP "<tr>\n";`
		1722	`$package_count++;`
		1723
		1724	`my $anchor= "${name}_${ver}";`
		1725
		1726	`#`
		1727	`# Package Name and description`
		1728	`# Cleanup and html-ize the description string`
		1729	`#`
		1730	`my $description = $Package{$name}{$ver}{description};`
		1731	`$description =~ s{\n\r}{\n}g;`
		1732	`$description =~ s{\r}{}g;`
		1733	`$description =~ s{^\n+}{};`
		1734	`$description =~ s{&}{&}g;`
		1735	`$description =~ s{<}{<}g;`
		1736	`$description =~ s{>}{>}g;`
		1737	`$description =~ s{"}{"}g;`
		1738	`$description =~ s{\n}{<br>\n}g;`
		1739
		1740	`print DP $td;`
		1741	`printf DP "<a name=\"$anchor\"></a>%s, %s<br>\n", $name, $ver;`
		1742	`print DP "<dl><dd>\n";`
		1743	`print DP $description;`
		1744	`print DP "</dd></dl>\n";`
		1745	`print DP "\n</td>\n";`
		1746
		1747	`#`
		1748	`# Depends On info`
		1749	`#`
		1750	`my $icount = 0;`
		1751	`print DP $td;`
		1752	`# printf DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Depends on:</dt>\n", $name, $ver;`
		1753	`foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )`
		1754	`{`
		1755	`my ($dname, $dver) = split $;, $depend;`
		1756	`my $tag = "${dname}_${dver}";`
		1757	`printf DP "<a href=\"#$tag\">%s %s</a><br>\n", $dname, $dver;`
		1758	`$icount++;`
		1759	`}`
		1760	`print DP "<br>\n" unless $icount;`
		1761	`print DP "</td>\n";`
		1762
		1763	`#`
		1764	`# End of Row`
		1765	`#`
		1766	`print DP "</tr>\n";`
		1767	`}`
		1768	`}`
		1769	`print DP "<tr>\n";`
		1770	`print DP thl("Total Count: $package_count", 2);`
		1771	`print DP "</tr>\n";`
		1772
		1773	`print DP "</tbody>\n";`
		1774	`print DP "</table>\n";`
		1775	`close DP;`
		1776	`}`
		1777
		1778	`#-------------------------------------------------------------------------------`
227	dpurdie	1779	`# Function : extract_files`
		1780	`#`
		1781	`# Description : Alternate mode of operation`
		1782	`# Extract files from the generated list. This is intended to`
235	dpurdie	1783	`# be run as a seperate phase taking the 'extract' file`
227	dpurdie	1784	`#`
		1785	`# Inputs :`
		1786	`#`
		1787	`# Returns :`
		1788	`#`
		1789	`sub extract_files`
		1790	`{`
		1791	`my @extract_order;`
		1792	`my %extract;`
		1793	`ErrorConfig( 'name' => 'ESCROW-EXTRACT' );`
		1794
		1795	`#`
		1796	`# Open the file and read in data in one hit`
		1797	`# This will detect file errors early`
243	dpurdie	1798	`# The lines may have arguments that are quoted.`
		1799	`# Supported forms are:`
		1800	`# "-tag=data" - data may contain spaces`
		1801	`# -tag=data - data must not contain spaces`
227	dpurdie	1802	`#`
243	dpurdie	1803	`#`
227	dpurdie	1804	`Error ("Cannot find specified file: $opt_extract")`
		1805	`unless ( -f $opt_extract );`
		1806
		1807	`open (FH, "<$opt_extract" ) \|\| Error ("Cannot open file");`
		1808	`while ( <FH> )`
		1809	`{`
		1810	`s~[\r\n]+$~~;`
243	dpurdie	1811	`Verbose2 ($_);`
227	dpurdie	1812	`next unless ( $_ );`
		1813
		1814	`my ($view, $label, $path);`
243	dpurdie	1815	`if ( m{(\s"-view=([^"]+)")\|(\s-view=(\S+))} )`
227	dpurdie	1816	`{`
243	dpurdie	1817	`$view = $2 \|\| $4;`
227	dpurdie	1818	`}`
		1819
243	dpurdie	1820	`if ( m{(\s"-label=([^"]+)")\|(\s-label=(\S+))} )`
235	dpurdie	1821	`{`
243	dpurdie	1822	`$label = $2 \|\| $4;`
235	dpurdie	1823	`}`
		1824
243	dpurdie	1825	`if ( m{(\s"-path=([^"]+)")\|(\s-path=(\S+))} )`
235	dpurdie	1826	`{`
243	dpurdie	1827	`$path = $2 \|\| $4;`
235	dpurdie	1828	`}`
		1829
		1830	`Error "Bad file format in line: $_" unless ( $view && $label );`
227	dpurdie	1831	`Error "Duplicate view name: $view" if ( exists $extract{$view} );`
		1832	`push @extract_order, $view;`
		1833	`$extract{$view}{label} = $label;`
		1834	`$extract{$view}{path} = $path;`
		1835	`}`
		1836	`close FH;`
		1837
		1838	`#`
		1839	`# Log the file processing`
		1840	`#`
		1841	`my $lfile = "${opt_extract}.log";`
243	dpurdie	1842	`Message ("Creating logfile: ${opt_extract}.log");`
227	dpurdie	1843	`open (FH, ">$lfile" ) \|\| Error ("Cannot open log file: $lfile");`
		1844
		1845	`#`
		1846	`# Process each entry`
		1847	`#`
		1848	`foreach my $view ( @extract_order )`
		1849	`{`
		1850	`my $label = $extract{$view}{label};`
		1851	`my $path = $extract{$view}{path};`
243	dpurdie	1852	`if ( $opt_test )`
		1853	`{`
		1854	`Verbose ("view($view) label($label) path($path)");`
		1855	`print FH "view($view) label($label) path($path) : TEST\n";`
		1856	`}`
		1857	`else`
		1858	`{`
263	dpurdie	1859	`my $rv = JatsCmd ('extract', '-extractfiles', "-view=$view", "-label=$label", "-path=$path", "-root=.", "-noprefix");`
243	dpurdie	1860	`print FH "$view : SUCCESS\n" unless $rv;`
		1861	`print FH "$view : ERROR\n" if $rv;`
		1862	`}`
227	dpurdie	1863	`}`
		1864	`close FH;`
243	dpurdie	1865	`Message ("Results in logfile: ${opt_extract}.log");`
227	dpurdie	1866
		1867	`}`
		1868
		1869
		1870	`#-------------------------------------------------------------------------------`
		1871	`# Documentation`
		1872	`#`
		1873
		1874	`=pod`
		1875
		1876	`=head1 NAME`
		1877
		1878	`escrow - Extract Escrow Build Information`
		1879
		1880	`=head1 SYNOPSIS`
		1881
281	dpurdie	1882	`jats escrow [options] [name version]`
227	dpurdie	1883
		1884	`Options:`
		1885	`-help - brief help message`
		1886	`-help -help - Detailed help message`
		1887	`-man - Full documentation`
		1888	`-sbomid=xxx - Specify the SBOM to process`
		1889	`-rtagid=xxx - Specify the Release to process (Optional)`
255	dpurdie	1890	`-rootpackage=xxx - Specifies a root package. In conjunction with -rtagid.`
227	dpurdie	1891	`-ignore=name - Ignore packages with the specified name`
		1892	`-extract=fname - Extract files from a previous run`
		1893	`-verbose - Enable verbose output`
		1894	`-[no]patch - Ignore/Include patches. Default:Include`
		1895	`-[no]test - Reduced package scanning for test`
		1896
		1897	`=head1 OPTIONS`
		1898
		1899	`=over 8`
		1900
		1901	`=item B<-help>`
		1902
		1903	`Print a brief help message and exits.`
		1904
		1905	`=item B<-help -help>`
		1906
		1907	`Print a detailed help message with an explanation for each option.`
		1908
		1909	`=item B<-man>`
		1910
		1911	`Prints the manual page and exits.`
		1912
		1913	`=item B<-sbomid=xxx>`
		1914
255	dpurdie	1915	`This option specifies the SBOM to process. The sbomid must be determined from`
		1916	`Deployment Manager.`
227	dpurdie	1917
		1918	`=item B<-rtagid=xxx>`
		1919
255	dpurdie	1920	`This option specified an RTAG_ID that must be determined from Release Manager.`
227	dpurdie	1921
255	dpurdie	1922	`This option may be used with or without the B<-sbomid=xxx> option.`
		1923
		1924	`With an SBOM_ID this option specifies an RTAG_ID to process in conjunction with the SBOM.`
		1925	`The program will determine packages that are in the Release, but not in the`
		1926	`SBOM.`
		1927
		1928	`Without an SBOM_ID, this option will limit the processing to the specified`
		1929	`release. Less information is generated. This form of the generation may be`
		1930	`combined with B<-rootpackage=xxx> to further limit the set of packages`
		1931	`processed.`
		1932
		1933	`=item B<-rootpackage=xxx>`
		1934
		1935	`This option can be used in conjunction with B<-rtagid=xxx> to limit the`
		1936	`extraction to named package and all of its dependent packages. The tool will`
		1937	`determine the required version of the package via the specified release.`
		1938
227	dpurdie	1939	`=item B<-ignore=name>`
		1940
		1941	`All versions of the named package will be ignored. This parameter is options.`
		1942	`It may be used multiple times.`
		1943
		1944	`=item B<-extract=name>`
		1945
		1946	`This option will process the 'extract' file created in a previous run of this`
		1947	`program and extract source files for the package-versions found in the file.`
		1948
		1949	`The command will then create a log file recording packages that could ne be`
		1950	`extracted.`
		1951
287	dpurdie	1952	`This option does not not interwork with many of the other command line options.`
		1953	`This option cannot be used in conjunction with the -rtagid, -sbomid, rootpackage`
		1954	`and -nopatch.`
227	dpurdie	1955
		1956	`=item B<-[no]patch>`
		1957
		1958	`This option is used ignore patches. If -nopatch is selected, then packages`
		1959	`versions that look like a patch will be added to the ignore list.`
		1960
		1961	`=item B<-[no]test>`
		1962
		1963	`This option is used for testing. It will only process the first two OS entries`
		1964	`in the SBOM. This speeds up processing. It does not generate a complete list of`
		1965	`packages.`
		1966
255	dpurdie	1967	`=item B<-verbose>`
227	dpurdie	1968
		1969	`This option will display progress information as the program executes.`
		1970
		1971	`=back`
		1972
		1973	`=head1 DESCRIPTION`
		1974
		1975	`This program is a tool for extracting Escrow build information.`
255	dpurdie	1976	`The program has two modes of operation:`
227	dpurdie	1977
255	dpurdie	1978	`=over 8`
227	dpurdie	1979
281	dpurdie	1980	`=item 1. Generation. Generate files describing packages within an SBOM/Release/`
		1981	`Package.`
255	dpurdie	1982
		1983	`=item 2. Extraction Supervise extraction of source trees.`
		1984
		1985	`=back`
		1986
		1987	`=head2 Generation Operations`
		1988
281	dpurdie	1989	`This program has several modes of operation. The mode is determined from the`
		1990	`command line arguments provided.`
255	dpurdie	1991
227	dpurdie	1992	`=over 8`
		1993
281	dpurdie	1994	`=item Full Escrow`
		1995
		1996	`This mode requires an SBOM_ID. If an RTAG_ID is also provided, then additional`
		1997	`information will be generated.`
		1998
		1999	`=item Release Escrow`
		2000
		2001	`If only an RTAG_ID is provided then the processing wil be limited to the`
		2002	`packages involved in creating the specified release.`
		2003
		2004	`If a 'rootpackage' name is provided, then the processing is limited to`
		2005	`packages that depend on the named package.`
		2006
		2007	`=item Single Package`
		2008
		2009	`If a package name and a package version are specified on the command line,`
		2010	`then the processing will be limited to the specified package and ist dependents.`
		2011	`No release related information will be provided.`
		2012
		2013	`=back`
		2014
		2015	`The 'Full Escrow' extract is the complete operation. All others are sub-sets of`
		2016	`this processing. The complete processing is:`
		2017
		2018	`=over 8`
		2019
227	dpurdie	2020	`=item * Determine all the NODES in the SBOM`
		2021
		2022	`=item * Determine all the Base Packages for each NODE`
		2023
		2024	`=item * Determine all the Packages for each NODE`
		2025
		2026	`=item * Determine all the dependent packages for all packages encountered`
		2027
		2028	`=item * Generate a list of jats commands to extract the package source`
		2029
		2030	`=item * Generate a file describing the build order`
		2031
		2032	`=item * Generate a file describing the packages that cannot be built`
		2033
		2034	`=item * Generate an HTML file with extensive cross reference information`
		2035
		2036	`=over 8`
		2037
		2038	`=item * List of all packages with references into Release Manager`
		2039
		2040	`=item * List of all packages showing dependent packages`
		2041
		2042	`=item * List of all packages showing consumer packages`
		2043
		2044	`=item * List of all packages for which multiple versions are required`
		2045
		2046	`=item * Details of packages that are not built.`
		2047
		2048	`=item * Build order`
		2049
		2050	`=item * Build machines and built types`
		2051
255	dpurdie	2052	`=item * Deployed target nodes, with references into Deployment Manager`
227	dpurdie	2053
		2054	`=back`
		2055
		2056	`=back`
		2057
		2058	`This may take some time, as a typical escrow build may contain many hundreds of packages.`
		2059
		2060	`The program will display a list of files that have been created.`
		2061
255	dpurdie	2062	`=head2 Extraction Operations`
		2063
227	dpurdie	2064	`Given an 'extract' file from a previous run of this program the program will:`
		2065
		2066	`=over 8`
		2067
		2068	`=item * Parse the 'extract' file`
		2069
255	dpurdie	2070	`=item * Create subdirectories for each package version within the file. This is done`
227	dpurdie	2071	`in such a way that no views are left in place.`
		2072
		2073	`=item * Create a log file showing packages that could not be extracted.`
		2074
		2075	`=back`
		2076
		2077	`=cut`
		2078

Subversion Repositories DevTools

(root)/core_devl/branches/gitBuilder/TOOLS/escrow.pl – Rev 295