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

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

Subversion Repositories DevTools

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