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

 ########################################################################
-# Copyright ( C ) 2007 ERG Limited, All rights reserved
+# Copyright ( C ) 2009 ERG Limited, All rights reserved
+#
-# Module name   : jats.sh
+# Module name   : escrow.pl
 # Module type   : Makefile system
-# Compiler(s)   : n/a
+# Compiler(s)   : Perl
-# Environment(s): jats
+# Environment(s): jats build system
+#
 # Description   : Determine packages from an SBOM for escrow purposes
 #                 For a given bom_id determine all used packages
 #                 Create various bits of useful information
 #                   Extract commands
 #                   Build Order
 #                   Depenendency Info
 #                   Bad Packages
+#
-#
 #......................................................................#
 require 5.006_001;
 use strict;
 use warnings;
 use DBI;
 use Getopt::Long;
 use Pod::Usage;                             # required for help support
 use Storable qw (dclone);
+#
 #   Config Options
+#
 my $VERSION = "1.0.0";              # Update this
 my $opt_help = 0;
-my $opt_manual;
 my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
 my $opt_sbom_id;
 my $opt_rtag_id;
 my $opt_test = 0;
 my $opt_patch = 1;
+#
 # Returns         :
+#
 my $result = GetOptions (
-                "help+"         => \$opt_help,              # flag, multiple use allowed
+                "help:+"        => \$opt_help,              # flag, multiple use allowed
-                "manual"        => \$opt_manual,            # flag
+                "manual:3"      => \$opt_help,              # flag, multiple use allowed
-                "verbose+"      => \$opt_verbose,           # flag
+                "verbose:+"     => \$opt_verbose,           # flag
                 "sbomid=s"      => \$opt_sbom_id,           # string
                 "sbom_id=s"     => \$opt_sbom_id,           # string
                 "rtagid=s"      => \$opt_rtag_id,           # string
                 "rtag_id=s"     => \$opt_rtag_id,           # string
                 "rootpackage=s" => \$opt_rootpkg,           # String
+#
 #   Process help and manual options
+#
 pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
 pod2usage(-verbose => 1)  if ($opt_help == 2 );
-pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
+pod2usage(-verbose => 2)  if ($opt_help > 2);
 ErrorConfig( 'name'    => 'ESCROW',
              'verbose' => $opt_verbose );
+#
 #   Sanity test
+#
-unless ( $opt_rtag_id || $opt_sbom_id || $opt_extract)
+unless ( $opt_rtag_id || $opt_sbom_id || $opt_extract || $#ARGV >= 1)
+{
     Error ("Need sbomid and/or rtagid, or -extract",
            "Example: -sbomid=13543, for NZS Phase-1",
            "Example: -sbomid=13543 -rtagid=xxxx, for NZS Phase-1, comapred against given release",
            "Example: -rtagid=2362, for Sydney R1/R2",
            "Example: -rtagid=8843 -root=StockholmSBOM",
+           "Example: PackageName PackageVersion, for extracting a single package",
+    )
+}
+#
 #   The extract option is special
 #   It places the progam in a different mode
+#
 if ( $opt_extract )
+{
     Error ("Cannot mix -extract with sbomid or rtagid" )
-        if ( $opt_rtag_id || $opt_sbom_id );
+        if ( $opt_rtag_id || $opt_sbom_id || $#ARGV >= 0 );
     extract_files();
     exit (0);
+}
 Warning ("No sbomid provided. Output based an a Release") unless ( $opt_sbom_id );
 $dm_base =~ s~BOMID~$opt_sbom_id~ if ($opt_sbom_id);
 $fpref = "release" unless ( $opt_sbom_id );
+    }
+    #
     #   For each Top Level Package determine the dependent packages
+    #
-    foreach my $pv_id ( keys %pv_id )
-    {
-        getPkgDetailsByPV_ID( $pv_id);
+    getPkgDetailsForPVIDs (keys %pv_id);
-    }
     LocateStrays();
+    #
     #   Determine packages in a given Release
+    #
     if ( $opt_rtag_id )
+    {
         getPkgDetailsByRTAG_ID( $opt_rtag_id );
+    }
+}
-else
+elsif ( $opt_rtag_id )
+{
     getPkgDetailsByRTAG_ID( $opt_rtag_id );
     if ( $opt_rootpkg )
+    {
+        #
         getPkgDetailsByPV_ID( $Release{$opt_rootpkg}{$root_vers[0]}{pv_id} );
+    }
     else
+    {
-my $count = 0;
-        foreach my $pv_id ( keys %Release_pvid )
+        getPkgDetailsForPVIDs (keys %Release_pvid);
-        {
-            next if ( $opt_test && ++$count > 2 );
-            getPkgDetailsByPV_ID( $pv_id);
-        }
+    }
     LocateStrays(1);
+}
+elsif ( $#ARGV >= 1 )
+{
+    #
+    #   Locate package and dependents
+    #   Convert package name into a PVID
+    #
+    my $pv_id = getPkgDetailsByName( @ARGV );
+    Error ("Cannot locate package by name and version: @ARGV")
+        unless ( $pv_id );
+    #
+    #   Set package as the root package
+    $opt_rootpkg = $ARGV[0];
+    getPkgDetailsByPV_ID( $pv_id  );
+    LocateStrays(2);
+}
+else
+{
+    Error ("Don't know what to do with common line arguments provided");
+}
+#
 #   Remove packages to be ignored
+#
         Error("Prepare failure" );
+    }
+}
 #-------------------------------------------------------------------------------
+# Function        : getPkgDetailsByName
+#
+# Description     : Determine the PVID for a given package name and version
+#
+# Inputs          : $pname          - Package name
+#                   $pver           - Package Version
+#
+# Returns         :
+#
+sub getPkgDetailsByName
+{
+    my ($pname, $pver) = @_;
+    my $pv_id;
+    my (@row);
+    connectRM(\$RM_DB) unless ($RM_DB);
+    # First get details for a given package version
+    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
+                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg" .
+                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
+    my $sth = $RM_DB->prepare($m_sqlstr);
+    if ( defined($sth) )
+    {
+        if ( $sth->execute( ) )
+        {
+            if ( $sth->rows )
+            {
+                while ( @row = $sth->fetchrow_array )
+                {
+                    $pv_id = $row[0];
+                    my $name = $row[1];
+                    my $ver = $row[2];
+                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id");
+                }
+            }
+            $sth->finish();
+        }
+    }
+    else
+    {
+        Error("Prepare failure" );
+    }
+    return $pv_id;
+}
+#-------------------------------------------------------------------------------
+# Function        : getPkgDetailsForPVIDs
+#
+# Description     : Get all package details by PVID, from a list of PVIDs
+#
+# Inputs          : List of PVID's to process
+#
+# Returns         : Nothing
+#
+sub getPkgDetailsForPVIDs
+{
+    my $count = 0;
+    foreach my $pv_id ( @_ )
+    {
+        next if ( $opt_test && ++$count > 2 );
+        getPkgDetailsByPV_ID( $pv_id);
+    }
+}
+#-------------------------------------------------------------------------------
 # Function        : GetDepends
+#
 # Description     : Extract the dependancies for a given package version
+#
 # Inputs          : $pvid
+#
 # Description     : Locate stray packages
 #                   These are packages that have not been defined by the
 #                   top level SBOM. These are not really stray
+#
-# Inputs          :
+# Inputs          : $mode           2: No stray tagging
-#
+#                                   0: Mark all as stray
+#                                   1: Don't mark packages as stray
+#                                      if they are in releases hash
-# Returns         :
+# Returns         : Nothing
+#
 sub LocateStrays
+{
     my ($mode) = @_;
     while ( $#StrayPackages >= 0 )
         my $ver = $DATA->[1];
         my $pv_id = $DATA->[2];
         next if ( exists $Package{$name}{$ver}{done} );
         getPkgDetailsByPV_ID ( $pv_id );
+        next if ( $mode > 1 );
         if ( $mode )
+        {
             next if ( exists $Release{$name}{$ver} );
+        }
         $Package{$name}{$ver}{stray} = 1;
 escrow - Extract Escrow Build Information
 =head1 SYNOPSIS
-  jats escrow [options]
+  jats escrow [options] [name version]
  Options:
     -help              - brief help message
     -help -help        - Detailed help message
     -man               - Full documentation
 This program is a tool for extracting Escrow build information.
 The program has two modes of operation:
 =over 8
-=item 1. Generation. Generate files describing packages within an SBOM/Release.
+=item 1. Generation. Generate files describing packages within an SBOM/Release/
+Package.
 =item 2. Extraction  Supervise extraction of source trees.
 =back
 =head2 Generation Operations
+This program has several modes of operation. The mode is determined from the
+command line arguments provided.
+=over 8
+=item   Full Escrow
-Given an SBOM_ID and/or RTAG_ID this program will:
+This mode requires an SBOM_ID. If an RTAG_ID is also provided, then additional
+information will be generated.
+=item   Release Escrow
+If only an RTAG_ID is provided then the processing wil be limited to the
+packages involved in creating the specified release.
+If a 'rootpackage' name is provided, then the processing is limited to
+packages that depend on the named package.
+=item   Single Package
+If a package name and a package version are specified on the command line,
+then the processing will be limited to the specified package and ist dependents.
+No release related information will be provided.
+=back
+The 'Full Escrow' extract is the complete operation. All others are sub-sets of
+this processing. The complete processing is:
 =over 8
 =item * Determine all the NODES in the SBOM

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/escrow.pl – Rev 279 → 281