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

Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_devl/TOOLS/escrow.pl – Rev 391