Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : rmMerge_suck.pl
# Module type   : JATS Utility
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Insert Extacted package-version data into a different RM instance
#
# Usage         : See POD at the end of this file
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;

use JatsError;
use JatsRmApi;
use JatsSystem;
use FileUtils;
use ConfigurationFile;
use File::Copy;
use DBI;
my $RM_DB;
my $VERSION = "1.0";
my @testRMCred = ('TST', 'jdbc:oracle:thin:@relmanu3.coidtfba5ouc.ap-southeast-2.rds.amazonaws.com:1521:relmanu3', 'RELEASE_MANAGER', 'MPM0$U74');
my @oldRMCred =  ('OLD', 'jdbc:oracle:thin:@auawsards001:1521:RELEASEM', 'RELEASE_MANAGER', 'ske2k0se');
my @useRmCred;
my $defaultRtagId = 6883;                                   # Used when an RRTAG_ID cannot be translated
my $defaultRtagIdText = 'CORE Software Product Line';       # Could look it up, but ...


my $opt_reuse=1;
my $opt_help=0;
my $opt_verbose=0;
my $opt_debug=0;
my $opt_live = 1;
my $opt_previous = '';
my $opt_placeKeeper;
my $opt_history = 1;
my $opt_toHistory;
my $opt_infile;
my $opt_newPackage;

my $pname;
my $pversion;
my $pvid;
our %rmData;
my %keyFieldsData;
my %buildIdMap;
my @historySummary;
my @historyShortSummary;
my $nonRipple;


#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
my $result = GetOptions (
                "help:+"        => \$opt_help,
                "manual:3"      => \$opt_help,
                "verbose:+"     => \$opt_verbose,
                "debug:+"       => \$opt_debug,
                "previous:s"    => \$opt_previous,
                "live!"         => \$opt_live,
                "placekeeper!"  => \$opt_placeKeeper,
                "history!"      => \$opt_history,
                "toHistory:s"   => \$opt_toHistory,
                "infile:s"      => \$opt_infile,
                "newPackage"    => \$opt_newPackage,
                );

                #
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                #

#
#   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 );
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ( $#ARGV != 1 );

#
#   Configure the error reporting rmMerge_process now that we have the user options
#
ErrorConfig( 'name'    =>'SPIT',
             'verbose' => $opt_verbose,
             'debug' => $opt_debug,
            );

#
# 
$pname = $ARGV[0];  
$pversion = $ARGV[1];

if ($opt_live) {
    Message("Using Live Database");
    @useRmCred = @oldRMCred;
} else  {
    @useRmCred = @testRMCred;
}
  
#   Generate the output filename
#   
$opt_infile = join('.', $pname, $pversion, 'rminfo', 'txt') unless $opt_infile; 
my $localDataStore = $opt_infile;
  
$ENV{GBE_RM_LOCATION} = $useRmCred[1];
$ENV{GBE_RM_USERNAME} = $useRmCred[2];
$ENV{GBE_RM_PASSWORD} = $useRmCred[3];
connectRM(\$RM_DB) unless ( $RM_DB );
Message("Insert: $pname $pversion");
Message("After $opt_previous") if defined $opt_previous;

$pvid = GetPvid();
Error ("Package Version already exists: $pname, $pversion") if defined $pvid;

#
#   Get the data saved by rmMerge_suck
#
restoreLocalData();

#
#   May need to create a new package name entry
#   
CheckPackageName();

#
#   Potentially massage the data a bit
#
FudgeRtagId();
MassageHistory();
MassagePreviousPackageVersion();
MassagePlaceKeeper();
InsertActionLogEntry();
CalcRippleType();

#
#   Generate Cross reference information for the various tables
#   Need to have all the cross references in place first
#
GetXrefsUsers(qw(CREATOR_ID MODIFIER_ID OWNER_ID USER_ID));
GetXrefsPvid(qw(PV_ID LAST_PV_ID DPV_ID));
GetXrefsPkg(qw(PKG_ID DPKG_ID ));
GetXrefsActType(qw( ACTTYPE_ID ));
GetXrefsRtagId(qw( RTAG_ID ));
GetXrefsLicence(qw( LICENCE ));
ErrorDoExit();

#GetXrefsIgnore(qw( TEST_ID TESTRUN_ID DOC_ID BUILD_ID));        # Primary keys - ignore
#GetXrefsIgnore(qw( BE_ID BM_ID BSA_ID BS_ID VCS_TYPE_ID));      # Assume these have not changed

#
#   Now insert data into tables in the target database
#   Need to MAP some fields
#
Message ("Flag as non-Ripple") if $nonRipple;
Message ("Flag as a Ripple") unless $nonRipple;
CreateNewPvId();
CreatePackageVersion('PACKAGE_VERSIONS');
CreatePackageData('PACKAGE_DEPENDENCIES');
CreatePackageData('ACTION_LOG');
CreatePackageData('JIRA_ISSUES');
CreatePackageData('PACKAGE_BUILD_ENV');
CreatePackageData('PACKAGE_DOCUMENTS');
CreatePackageData('PACKAGE_BUILD_INFO');
CreatePackageData('PACKAGE_METRICS');
CreatePackageData('RELEASE_COMPONENTS');
CreateAdditionalNotes('ADDITIONAL_NOTES');
CreateBuildInstances('BUILD_INSTANCES');
CreatePackageData('LICENCING');
CreateUnitTests('UNIT_TESTS');
CreateTestRun('TEST_RUN');

disconnectRM(\$RM_DB);
#DebugDumpData("keyFieldsData",\%keyFieldsData);
exit 0;

#-------------------------------------------------------------------------------
# Function        : CalcRippleType 
#
# Description     : Have a guess as to the type of this package-version
#                   If its a 'Ripple' then we want to flag it as a non-ripple
#                   Checks:
#                       If there is extended history - then assume in nonRipple
#                       If its  new Package - then its a non ripple
#                       Then examine the previous version numbers.
#                        
#
# Inputs          : 
#
# Returns         : 
#
sub CalcRippleType
{
    return if $nonRipple;
    if ($opt_newPackage) {
        $nonRipple = 1;
        return;
    }

    # Examine the previous version numbers.
    #
    if ($opt_previous) {
        my $prevBase;
        my $prevPatch;
        my $prevRipple = 0;

        my $base;
        my $patch;
        my $ripple = 0;

        if ( $opt_previous =~ m~^(.*)\.([0-9]+)\.([a-zA-Z]+)$~) {
            $prevBase = $1;
            $prevPatch = $2;
Debug("Previous:$opt_previous - $prevBase, $prevPatch");

            if ($pversion =~ m~^(.*)\.([0-9]+)\.([a-zA-Z]+)$~ ) {
                $base = $1;
                $patch = $2;
Debug0("Previous:$pversion - $base, $patch");

                if ( $prevBase ne $base) {
                    $nonRipple = 1;
                    Debug0("Base version differs. $prevBase ne $base");
                    return;
                }

                if (length($prevPatch) > 3) {
                    $prevRipple = $prevPatch % 1000;
                    $prevPatch =  int($prevPatch / 1000);
                }

                if (length($patch) > 3) {
                    $ripple = $patch % 1000;
                    $patch =  int($patch / 1000);
                }

                if ( $prevPatch ne $patch) {
                    $nonRipple = 1;
                    Debug0("Patch version differs. $prevPatch ne $patch");
                    return;
                }

                return;
            } elsif ($pversion =~ m~^\((.*)\)\.([a-zA-Z]+)$~ ) {
                Debug0("WIP Detected");
                $nonRipple = 0;
                return;
            }
        } 
        Error("Could not parse version numbers: $opt_previous, $pversion" );
    }
}


#-------------------------------------------------------------------------------
# Function        : FudgeRtagId 
#
# Description     : Ensure that the $defaultRtagId is in the RTAG lookup tables
#                   Only used in BUILD_INSTANCES
#                   Could 'look' for all occurences
#
# Inputs          : 
#
# Returns         : 
#
sub FudgeRtagId
{
    my $entry = $rmData{BUILD_INSTANCES_XREF};
    return unless $entry;

    $entry = $entry->{RTAG_ID};
    if ($entry) {
        unless (exists $entry->{$defaultRtagId}) {
            $entry->{$defaultRtagId} = $defaultRtagIdText;
        }
    } else {
        Warning ("FudgeRtagId - cannot find expected table - BUILD_INSTANCES_XREF:RTAG_ID","Possibly NULL rtagId");
    }
}

#-------------------------------------------------------------------------------
# Function        : MassageHistory 
#
# Description     : If required, create a nice textual history of the package
#                   dating back to the Release Managr split
#
# Inputs          : 
#
# Returns         : 
#
sub MassageHistory
{
    return unless $opt_history;
    return unless exists $rmData{PV_HISTORY_DATA};

    #
    #   Locate the history section
    #
    my $history = $rmData{PV_HISTORY_DATA};

    # Get useful indexes
    my $idxVersion = getIndex('PV_HISTORY', 'PKG_VERSION');
    my $idxDate    = getIndex('PV_HISTORY', 'MODIFIED_STAMP');
    my $idxUser    = getIndex('PV_HISTORY', 'USER_NAME');
    my $idxText    = getIndex('PV_HISTORY', 'COMMENTS');

    #
    #   Scan entries looking for max length of user name
    #   Simply for a pretty picture
    #
    my $maxUlen = 1;
    foreach my $item ( @{$history}) {
        my $ulen = length ($item->[$idxUser]);
        if ($ulen > $maxUlen) {
            $maxUlen = $ulen;
        }
    }

    #
    #   Process each history item
    #   Don't include my own history entry
    #   Stop when we get to the 'previous' version as we know the history from there.
    #
    my $histCharCount = 0;
    my $histShortCharCount = 0;
    foreach my $item ( @{$history}) {
        my $lastEntry = 0;
        next if  $item->[$idxVersion] eq $pversion;
        if ($opt_previous) {
            last if $item->[$idxVersion] eq $opt_previous;
            last unless isVersionGreater( $item->[$idxVersion], $opt_previous ) ;
        }
        if ($opt_toHistory) {
            $lastEntry = 1 if ($item->[$idxVersion] eq $opt_toHistory);
        }
print("MassageHistory: $pversion, $opt_previous, $item->[$idxVersion]\n");

        my $etext = $item->[$idxText];
        $etext =~ s~(%0D%0A)+$~~;
        $etext =~ s~\s+$~~;
        $etext =~ s~^\s+~~;
        $etext =~ s~^\s+~~;

        my $text = sprintf("%-${maxUlen}.${maxUlen}s %s (%s) %s", $item->[$idxUser], $item->[$idxDate], $item->[$idxVersion], $etext);
        push @historySummary, $text;
        $histCharCount += length($text);

        $text =~ s~%0D.*$~ ...~;
        push @historyShortSummary, $text;
        $histShortCharCount += length($text);

Debug0(length($text), ":", $text);

        #
        #   We have history from major versions
        #   Force this insert to be a non-ripple
        #
        $nonRipple = 1;

        last if $lastEntry;
    }
    Message("History Text Length: $histCharCount");
}

#-------------------------------------------------------------------------------
# Function        : isVersionGreater 
#
# Description     : Test two versions
#
# Inputs          : $v1, $v2
#
# Returns         : 2 : Cannot parse
#                   1 : v1 >= v2
#                   0 : v1 < v2 or chnage in project
#                   
sub isVersionGreater
{
    my ($v1, $v2) = @_;
    my $rv = isVersionGreaterWrapper(@_);
    Debug0("isVersionGreater: $v1, $v2 :: $rv");
    return $rv;
}
sub isVersionGreaterWrapper
{
    my ($v1, $v2) = @_;
    return 1 if $v1 eq $v2;

    my ($v10, $v11, $v12, $v13, $v14, $v15 ) = SplitVersion( $v1);
    my ($v20, $v21, $v22, $v23, $v24, $v25 ) = SplitVersion( $v2);

    return 2 if (! defined($v10) || !defined($v20));
    return 2 if $v10 != $v20;

    return 0 unless $v15 eq $v25;

    #
    #   Cots type packages
    #
    if ($v10 == 2) {
        my $a = ($v11 cmp $v21); 
        if ($a > 0) {
            return 1;
        } elsif ($a < 0 ){
            return 0;
        } else {
            if ($v12 > $v22) {
                return 1;
            } elsif($v12 == $v22) {
                if ($v13 > $v23) {
                    return 1;
                } elsif ($v13 == $v23) {
                    if ($v14 >= $v24) {
                        return 1;
                    } else {
                        return 0;
                    }
                }
            }
        }
        return 0;
    }

    #
    #   Standard version scheme
    #
    if ($v11 > $v21) {
        return 1;
    } elsif ($v11 == $v21) {
        if ($v12 > $v22) {
            return 1;
        } elsif ($v12 == $v22) {
            if ($v13 > $v23) {
                return 1;
            } elsif ($v13 == $v23) {
                if ($v13 > $v23) {
                    return 1;
                } elsif ($v13 == $v23) {
                    if ($v13 > $v23) {
                        return 1;
                    } elsif ($v14 == $v24) {
                        return 1;
                    }
                }
            }
        }
    }
    return 0;
}

#-------------------------------------------------------------------------------
# Function        : SplitVersion 
#
# Description     : Spit a 'nice' version number into bits
#
# Inputs          : $vn - version number
#
# Returns         : An array of bits or UNDEF
#
sub SplitVersion
{
    my ($vn) = @_;
    if ($vn =~ m~^(\d+)\.(\d+)\.(\d+)(\d{3})\.(\w+)$~) {
        return 1,$1,$2,$3,$4,$5;
    } elsif ($vn =~ m~^(.*)\.(\d+)(\d{3})\.(\w+)$~) {
        return 2,$1,0,$2,$3,$4;
    } else {
        return undef;
    }
}

#-------------------------------------------------------------------------------
# Function        : getIndex 
#
# Description     : Get the index of a data item from specified meta data
#
# Inputs          : $table  - Name of table to access
#                   $field  - Name of field to locate
#
# Returns         : Will generte an error if not found 
#
sub getIndex
{
    my ($table,$field) = @_;
    my $rv;
    my $tableName = $table . "_NAMES";
    Error ("Internal: getIndex. Metadata not found for: $table") unless exists $rmData{$tableName};

    my $pvMetaData = $rmData{$tableName};

    foreach ( @{$pvMetaData} ) {
        next unless $_->[0] eq $field;
        $rv =  $_->[3] - 1;
        last;
    }

    Error("Internal: getIndex. Cannot find metadata for field($field) in table($table)") unless $rv;
    return $rv;
}

#-------------------------------------------------------------------------------
# Function        : MassagePlaceKeeper 
#
# Description     : Massage the data for creation of a place keeper
#
# Inputs          : 
#;
# Returns         : 
#
sub MassagePlaceKeeper
{
    return unless $opt_placeKeeper;
    Message("Generate Place Keeper Package Version");

    # Empty the a few tables
    delete $rmData{ACTION_LOG_DATA};
    delete $rmData{PACKAGE_DEPENDENCIES_DATA};
    delete $rmData{PACKAGE_METRICS_DATA};
    #delete $rmData{RELEASE_COMPONENTS_DATA};
    delete $rmData{BUILD_INSTANCES_DATA};
    delete $rmData{UNIT_TESTS_DATA};
    delete $rmData{TEST_RUN_DATA};

    delete $rmData{ACTION_LOG_XREF};
    delete $rmData{PACKAGE_DEPENDENCIES_XREF};
    delete $rmData{PACKAGE_METRICS_XREF};
    #delete $rmData{RELEASE_COMPONENTS_XREF};
    delete $rmData{BUILD_INSTANCES_XREF};
    delete $rmData{UNIT_TESTS_XREF};
    delete $rmData{TEST_RUN_XREF};
}

#-------------------------------------------------------------------------------
# Function        : MassagePreviousPackageVersion 
#
# Description     : The previous package version may not exist in the target
#                   release manager
#                   
#                   Allow the user to specify the previous package version
#                   The point at which the package will be inserted 
#
# Inputs          : 
#
# Returns         : 
#
sub MassagePreviousPackageVersion
{
    return unless $opt_previous || $opt_newPackage;

    my $pvData = $rmData{PACKAGE_VERSIONS_DATA};
    my $pvMetaData = $rmData{PACKAGE_VERSIONS_NAMES};
    my $idxPrevVer;
    my $prevPvid;

    #
    #   Find the 'LAST_PV_ID' index
    #
    foreach ( @{$pvMetaData} ) {
        next unless $_->[0] eq 'LAST_PV_ID';
        $idxPrevVer =  $_->[3] - 1;
        last;
    }
    Error ("Internal: Cannot find index of the LAST_PV_ID field") unless defined $idxPrevVer;
    $prevPvid = $pvData->[0][$idxPrevVer]; 
    Message("Previous version was:" . $prevPvid);

    #
    #   Fudge the 'XREF_PV_ID' entry
    # 
    Error("No 'XREF_PV_ID' entry for previous version") unless exists $rmData{PACKAGE_VERSIONS_XREF}{PV_ID}{$prevPvid};

    if ($opt_newPackage) {
        delete $rmData{PACKAGE_VERSIONS_XREF}{PV_ID}{$prevPvid} unless ( $rmData{METADATA}{PV_ID} eq $prevPvid);
        $prevPvid = $pvData->[0][$idxPrevVer] = $rmData{METADATA}{PV_ID};

    } else {
        $rmData{PACKAGE_VERSIONS_XREF}{PV_ID}{$prevPvid} = join($;, $pname, $opt_previous);
    }
}

#-------------------------------------------------------------------------------
# Function        : InsertActionLogEntry 
#
# Description     : Add an action log to mark the migration of this package
#                   Assume the format of the action log
#                       'USER_ID', 'ACTION_DATETIME' 'PV_ID' 'DESCRIPTION' 'ACTTYPE_ID' 'ACTION_TIMESTAMP'
#
# Inputs          : 
#
# Returns         : 
#
sub InsertActionLogEntry
{
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   my $timeStamp = sprintf("%4.4d-%02d-%02d %02d:%02d:%02d.0", $year + 1900, $mon+1, $mday, $hour,$min,$sec);
   my $txt = $opt_placeKeeper ? "Version migrated from Pulse as a placekeeper. This version will not build" : "Version migrated from Pulse";
    push @{$rmData{ACTION_LOG_DATA}}, [
             3768,                      # buildadm
             $timeStamp,                # 2017-06-12 10:04:10.0
             $rmData{METADATA}{PV_ID},  # PV_ID
             $txt,
             66,                        # Action ID = 'Version Control System Converted'
             $timeStamp                 # 2017-6-12.10.4. 10. 155886000
        ];

        # Kludge in action type
        $rmData{ACTION_LOG_XREF}{USER_ID}{3768} = 'buildadm';
        $rmData{ACTION_LOG_XREF}{ACT_TYPE}{66} = 'VcsConversion';

        #DebugDumpData("Action_LOG", $rmData{ACTION_LOG_DATA});
}


#-------------------------------------------------------------------------------
# Function        : CheckPackageName 
#
# Description     : Check that the package name exists
#                   If not then create it
#                   Need to insert the generated pkg_id into the rmData so that
#                   it can be mapped correctly    
#
# Inputs          : 
#
# Returns         : 
#
sub CheckPackageName
{
    my $pkgName = $rmData{METADATA}{NAME};
    my @row = GetOneSqlRow("select pkg_id, pkg_name from packages p where p.pkg_name = '$pkgName'");
    if (!defined $row[0]) {
        #
        #   Need to create a new package_name
        #
        my $newPkgId = GetNextSeqNum('seq_pkg_id');
        Message("Need to create a new Package Name with pkg_id: $newPkgId");
        my $m_sqlstr = "insert into packages (pkg_id, pkg_name) values($newPkgId, '$pkgName' )";
        @row = GetOneSqlRow($m_sqlstr);
    }
}

#-------------------------------------------------------------------------------
# Function        : CreateTestRun  
#
# Description     : Create the entry in the TEST_RUN table
#                   Need to create a unique TESTRUN_ID for each entry
#
# Inputs          : $tableName      - Not sure it will be used
#
# Returns         : 
#
sub CreateTestRun
{
    my ($tableName) = @_;
    my $tableData = $tableName. '_DATA';

    #
    #   Get one row of data and massage it into a form suitable for insertion
    #
    my $data = $rmData{$tableData}[0];
    foreach my $data (@{$rmData{$tableData}}) {
        InsertTableRow($tableName, $data,{
            'TESTRUN_ID' => sub {return GetNextSeqNum('seq_testrun_id');},
            'BUILD_ID' => sub { 
                            my ($fname, $value) = @_;
                            my $newValue = $buildIdMap{$value};
                            Error ("Internal: Can't map build_id for $value") unless defined $newValue;
                            return $newValue;
                        }
        });
    }
}

#-------------------------------------------------------------------------------
# Function        : CreateUnitTests  
#
# Description     : Create the entry in the BUILD_INSTANCES table
#                   Need to create a unique BUILD_ID for each entry
#
# Inputs          : $tableName      - Not sure it will be used
#
# Returns         : 
#
sub CreateUnitTests
{
    my ($tableName) = @_;
    my $tableData = $tableName. '_DATA';

    #
    #   Get one row of data and massage it into a form suitable for insertion
    #
    my $data = $rmData{$tableData}[0];
    foreach my $data (@{$rmData{$tableData}}) {
        InsertTableRow($tableName, $data,{
            'TEST_ID' => sub {return GetNextSeqNum('seq_unit_tests');}
        });
    }
}

#-------------------------------------------------------------------------------
# Function        : CreateBuildInstances  
#
# Description     : Create the entry in the BUILD_INSTANCES table
#                   Need to create a unique BUILD_ID for each entry
#                   
#                   Complication. Need to create a map of build_id's
#                                 so that the build_id is available when rmMerge_processing the TEST_RUN table
#
# Inputs          : $tableName      - Not sure it will be used
#
# Returns         : 
#
sub CreateBuildInstances
{
    my ($tableName) = @_;
    my $tableData = $tableName. '_DATA';

    #
    #   Get one row of data and massage it into a form suitable for insertion
    #
    my $data = $rmData{$tableData}[0];
    foreach my $data (@{$rmData{$tableData}}) {
        InsertTableRow($tableName, $data,{
            'BUILD_ID' => sub {
                            my ($fname, $value) = @_;
                            my $build_id = GetNextSeqNum('seq_build_instance');
                            $buildIdMap{$value} = $build_id;
                            return $build_id;
                        }
        });
    }
}

#-------------------------------------------------------------------------------
# Function        : CreateAdditionalNotes  
#
# Description     : Create the entry in the ADDITIONAL_NOTES table
#                   Need to create a unique NOTE_ID for each note entered
#
# Inputs          : $tableName      - Not sure it will be used
#
# Returns         : 
#
sub CreateAdditionalNotes
{
    my ($tableName) = @_;
    my $tableData = $tableName. '_DATA';

    #
    #   Get one row of data and massage it into a form suitable for insertion
    #
    my $data = $rmData{$tableData}[0];
    foreach my $data (@{$rmData{$tableData}}) {
        InsertTableRow($tableName, $data,{
            'NOTE_ID' => sub {return GetNextSeqNum('seq_additional_notes');}
        });
    }
}

#-------------------------------------------------------------------------------
# Function        : GetNextSeqNum 
#
# Description     : Get the next sequence numbber froom a named sequence 
#
# Inputs          : $seqName 
#
# Returns         : A number
#
sub GetNextSeqNum
{
    my ($seqName) = @_;
    my @row = GetOneSqlRow("SELECT $seqName.NEXTVAL from DUAL");
    #Debug0("Generate $seqName: $row[0]");
    return $row[0];
}


#-------------------------------------------------------------------------------
# Function        : CreateNewPvId 
#
# Description     : Generate a new PV_ID and insert it into the cross reference
#                   information so tha it will be correctly substituted. 
#
# Inputs          : 
#
# Returns         : 
#
sub CreateNewPvId
{
    $pvid = GetNextSeqNum('seq_pv_id');
    Message("PackageVersion: PV_ID: $pvid");

    #
    #   PV_ID in the origin
    #   
    my $pvidOrigin = $rmData{METADATA}{PV_ID};
    $keyFieldsData{PV_ID}{$pvidOrigin} = $pvid;
}

#-------------------------------------------------------------------------------
# Function        : CreatePackageData  
#
# Description     : Insert one or more rows into a table
#                   Assumes no data massaging needs to be done
#
# Inputs          : $tableName      - Not sure it will be used
#
# Returns         : 
#
sub CreatePackageData
{
    my ($tableName) = @_;
    my $tableData = $tableName. '_DATA';

    #
    #   Get one row of data and massage it into a form suitable for insertion
    #
    foreach my $data (@{$rmData{$tableData}}) {
        InsertTableRow($tableName, $data);
    }

}

#-------------------------------------------------------------------------------
# Function        : CreatePackageVersion  
#
# Description     : Create the entry in the PACKAGE_VESRIONS table
#                   Need to create a unique PV_ID
#                   Need to MAP some entries
#                   Need to NULL some entries 
#
# Inputs          : $tableName      - Not sure it will be used
#
# Returns         : 
#
sub CreatePackageVersion
{
    my ($tableName) = @_;
    my $tableData = $tableName. '_DATA';

    #
    #   Get one row of data and massage it into a form suitable for insertion
    #
    my $data = $rmData{$tableData}[0];
    
    InsertTableRow($tableName, $data, {
        #'PKG_VERSION' => sub {my ($fname, $value) = @_; return $value .= $opt_live ? '' : '.TEST';},
        'SRC_PATH' => sub {my ($fname, $value) = @_; $value =~ s~AUPERASVN02~AUPERASVN0X~; return $value;},
        'PKG_IDEXT' => sub {my ($fname, $value) = @_; return 'PulseImport';},
        'BUILD_TYPE' => sub {
                my ($fname, $value) = @_;
                if ($opt_placeKeeper) {
                    return 'U';
                }
                if ($nonRipple && ($value eq 'Y')) {
                    return 'A';
                }

                return $value;
            },
        'COMMENTS' => sub {
                my ($fname, $value) = @_;
                $value =~ s~^(%0D%0A)~~;
                $value =~ s~(%0D%0A)+$~~;
                 
                if (length($value)> 0) {
                    $value .= "%0D%0A" ; 
                }
                $value .= "Version Imported from Pulse" unless $opt_placeKeeper; 
                $value .= "Version Imported from Pulse as a placeholder" if $opt_placeKeeper;
                
                if (@historySummary) {
                    my $text = '. Previous History' . "%0D%0A" . join("%0D%0A", @historySummary);
                    if ((length($text) + length($value)) > 4000 ) {
                        $text = '. Previous History' . "%0D%0A" . join("%0D%0A", @historyShortSummary);
                        Warning("Using abbreviated history");
                    }
                    $value .= $text;
                }
                if (length($value) > 4000) {
                    $value = substr ($value, 0, 4000);
                    $value .= "%0D%0AChopped ...";
Warning("Chopping comment string. Was " . length($value));
                }
                return $value;
            }
        });
}

#-------------------------------------------------------------------------------
# Function        : InsertTableRow 
#
# Description     : Insert a row into a table
#   
# Inputs          : $tableName
#                   $data   - Ref to data
#                   $metaData - REf to meta data    
#                   $callBacks - Hash of FieldNames, functions
#
# Returns         : 
#
sub InsertTableRow
{
    my ($tableName, $data, $callBacks) = @_;
    my $tableMetaData = $tableName. '_NAMES';
    my $metaData = $rmData{$tableMetaData};

    my @insertFields;
    my @insertValues;

    #
    #   Scan the metadata and fiddle the data
    #
    foreach my $entry ( @$metaData) {
        my $fname = $entry->[0];
        my $ftype = $entry->[1];
        my $isNullable = $entry->[2] eq 'Y';
        my $findex = $entry->[3]-1;
        my $value = $data->[$findex] || '';

        # Does this field need to be mapped
        if ($value ne '') {
            if (exists $rmData{XREF_MAP}{$fname}) {
                my $mapTable = $rmData{XREF_MAP}{$fname}; 
                Error ("Mapping table not found: $mapTable","Need: $value") unless exists $keyFieldsData{$mapTable};

                unless (exists $keyFieldsData{$mapTable}{$value}) {
                    DebugDumpData("keyFieldsData",\%keyFieldsData);
                    DebugDumpData("Data",$data);
                    Error ("Mapping value not found: $mapTable, $value, while rmMerge_processing $tableName, $fname") ;
                }
                my $newValue = $keyFieldsData{$mapTable}{$value};
                unless (defined $newValue) {
                    DebugDumpData("keyFieldsData",\%keyFieldsData);
                    DebugDumpData("Data",$data);
                    Error("Undefined map for: $tableName, $fname, $value");
                }
                if ($newValue ne $value) {
    Verbose("Mapping $tableName:$mapTable:$fname:$value -> $newValue");
                    $value = $newValue;
                }
            }
        }

        #
        #   Does the field need to be massaged
        #
        if (defined $callBacks && $callBacks->{$fname}) {
            my $newValue = $callBacks->{$fname}->($fname, $value);
            if ($newValue ne $value) {
Verbose("Massage $tableName:$fname:$value -> $newValue");
                $value = $newValue;
            }
        }

        #
        #   Does the field need to be quoted
        #   Assume that the 'suck' rmMerge_process has quoted special characters
        #   %0D -> return
        #   %0A -> newLine
        #   %09 -> Tab
        #   %25 -> As a percent
        #   %27 -> Single Quote
        #   Also need to handle a single quote char
        #
        if ($ftype =~ m~CHAR|VARCHAR~) {
            $value =~ s~'~'||chr(39)||'~g;
            $value =~ s~%0D~'||chr(13)||'~g;
            $value =~ s~%0A~'||chr(10)||'~g;
            $value =~ s~%09~'||chr(9)||'~g;
            $value =~ s~%27~'||chr(39)||'~g;
            $value =~ s~%25~%~g;
            $value = "'" . $value . "'";
#print("String Length ($fname):", length($value),"\n");

        } elsif ($ftype =~ m~DATE|TIMESTAMP~) {
            $value = "TO_TIMESTAMP('$value','YYYY-MM-DD HH24:MI:SS.FF')"
        }

        # Null item if we are allowed to
        if ($isNullable && length($value) <= 0) {
            $value = 'null';
        }

        push @insertFields, $fname;
        push @insertValues, $value;
    }

    #
    #   Generate the SQL
    #
    my $m_sqlstr = "insert into $tableName (" . join(',', @insertFields) . ")" . " VALUES (". join(',', @insertValues) .")";
    Debug("$m_sqlstr");

    my $sth = $RM_DB->prepare($m_sqlstr);
    my @row;
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    print("@row\n");
                }
            }
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetXrefCommon 
#
# Description     : Common code for fetch XREF data from the database 
#
# Inputs          : $name       - Tag name
#                   $sql        - sql fragment to do the work    
#                   $options    - Ref to a hack of options
#                                   'default' - Value to use when not found
#
# Returns         : 
#
sub GetXrefCommon
{
    my ($name,$sql, $options) = @_;

    my (@fields) = @_;
    my %idList;
    my %data;
    $options = {} unless $options;

    #
    #   Generate a hash of items that we need
    #
    foreach my $tableName ( keys %rmData ) {
        next unless $tableName =~ m~_XREF$~;
        next unless exists $rmData{$tableName}{$name};
        foreach my $id (keys %{ $rmData{$tableName}{$name} }) {
            $idList{ $rmData{$tableName}{$name}{$id} } = $id;
        }
    }

    #DebugDumpData("GetXrefCommon, $name", \%idList);
    return unless %idList;

    #
    #   Get all the table data
    #
    my @row;   
    my $m_sqlstr =  $sql . " in (". quoteList(keys %idList) .")";
#Debug0("GetXrefCommon: $m_sqlstr");
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    #print("GetXrefCommon: @row\n");
                    $data{$row[1]} = $row[0];
                }
            }
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }

    #
    #   Check that all required values have been found
    #
    foreach my $id (keys %idList) {
        if (exists $data{$id}) {
            $keyFieldsData{$name}{$idList{$id}} = $data{$id};
        } elsif (defined $options->{default}) {
            $keyFieldsData{$name}{$idList{$id}} = $options->{default};
        } else {
            ReportError("No Crossref for $name matching: $id");
            #DebugDumpData("RmData", \%rmData);
        }
    }

    #
    #   Keep the raw data in the output hash - possibly for debugging purposes
    $keyFieldsData{$name . '_DEBUG'} = \%data;
}

#-------------------------------------------------------------------------------
# Function        : GetXrefsLicence
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsLicence
{
    my (@fields) = @_;
    GetXrefCommon('LICENCE', 'select licence, name from release_manager.licences where name');
}

#-------------------------------------------------------------------------------
# Function        : GetXrefsRtagId 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsRtagId
{
    my (@fields) = @_;
    GetXrefCommon('RTAG_ID', 'select rtag_id, rtag_name from release_tags where rtag_name', {default => $defaultRtagId});
}

#-------------------------------------------------------------------------------
# Function        : GetXrefsActType 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsActType
{
    my (@fields) = @_;
    GetXrefCommon('ACT_TYPE', 'select acttype_id, name from release_manager.action_type where name');
}

#-------------------------------------------------------------------------------
# Function        : GetXrefsPkg 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsPkg
{
    my (@fields) = @_;
    GetXrefCommon('PKG_ID', 'select p.pkg_id, p.pkg_name from release_manager.packages p where p.pkg_name');
}

#-------------------------------------------------------------------------------
# Function        : GetXrefsPvid 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsPvid
{
    my (@fields) = @_;

    #
    #   Need to delete my PV_ID from the XREF tables 'PV_ID' tables
    #   as I will never be found
    #
    foreach my $tableName ( keys %rmData ) {
        next unless $tableName =~ m~_XREF$~;
        next unless exists $rmData{$tableName}{PV_ID};
        delete $rmData{$tableName}{PV_ID}{$rmData{METADATA}{PV_ID}};
    }

    GetXrefCommon('PV_ID', "select pv.pv_id, p.pkg_name || '$;' ||pv.pkg_version from release_manager.packages p, release_manager.package_versions pv" . 
                   " where p.pkg_id = pv.pkg_id and p.pkg_name || '$;' || pv.pkg_version");

}

#-------------------------------------------------------------------------------
# Function        : GetXrefsUsers 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsUsers
{
    my (@fields) = @_;
    GetXrefCommon('USER_ID', 'select user_id, user_name from access_manager.users where user_name');
}

#-------------------------------------------------------------------------------
# Function        : quoteList  
#
# Description     : Convert an array of strings into a quoted comma-sep string
#                   Used in sql of the form select ... in ( 'aaa','bbb',ccc') 
#
# Inputs          : An array of strings 
#
# Returns         : quoted comma-sep string
#

sub quoteList
{
    my $rv = '';
    my $join = '';
    foreach  (@_) {
        $rv .= $join . "'" . $_ . "'";
        $join = ',';
    }
    return $rv;
}

#-------------------------------------------------------------------------------
# Function        : GetOneSqlRow 
#
# Description     : Execute a simple SQL statement and return to the user the first row of data
#
# Inputs          : $sql - statement to execute 
#
# Returns         : And array of data
#
sub GetOneSqlRow
{
    my ($m_sqlstr) = @_;
#Debug0("GetOneSqlRow: $m_sqlstr");
    my (@row);
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) ) {
        if ( $sth->execute( ) ) {
            if ( $sth->rows ) {
#Debug0("GetOneSqlRow: @row");
                @row = $sth->fetchrow_array;
            }
            $sth->finish();

        } else {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    } else {
        Error("Prepare failure" );
    }

    return @row;
}

#-------------------------------------------------------------------------------
# Function        : GetPvid 
#
# Description     : Get the packages pvid
#
# Inputs          : 
#
# Returns         : The pvid 
#
sub GetPvid
{
    my @row = GetOneSqlRow("select pv_id from packages p, package_versions pv where p.pkg_name = 'TEST_$pname' and pv.pkg_version = '$pversion' and p.pkg_id = pv.pkg_id");
    return $row[0];
}

#-------------------------------------------------------------------------------
# Function        : saveLocalData 
#
# Description     : Saves a hash of data to disk 
#
# Inputs          : 
#
# Returns         : 
#
sub saveLocalData
{
    #
    #   Dump out the configuration information
    #
    my $fh = ConfigurationFile::New( $localDataStore);

    $fh->DumpData( "\n# rmData\n#\n", "rmData", \%rmData );
    $fh->Close();

    DebugDumpData("rmData", \%rmData);
}

#-------------------------------------------------------------------------------
# Function        : restoreLocalData 
#
# Description     : Read in the locally preserved data 
#
# Inputs          : 
#
# Returns         : 
#
sub restoreLocalData
{
    if (-f $localDataStore) {
        require ( $localDataStore );
    } else {
        Error ("Extracted data not found: $localDataStore");
    }
}

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=for htmltoc    GENERAL::ClearCase::

=head1 NAME

rmMerge_suck - Inject Package-Version info into RM from a previous extraction

=head1 SYNOPSIS

jats rmMerge_spit [options] PackageName PackageVersion

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -live              - Operation on Live data
    -prev=txt          - Prevous package version
    -[no]placeKeeper   - Only partial package creation
    -[no]history       - Append a text summary of the package history
    -newPackage        - Special Handling for a new package
    -infile=path       - Path to input file

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=back

=head2 OPTIONS

=over

=item -placeKeeper

This mode will only insert some of the package information. Suffiecient to preserve the
version number.

The dependencies are not imported. The package will not build.

Used to capture package-versions with some history.

=item -history

This option will cause a textual summary of the packages history to be added created.

The summary track non-ripple builds back to the Release Manager split.

=item -newPackage

Enable special handling of a new package. In particular the Previous version will be set to null.

=back

=head1 EXAMPLE

jats eprog rmMerge_spit PackageName PackageVersion

=cut