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

Subversion Repositories DevTools

(root)/core_devl/branches/alewis_gccinstrumented/TOOLS/escrow.pl – Rev 1403