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

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

Subversion Repositories DevTools

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