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

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/escrow.pl – Rev 325