WebSVN – DevTools – Blame – /core_devl/trunk/TOOLS/escrow.pl

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

Subversion Repositories DevTools

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