Subversion Repositories DevTools

########################################################################

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : jats_generate_deployable.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats build system

#

# Description   : Extracts current package version list from release manager

#                 based on the 'IS_DEPOLYABLE' flag in a given Release

#                 and copies resultant packages to release specific

#                 directory.

#                 

#                 Based on jats_update_release.pl and jats_gen_bom.pl but it is 

#                 intended to be used by the PULSE digital distribution process

#......................................................................#

require 5.008_002;

use File::Basename;

use File::Copy;

use File::Path;

use strict;

use warnings;

use JatsEnv;

use JatsError;

use JatsRmApi;

use ArrayHashUtils;

use FileUtils;

use DBI;

use Getopt::Long;

use Pod::Usage;                             # required for help support

use JSON;

#

#   Config Options

#

my $VERSION = "1.0.0";                      # Update this

my $opt_help = 0;

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_rtagid;

my $opt_rootdir = '.';

my $opt_test;

my $opt_showFilters;

my @opt_addFilters;

my @opt_delFilters;

my $opt_showFiles;

my @opt_addFiles;

my @opt_delFiles;

my $opt_symlinks;

#

#   Constants

#

my $CONFFILE = '.bomGen';

my $BOMFILE = '.bomCots';

my $MANIFEST = 'MANIFEST.json';

my $TFVARS   = 'MANIFEST.tf';

#

#   Globals

#

my $DM_DB;              # Data Base Interface

my %bomList;            # All files in the BOM

my $bomInfo;            # Sbom meta data

my %baseList;           # List of files in bin

#

#   Configuration file vars

#

my @confFilters;

my @confFiles;

my %filtersUsed;

#-------------------------------------------------------------------------------

# Function        : Main

#

# Description     : Main entry point

#                   Parse user options

#

# Inputs          :

#

# Returns         :

#

my $result = GetOptions (

                "help:+"            => \$opt_help,              # flag, multiple use allowed

                "manual:3"          => \$opt_help,              # flag, multiple use allowed

                "verbose:+"         => \$opt_verbose,           # flag

                "rtagid|rtag_id=s"  => \$opt_rtagid,            # Number

                "rootdir=s"         => \$opt_rootdir,           # string

                "symlinks!"         => \$opt_symlinks,          # Boolean

                "addfilter=s"       => \@opt_addFilters,        # multiple strings

                "delfilter=s"       => \@opt_delFilters,        # multiple strings

                "showfilters"       => \$opt_showFilters,       # flag

                "addfiles=s"       => \@opt_addFiles,           # multiple strings

                "delfiles=s"       => \@opt_delFiles,           # multiple strings

                "showfiles"        => \$opt_showFiles,          # flag

                "test"              => \$opt_test,              # flag

                );

#

#   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_help > 2);

ErrorConfig( 'name'    => 'GenDeploy',

             'verbose' => $opt_verbose );

#

#   Sanity tests

#

# Supplied rootdir must exists as a directory

Error("Root dir not specified") 

    unless defined $opt_rootdir;

Error("Root dir not a valid directory: ", $opt_rootdir )

    unless( -d $opt_rootdir );

    # Environment var GBE_DPKG must exists as a directory

Error("GBE_DPKG Environment var is not a directory")

    unless ( -d $ENV{GBE_DPKG} );

LoadFilterConfig();

ProcessFilterArgs();

#   Non Filter operations

#   Must supply an rtagid

Error("Need --rtagid", "Example: -rtagid=2362" )

    unless ($opt_rtagid);

Error("No Filters defined.", "Add filters before creating BOM") 

    unless ( @confFilters );

#

#   This command is destined to be used in a directory where group permissions

#   are important. Ensure that the user is not killing group access

#

umask 0002;

#

#   Body of the processing

#       Save generation time into the meta data

my $now = time;

$bomInfo->{version} = "2.0.0";

$bomInfo->{timestamp}{epoch} = $now;

$bomInfo->{timestamp}{utc} = gmtime($now);

Message("Copying packages from $ENV{GBE_DPKG} to $opt_rootdir") unless $opt_symlinks;

Message("Symlink packages from $opt_rootdir to $ENV{GBE_DPKG}") if $opt_symlinks;

#

#   Processing

#

connectRM(\$DM_DB);

GetReleaseInfo();               # Get Release Metadata

GetPackageData();               # Get RM Data

RemoveDuplicates();             # Need P or D, but not both

CopyInNew();                    # Copy new files

RemoveExcess();                 # Remove files no longer required

GenFileData();                  # Generate file metadata

WriteManifest();                # Save out meta data

exit 0;

#-------------------------------------------------------------------------------

# Function        : GenFileData 

#

# Description     : Generate meta data on each file

#                   Much of this is a guess.

#                   Assume files look like:

#                   

#                       VIXcryptoKeyManager-1.0.2061.cr-WIN32.exe

#                       erg-pkgmnt_1.0.3010.cr_UBUNTU16_P.deb

#                       erg-pkgmnt_1.0.3010.cr_RHEL7_P.rpm

#                       xxxxxx.sh - bit trickier

#

# Inputs          : None

#

# Returns         : Populates $bomInfo

#

sub GenFileData

{

    my @elist;

    my @edup;

    foreach my $file (sort keys %bomList)

    {

        my $data;

        my $alias;

        $bomList{$file}{version} =~ m~(.*)\.([a-z]+)$~;

        my $pvfull = $1;

        my $proj = $2;

        my $pv = $pvfull;

        $pv =~ s~\.\d+$~~;

        if ($file =~ m~^(.*)-(.*)\.(.*)-(WIN.*)\.(exe)$~i)

        {

            $data->{name} = $1;

            $data->{version} = $2;

            $data->{prj} = $3;

            $data->{arch} = $4;

            $data->{type} = $5;

        }

        elsif ( $file =~ m~^(.*)_(.*)\.([^_]+)_(.*)\.(deb|tgz|rpm)$~i)

        {

            $data->{name} = $1;

            $data->{version} = $2;

            $data->{prj} = $3;

            $data->{arch} = $4;

            $data->{type} = $5;

            $data->{arch} =~ s~_[PD]~~;

            $alias = join('.', $data->{name}, $data->{prj}, $data->{arch}, $data->{type} );

        }

        elsif ( $file =~ m~^(.*)-(.*)-(.*)\.(.*)\.(rpm)$~i)

        {

            $data->{name} = $1;

            $data->{version} = $2;

            $data->{release} = $3;

            $data->{arch} = $4;

            $data->{type} = $5;

            $alias = join('.', $data->{name}, $data->{arch}, $data->{type} );

        }

        elsif ( $file =~ m~^(.*)-($pv)\.(.*)\.(rpm)$~i)

        {

            # COTS package

            $data->{name} = $1;

            $data->{version} = $2;

            $data->{arch} = $3;

            $data->{type} = $4;

            $data->{prj} = $proj;

        }

        elsif ( $file =~ m~^(.*)_($pv)\.(tgz)$~i)

        {

            # COTS package

            $data->{name} = $1;

            $data->{version} = $2;

            $data->{arch} = 'UNKNOWN';

            $data->{type} = $3;

            $data->{prj} = $proj;

        }

        elsif ( $file =~ m~^(.*)-($pv)\.(.*)\.(deb)$~i)

        {

            # COTS package

            $data->{name} = $1;

            $data->{version} = $2;

            $data->{arch} = $3;

            $data->{type} = $4;

            $data->{prj} = $proj;

        }

        elsif ( $file =~ m~^(.*)\.(sh|zip|msi|tar\.gz)$~i)

        {

            $data->{name} = $1;

            $data->{arch} = 'NOARCH';

            $data->{type} = $2;

            $data->{version} = $pvfull;

            $data->{prj} = $proj;

        }

        unless (($data && $data->{name} && $data->{prj} && $data->{type}) || $alias) {

            push @elist, $file;

            next;

        }

        $data->{fullname} = $file;

        #

        #   Create a nice alias

        #       ERG -> VIX  (not done)

        #       All lowercase

        #

        $alias = join ('.', $data->{name}, $data->{prj}, $data->{type} ) unless defined $alias;

        $alias = lc ($alias);

        #$alias =~ s~^erg~vix~;

        #$alias =~ s~^vix~vix-~;

        #$alias =~ s~^vix--~vix-~;

        push (@edup, join( ' : ', $alias, $file ,$bomInfo->{files}{$alias}{fullname})  ) if exists $bomInfo->{files}{$alias};

        delete $data->{type};

        $bomInfo->{files}{$alias} = $data;

#Debug0("Alias: $file-> $alias");

    }

    ReportError ("Cannot extract file metadata from:", @elist)  if (@elist);

    ReportError ("Duplicate aliases for:", @edup)  if (@edup);

    ErrorDoExit();

}

#-------------------------------------------------------------------------------

# Function        : CopyInNew 

#

# Description     : Copy in new files

#                   Don't copy in files that already exist - assume that the

#                   files don't change without a chnage to the file name

#

# Inputs          : 

#

# Returns         : 

#

sub CopyInNew

{

    #

    #   Ensure the output directory exists

    #

    if ( ! -d $opt_rootdir )

    {

        if ( defined($opt_test) )

        {

            Message("mkdir $opt_rootdir");

        }

        else

        {

            eval { mkpath($opt_rootdir) };

            Error("Failed to make project directory tree $opt_rootdir") if ( $@ || ! -d $opt_rootdir );

        }

    }

    #

    #   Generate a list of all files in the directory

    #

    foreach my $file ( glob("$opt_rootdir/*") ) {

        $baseList{$file}{data} = 1;

    }

    #

    #   Determine the files to be transferred

    #

    my @filelist;

    foreach my $file ( keys %bomList)

    {

        push (@filelist, $file) unless ( -f "$opt_rootdir/$file" );

    }

    #

    #   Perform the actual copy

    #

    if ( @filelist )

    {

        #Message("Copying files for package $PKG_NAME version $PKG_VERSION");

        if ( defined($opt_test) )

        {

            Message( map("$_...", @filelist) );

        }

        else

        {

            eval { mkpath($opt_rootdir) };

            Error("Failed to make destination directory") if ( $@ || ! -d $opt_rootdir );

            foreach my $file ( @filelist )

            {

                my $srcFile = $bomList{$file}{path};

                if ($opt_symlinks)

                {

                   Verbose("Symlink: $file");

                   my $fname = catdir( $opt_rootdir, StripDir($srcFile));

                    if ( ! symlink ($srcFile, $fname) )

                    {

                        Warning("Failed to symlink $file ($!)");

                    }

                }

                else

                {

                    Verbose("Copy: $file");

                    if ( ! copy($srcFile, $opt_rootdir) )

                    {

                        Warning("Failed to copy $file ($!)");

                    }

                }

            }

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : RemoveExcess 

#

# Description     : Remove excess files from the output directory 

#

# Inputs          : 

#

# Returns         : 

#

sub RemoveExcess

{

    my @filelist;

    my %keepList = map { $_ => 1 } @confFiles;

    #

    #   Find all files in the output directory

    #   Use the 'keepList' so that we don't pickup files that should

    #   be in the directory. README.md, MANIFEST ...

    #

    foreach my $srcPath ( glob("$opt_rootdir/*") )

    {

        my $dstFile = basename($srcPath);

        next if exists $keepList{$dstFile};

        next unless ( -f $srcPath );

        push (@filelist, $dstFile) unless (exists $bomList{$dstFile} );

    }

    if ( @filelist)

    {

        Verbose ("Delete execess files", @filelist );

        unless ( defined($opt_test) )

        {

            foreach my $file ( @filelist )

            {

                Verbose2("Delete: $file...");

                if ( unlink("$opt_rootdir/$file") ne 1 )

                {

                    Warning("Failed to delete: $file. ($!)");

                }

            }

        }

    }

    #

    #   Report changed files

    #   Generate a list of all files in the directory

    #

    foreach my $file ( glob("$opt_rootdir/*") ) {

        $baseList{$file}{data} |= 2;

    }

    #

    #   Determined added, removed and replaced

    #       

    #

    my (@replaced, @added, @removed, @unchanged, %newList);

    foreach my $entry ( keys %baseList )

    {

        (my $key = $entry) =~ s~\d+~z~g;

        $baseList{$entry}{key} = $key;

        (my $name = $entry) =~ s~^\./~~;

        $newList{$key}{$baseList{$entry}{data}} = $entry;

    }

    foreach my $key ( sort keys %newList )

    {

        if (exists $newList{$key}{1} && exists $newList{$key}{2}  ) {

            push @replaced, "$newList{$key}{1}   =>   $newList{$key}{2}";

        } elsif (exists $newList{$key}{1}) {

            push @removed, $newList{$key}{1};

        } elsif (exists $newList{$key}{2}) {

            push @added, $newList{$key}{2};

        } elsif (exists $newList{$key}{3}) {

            push @unchanged, $newList{$key}{3};

        }

    }

    Message ("Unchanged: " .(@unchanged ? scalar(@unchanged ) : 'None') );

    Message ("Replaced: " . (@replaced ?  scalar(@replaced )  : 'None'), @replaced);

    Message ("Added: " .    (@added    ?  scalar(@added )     : 'None'), @added);

    Message ("Removed: " .  (@removed  ?  scalar(@removed )   : 'None'), @removed);

}

#-------------------------------------------------------------------------------

# Function        : RemoveDuplicates 

#

# Description     : Scan the BOM file list and remove duplicate installers

#                   Duplicate installers are that that have both a P and a D

#                   flavor of the installer

#                   

#                   This test has some nasty built-in knowledge (assumtions)

#                   It assumes that:

#                       Windows installers are only created for one flavor

#                           Don't need to worry about windoes installers

#                       Non windows installers are of the form:

#                           Name_Architecture_Type.deb    

#

# Inputs          : 

#

# Returns         : 

#

sub RemoveDuplicates

{

    my %baseNames;

    foreach my $file ( keys %bomList)

    {

        #

        #   Only process files that are of the expected form

        #       ie: erg-udcrypt_1.0.3043.vss_UBUNTU16_P.deb

        #

        if( $file =~ m~(.*)_([PD])(\.(deb|rpm|tgz))$~ )

        {

            my $base=$1;

            my $type=$2;

            my $suf=$3;

            if (exists $baseNames{$base} )

            {

                my $debugName = $base . '_D' . $suf;  

                Verbose("Remove debug installer: $file. Kill: $debugName");

                delete $bomList{$debugName};

            }

            $baseNames{$base} = $type;

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : LoadFilterConfig  

#

# Description     : Load Filter Config

#                   Retain filter config for future reference 

#

# Inputs          : 

#

# Returns         : 

#

sub LoadFilterConfig

{

    if ( -f "$opt_rootdir/$CONFFILE" )

    {

        Message("Loading Config File");

        my $perl_scalar = ReadJsonFile("$opt_rootdir/$CONFFILE");

        Error ("Invalid format in Config file")

            unless (ref($perl_scalar->{filters}) eq 'ARRAY');

        push (@confFilters, @{$perl_scalar->{filters}});

        push (@confFiles, @{$perl_scalar->{keptfiles}}) if exists ($perl_scalar->{keptfiles});

    }

}

#-------------------------------------------------------------------------------

# Function        : ReadJsonFile 

#

# Description     : Read a JSON file and return the data 

#

# Inputs          : $fname  - Name of the file to read 

#

# Returns         : Ref to the JSON 

#

sub ReadJsonFile

{

    my ($fname) = @_;

    local $/;

    open(my $fh, $fname ) || Error("Failed to open $fname. $!");

    my $json_text = <$fh>;

    my $perl_scalar = decode_json( $json_text );

    close($fh);

    return $perl_scalar;

}

#-------------------------------------------------------------------------------

# Function        : WriteJsonFile 

#

# Description     : Write data into a file as JSON

#

# Inputs          : $fname  - Name of file to write

#                   $data   - Ref to data to write 

#

# Returns         : Will not return on error

#

sub WriteJsonFile

{

    my ($fname, $data) = @_;

    FileCreate ($fname, to_json( $data, { ascii => 1, pretty => 1 }));

}

#-------------------------------------------------------------------------------

# Function        : ProcessFilterArgs

#

# Description     : Process the filter based arguments 

#

# Inputs          : 

#

# Returns         : 

#

sub ProcessFilterArgs

{

    my $filterArgSeen;

    my $writeConf;

    if ( @opt_addFilters )

    {

        Message ("Adding command line filters to the release config file");

        foreach my $element (@opt_addFilters) {

            UniquePush (\@confFilters, $_ ) foreach  ( split(/,/, $element));

        }

        $writeConf = 1;

    }

    if ( @opt_delFilters )

    {

        Message ("Deleting command line filters to the release config file");

        foreach my $element (@opt_delFilters) {

            ArrayDelete (\@confFilters, $_ ) foreach  ( split(/,/, $element));

        }

        $writeConf = 1;

    }

    if ( @opt_addFiles )

    {

        Message ("Adding command line files to the release config file");

        foreach my $element (@opt_addFiles) {

            UniquePush (\@confFiles, $_ ) foreach  ( split(/,/, $element));

        }

        $writeConf = 1;

    }

    if ( @opt_delFiles )

    {

        Message ("Deleting command line files to the release config file");

        foreach my $element (@opt_delFiles) {

            ArrayDelete (\@confFiles, $_ ) foreach  ( split(/,/, $element));

        }

        $writeConf = 1;

    }

    #

    #   Save filter information

    #

    if ( $writeConf && ! defined($opt_test) )

    {

        Verbose ("Write config file");

        #

        #   Add known files

        #

        UniquePush (\@confFiles, $CONFFILE, $BOMFILE, $MANIFEST, $TFVARS);

        my $config;

        push @{$config->{filters}},@confFilters;

        push @{$config->{keptfiles}},@confFiles;

        WriteJsonFile("$opt_rootdir/$CONFFILE",$config);

    }

    #

    #   Display information to the user

    #

    if ($opt_showFilters)

    {

        Message ("Configured Filters",@confFilters );

        $filterArgSeen = 1;

    }

    if ($opt_showFiles)

    {

        Message ("Configured Files. Keep:",@confFiles );

        $filterArgSeen = 1;

    }

    #

    #   Terminate program on any filter operations

    #

    exit 0 if ( $writeConf || $filterArgSeen);

}

#-------------------------------------------------------------------------------

# Function        : WriteManifest 

#

# Description     : Save the filter config file if required

#

# Inputs          : 

#

# Returns         : 

#

sub WriteManifest

{

    return if defined($opt_test);

    #

    #   Create JSON metadata

    #

    Verbose ("Write JSON Manifest");

    my $jsonString = to_json( $bomInfo, { ascii => 1, pretty => 1, canonical => 1 } ); 

    FileCreate ($opt_rootdir . '/' . $MANIFEST, $jsonString);

    #

    #   Create Terraform data

    #       Note: Terraform variable cannot have a '.' in them

    #   

    my @tfData2;

    push @tfData2, "// Terraform variable definitions to map clean package name to full file name";

    push @tfData2, "variable vixFileName {";

    push @tfData2, "    type = \"map\"";

    push @tfData2, "    default = {" ;

    foreach my $item ( sort keys %{$bomInfo->{files}} )

    {

        push @tfData2, "        \"". $item  ."\" = \"" .$bomInfo->{files}{$item}{fullname} ."\"";

    }

    push @tfData2, "    }" ;

    push @tfData2, "}" ;

    FileCreate ($opt_rootdir . '/' . $TFVARS, @tfData2);

}

#-------------------------------------------------------------------------------

# Function        : GetReleaseInfo 

#

# Description     : Get Release Meta Data

#

# Inputs          : 

#

# Returns         : Will exit on error 

#

sub GetReleaseInfo

{

    my $m_sqlstr = "SELECT p.PROJ_ID, rt.rtag_id, p.PROJ_NAME, rt.RTAG_NAME" .

                    " FROM release_tags rt, PROJECTS p" .

                    " WHERE p.PROJ_ID = rt.PROJ_ID" .

                    " and rt.RTAG_ID = " . $opt_rtagid;

    my $sth = $DM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( my ( $proj_id, $xx, $pname, $rname ) = $sth->fetchrow_array )

                {

                    my $data;

                    $data->{product_id} = $proj_id;

                    $data->{product_name} = $pname;

                    $data->{release_rtagid} = $opt_rtagid;

                    $data->{release_name} = $rname;

                    push @{$bomInfo->{release}}, $data;

                }

            }

            else

            {

                Error("GetReleaseInfo: No rtagid found for " . $opt_rtagid);

            }

            $sth->finish();

        }

        else

        {

            Error("GetReleaseInfo: Execute failure", $sth->errstr(), $m_sqlstr );

        }

    }

    else

    {

        Error("GetReleaseInfo: Prepare failure", $sth->errstr(), $m_sqlstr );

    }

}

#-------------------------------------------------------------------------------

# Function        : GetPackageData 

#

# Description     : Extract data from RM based on the provided rtag_id

#

# Inputs          : 

#

# Returns         : 

#

sub GetPackageData

{

    my $m_sqlstr =  "SELECT p.PKG_NAME, " .

                    " pv.PKG_VERSION, " .

                    " l.name " .

                    "FROM package_versions pv, " .

                    " RELEASE_MANAGER.RELEASE_CONTENT rc, " .

                    " RELEASE_MANAGER.PACKAGES p, " .

                    " RELEASE_MANAGER.LICENCING pl, " .

                    " RELEASE_MANAGER.LICENCES l " .

                    "WHERE rc.rtag_id     = $opt_rtagid " .

                    " AND rc.pv_id         = pv.pv_id " .

                    " AND p.PKG_ID         = pv.pkg_id " .

                    " AND pv.IS_DEPLOYABLE = 'Y' " .

                    " AND pl.PV_ID(+)      = pv.pv_id " .

                    " AND pl.LICENCE       = l.LICENCE(+)" ;

#                    " and ( pv.IS_DEPLOYABLE = 'Y' or upper( p.PKG_NAME) like 'ERG%' or upper( p.PKG_NAME) like 'VIX%' )";

    my ( $PKG_NAME, $PKG_VERSION, $LICENSE );

    my $sth = $DM_DB->prepare($m_sqlstr);

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( ( $PKG_NAME, $PKG_VERSION, $LICENSE ) = $sth->fetchrow_array )

                {

                    Verbose ("Deployable: $PKG_NAME, $PKG_VERSION");

                    my $pkgDir = "$ENV{GBE_DPKG}/$PKG_NAME";

                    my $srcDir = "$ENV{GBE_DPKG}/$PKG_NAME/$PKG_VERSION";

                    my $dstDir = $opt_rootdir;

                    if ( -d "$srcDir" )

                    {

                        my $foundFiltered = 0;

                        # for each of the filter rules we glob the rule in the src pkg/version dir

                        # and if any of the globbed files dont exist in the dst dir add it to the 

                        # the filelist array of files to copy

                        foreach my $filter ( @confFilters )

                        {

                            next if ( $filter =~ m~^--~ );

                            foreach my $srcPath ( glob("$srcDir/$filter") )

                            {

                                next unless ( -f $srcPath );

                                next unless testExcluded ($srcPath);

                                $foundFiltered = 1;

                                $filtersUsed{$filter} = 1;

                                my $dstFile = basename($srcPath);

                                my $srcFile = $srcPath;

                                ReportError("File provided by multiple packages: $dstFile") if exists ($bomList{$dstFile});

                                $bomList{$dstFile}{path} = $srcPath;

                                $bomList{$dstFile}{package} = $PKG_NAME;

                                $bomList{$dstFile}{version} = $PKG_VERSION;

                                $bomList{$dstFile}{license} = $LICENSE || '';

                            }

                        }

                        # if no files found using filters then issue warning

                        Warning("No Files found for Package Version $PKG_NAME/$PKG_VERSION using supplied filters") 

                            unless ( $foundFiltered );

                        if ($foundFiltered)

                        {

                            $bomInfo->{packages}{$PKG_NAME} = $PKG_VERSION;

                        }

                    }

                    elsif ( ! -d "$pkgDir" )

                    {

                        # if srcDir and pkgDir dont exist then package is not in dpkg_archive so display message

                        Warning("Skipping Package $PKG_NAME/$PKG_VERSION as it does not exist in dpkg_archive");

                    }

                    else

                    {

                        # However if srcDir does not exist but pkgDir does exist then the package version is missing which maybe an issue

                        Warning("Missing Version $PKG_VERSION for Package $PKG_NAME in dpkg_archive");

                    }

                }

                #

                #   Report filter elements that where not used.

                #

                my @notUsed;

                foreach my $filter ( @confFilters )

                {

                    next if ( exists $filtersUsed{$filter} );

                    push @notUsed, $filter

                }

                Warning ("Unused filter rules:", @notUsed )

                    if ( @notUsed );

            }

            else

            {

                Error("No Packages for rtagid: $opt_rtagid");

            }

            $sth->finish();

        }

        else

        {

            Error("Execute failure", $sth->errstr(), $m_sqlstr );

        }

    }

    else

    {

        Error("Prepare failure", $sth->errstr(), $m_sqlstr );

    }

    #

    #   Report Commercial packages

    #   Write out a file to contain the list of COTS files

    #

    my @Commercial;

    foreach my $file (sort keys %bomList)

    {

        next unless ($bomList{$file}{license} =~ m ~^Commercial~);

        $bomList{$file}{cots} = 1;

        push @Commercial, $file;

    }

    Message ("Commercial software packages:", @Commercial);

    my $data;

    $data->{COTS} = \@Commercial;

    WriteJsonFile ("$opt_rootdir/$BOMFILE", $data);

    ErrorDoExit();

}

#-------------------------------------------------------------------------------

# Function        : testExcluded 

#

# Description     : Test a filename against the list of exclusion list 

#

# Inputs          : filename 

#

# Returns         : true - not excluded

#

sub testExcluded

{

    my ($filename) = @_;

    foreach my $ufilter ( @confFilters )

    {

        next unless ( $ufilter =~ m~^--(.*)~ );

        my $filter = glob2pat($1);

        if ( $filename =~ m~$filter~)

        {

            $filtersUsed{$ufilter} = 1;

            return 0;

        }

    }

    return 1;

}

#-------------------------------------------------------------------------------

# Function        : glob2pat

#

# Description     : Convert four shell wildcard characters into their equivalent

#                   regular expression; all other characters are quoted to

#                   render them literals.

#

# Inputs          : Shell style wildcard pattern

#

# Returns         : Perl RE

#

sub glob2pat

{

    my $globstr = shift;

    $globstr =~ s~^/~~;

    my %patmap = (

        '*' => '[^/]*',

        '?' => '[^/]',

        '[' => '[',

        ']' => ']',

        '-' => '-',

    );

    $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;

    return '/' . $globstr . '$';

}

#-------------------------------------------------------------------------------

#   Documentation

#

=pod

=for htmltoc    DEPLOY::generate_deployable

=head1 NAME

jats_generate_deployable - Extracts current package version list from Release Manager RtagId

                and copy resultant packages to a specific directory.

=head1 SYNOPSIS

  jats generate_deployable [options]

 Options:

    -help                   - Brief help message

    -help -help             - Detailed help message

    -man                    - Full documentation

    -rtagid=xxx             - Specify the Release Manager RtagId to process

    -rootdir=xxx            - Specifies the root of the releases directory

    -[no]symlinks           - Use symlinks to dpkg_archive

    -showfilters            - Display current filter set and exit

    -addfilter=xxx[,yyy]    - Add a new filter to the existing filter set

    -delfilter=xxx[,yyy]    - Delete a filter from the existing filter set

    -showfiles              - Display current kept file set and exit

    -addfiles=xxx[,yyy]     - Add a new file to the kept file set

    -delfiles=xxx[,yyy]     - Delete a file from the kept file set

    -test                   - Just log actions without copying files.

    -verbose                - Enable verbose output

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>