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   : Extact package-version data from RM
#
# 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 @newRMCred = ('NEW', 'jdbc:oracle:thin:@auawsards002:1521:RELEASEM', 'RM_READONLY', 'Tp8WmmDKMq2Z');

my $opt_reuse=1;
my $opt_help=0;
my $opt_verbose=0;
my $opt_debug=0;
my $opt_outfile;

my $pname;
my $pversion;
my $pvid;
our %rmData;
my @keyFields = qw(PV_ID RTAG_ID PROJ_ID PKG_ID CREATOR_ID MODIFIER_ID OWNER_ID LAST_PV_ID BS_ID VCS_TYPE_ID PKG_IDEXT BE_ID BSA_ID BM_ID DPV_ID DPKG_ID DOC_ID TEST_ID USER_ID ACTTYPE_ID NOTE_ID BUILD_ID TESTRUN_ID LICENCE);
my %keyFields = map {$_ => 1} @keyFields;
my %keyFieldsData;


#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
my $result = GetOptions (
                "help:+"        => \$opt_help,
                "manual:3"      => \$opt_help,
                "verbose:+"     => \$opt_verbose,
                "debug:+"       => \$opt_debug,
                "reuse!"        => \$opt_reuse,
                "outfile:s"     => \$opt_outfile,
                );

                #
                #   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'    =>'SUCK',
             'verbose' => $opt_verbose,
             'debug' => $opt_debug,
            );

#
# 
$pname = $ARGV[0];  
$pversion = $ARGV[1];
  
#   Generate the output filename
#
$opt_outfile = join('.', $pname, $pversion, 'rminfo', 'txt') unless ($opt_outfile);
my $localDataStore = $opt_outfile;
  
$ENV{GBE_RM_LOCATION} = $newRMCred[1];
$ENV{GBE_RM_USERNAME} = $newRMCred[2];
$ENV{GBE_RM_PASSWORD} = $newRMCred[3];
connectRM(\$RM_DB) unless ( $RM_DB );

$pvid = GetPvid();
Error ("Package Version not found: $pname, $pversion") unless defined $pvid;
Message("Extacting: $pname $pversion, PVID: $pvid");

#
#   Insert some basic information
#   
$rmData{METADATA}{NAME} = $pname;
$rmData{METADATA}{VERSION} = $pversion;
$rmData{METADATA}{PV_ID} = $pvid;

GetTableData('PACKAGE_VERSIONS');
GetTableData('PACKAGE_DEPENDENCIES');
GetTableData('PACKAGE_BUILD_ENV');
GetTableData('PACKAGE_BUILD_INFO');
GetTableData('PACKAGE_DOCUMENTS');
GetTableData('PACKAGE_METRICS');
GetTableData('ACTION_LOG');
GetTableData('ADDITIONAL_NOTES');
GetTableData('BUILD_INSTANCES');
GetTableData('LICENCING');
GetTableData('UNIT_TESTS');
GetTableData('RELEASE_COMPONENTS');
GetTableData('JIRA_ISSUES');

#
#   Now some indirect information
#       Test Runs - linked by build_id
GetTestRuns();

#
#   Have the basic data - don't know about blobs !!!!
#   Need to extract, as text, those fields that are used for linkage purposes
#   PV_IDs, PKG_IDS
#
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 ));

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

GetPackageHistory();

disconnectRM(\$RM_DB);
ErrorDoExit();
saveLocalData();

my @unProcessed;
foreach my $tableName (keys %keyFieldsData) {
    foreach my $name ( keys %{$keyFieldsData{$tableName}}) {
        foreach my $key ( keys %{$keyFieldsData{$tableName}{$name}}) {
            push @unProcessed, "$tableName, $name, $key";
        }
    }
}

if (@unProcessed) {
    Error("Some the key fields have not been rmMerge_processed", @unProcessed )
}

exit 0;

#-------------------------------------------------------------------------------
# Function        : GetPackageHistory 
#
# Description     : Get significant ( non ripple package versions ) since the Build
#                   system spilt ( pvid = 1150630)
#
# Inputs          : 
#
# Returns         : 
#
sub GetPackageHistory
{ 
    Verbose ("GetPackageHistory");
    my $m_sqlstr =  "SELECT pv_id, pkg_version,  Modified_stamp, User_name, Comments" .
                    " FROM ( SELECT * " .
                    "  FROM " .
                    "    (SELECT pv.build_type,pv.last_pv_id AS raw_last_pvid ,pv_id,pv.pkg_version,DECODE(pv.pv_id, pv.last_pv_id, NULL, pv.last_pv_id) AS last_pv_id, comments, to_char(pv.modified_stamp, 'DD-MON-YYYY HH24:MM') as modified_stamp, u.user_name" .
                    "    FROM release_manager.package_versions pv, users u " .
                    "    WHERE u.user_id = pv.modifier_id and pv.PKG_ID IN (SELECT pkg_id FROM release_manager.package_versions pv WHERE pv.pv_id = $pvid ) " .
                    "    ) " .
                    "    START WITH pv_id =  $pvid " .
                    "    CONNECT BY nocycle prior last_pv_id = pv_id " .
                    "  ) WHERE build_type != 'Y'  and pv_id > 1150630";


    my @row;   
    my $tag = 'PV_HISTORY_DATA';
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my @data = @row;
                    escapeRowData(\@data);
                    push @{$rmData{$tag}}, \@data;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }

    #
    #   Fudge the META data information
    #
    $tag = 'PV_HISTORY' .  '_NAMES';
    push @{$rmData{$tag}}, [ 'PV_ID', 'NUMBER', 'N', '1' ];
    push @{$rmData{$tag}}, [ 'PKG_VERSION', 'VARCHAR2', 'N', '2' ];
    push @{$rmData{$tag}}, [ 'MODIFIED_STAMP', 'VARCHAR2', 'N', '3' ];
    push @{$rmData{$tag}}, [ 'USER_NAME', 'VARCHAR2', 'N', '4' ];
    push @{$rmData{$tag}}, [ 'COMMENTS', 'VARCHAR2', 'N', '5' ];
}


#-------------------------------------------------------------------------------
# Function        : GetXrefsCommon 
#
# Description     : Common code for getting cross reference data 
#
# Inputs          : $refFields      - Ref to fields to rmMerge_process
#                   $tag           - Tag base name
#                   $sql            - Sql fragment 
#
# Returns         : 
#
sub GetXrefsCommon
{
    my ($refFields, $tag, $sql) = @_;
    my %idList;

    foreach my $name (@$refFields) {
        $rmData{XREF_MAP}{$name} = $tag;
    }

    foreach my $tableName (keys %keyFieldsData) {
        foreach my $name (@$refFields) {
            foreach my $key ( keys %{$keyFieldsData{$tableName}{$name}}) {
                $idList{ $key} = 1;
            }
        }
    }
    return unless %idList;

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

    #
    #   Create data structures
    #
    foreach my $tableName (keys %keyFieldsData) {
        my $tName = $tableName . "_XREF";
        foreach my $name (@$refFields) {
            foreach my $key ( keys %{$keyFieldsData{$tableName}{$name}}) {
                DebugDumpData("Xref", \%xRef) unless exists $xRef{$key};
                ReportError("Cannot locate cross ref for $tableName, $name, $key") unless exists $xRef{$key} ;
                $rmData{$tName}{$tag}{$key} = $xRef{$key};
            }
            delete $keyFieldsData{$tableName}{$name};
        }
    }
}

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

#-------------------------------------------------------------------------------
# Function        : GetXrefsActType 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsRtagId
{
    GetXrefsCommon( \@_, 'RTAG_ID',"select rtag_id, rtag_name from release_tags where rtag_id");
}

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

#-------------------------------------------------------------------------------
# Function        : GetXrefsIgnore 
#
# Description     : Ignore the cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsIgnore
{
    my (@refFields) = @_;
    foreach my $tableName (keys %keyFieldsData) {
        foreach my $name (@refFields) {
            delete $keyFieldsData{$tableName}{$name};
        }
    }
}

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

#-------------------------------------------------------------------------------
# Function        : GetXrefsPvid 
#
# Description     : Get cross references to other entites     
#
# Inputs          : list of keyFieldData keys to rmMerge_process
#
# Returns         : 
#
sub GetXrefsPvid
{
    GetXrefsCommon( \@_, '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 pv.pv_id");
}

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


#-------------------------------------------------------------------------------
# Function        : GetTestRuns  
#
# Description     : Get TEST_RUN Data
#
# Inputs          : 
#
# Returns         : 
#
sub GetTestRuns
{
    my ($tableName) = 'TEST_RUN';
    my (@row);
    my @names;
    Verbose ("GetTestRuns");

    #
    #   Get the list of table names
    #
    my $names = GetColumnNames($tableName);
    $rmData{$tableName . '_NAMES'} = $names;
    #
    #   Scan the colums looking for key names
    #   
    my %xref;
    my $index = 0;
    foreach my $entry ( @{$names}) {
        my $fname = $entry->[0];
        if ( exists $keyFields{$fname}) {
            $xref{$index} = $fname;    
        } elsif ( $fname =~ m~_ID~ ) {
            Error("Consider $fname in $tableName");
        }
        $index++;
    }


    #
    #   Get all the table data
    #   
    my $m_sqlstr = "select tr.* from release_manager.BUILD_INSTANCES bi, release_manager.TEST_RUN tr where tr.build_id = bi.build_id and bi.pv_id = $pvid";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my @data = @row;
                    push @{$rmData{$tableName . '_DATA'}}, \@data;

                    #
                    #   Extract key linkage fields as we go
                    #
                    while (my($index, $fname) = each %xref) {
                        my $data = $row[$index];
                        next unless defined $data;
                        next if length($data) == 0;
                        $keyFieldsData{$tableName}{$fname}{$row[$index]} = 1;
                    }

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


#-------------------------------------------------------------------------------
# Function        : GetPvid 
#
# Description     : Get the packages pvid
#
# Inputs          : 
#
# Returns         : The pvid 
#
sub GetPvid
{

    my (@row);
    my $pvid;
    Verbose ("GetPvid");

    my $m_sqlstr = "select pv_id from packages p, package_versions pv where p.pkg_name = '$pname' and pv.pkg_version = '$pversion' and p.pkg_id = pv.pkg_id";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    #print join(' ', @row), "\n";
                    $pvid = $row[0];
                    last;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }

    return $pvid;
}

#-------------------------------------------------------------------------------
# Function        : GetTableData 
#
# Description     : Get all data from a table for the package
#                   Its pretty dumb
#
# Inputs          : $tableName 
#
# Returns         : 
#
sub GetTableData
{
    my ($tableName) = @_;
    my (@row);
    my @names;
    Verbose ("GetTableData: $tableName");

    #
    #   Get the list of table names
    #
    my $names = GetColumnNames($tableName);
    $rmData{$tableName . '_NAMES'} = $names;

    #
    #   Scan the colums looking for key names
    #   
    my %xref;
    my $index = 0;
    foreach my $entry ( @{$names}) {
        my $fname = $entry->[0];
        if ( exists $keyFields{$fname}) {
            $xref{$index} = $fname;    
        } elsif ( $fname =~ m~_ID~ ) {
            Error("Consider $fname in $tableName");
        }
        $index++;
    }

    #
    #   Get all the table data
    #   
    my $m_sqlstr = "select * from release_manager.$tableName where pv_id=$pvid";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my @data = @row;
                    escapeRowData(\@data);
                    push @{$rmData{$tableName . '_DATA'}}, \@data;

                    #
                    #   Extract key linkage fields as we go
                    #
                    while (my($index, $fname) = each %xref) {
                        my $data = $row[$index];
                        next unless defined $data;
                        next if length($data) == 0;
                        $keyFieldsData{$tableName}{$fname}{$row[$index]} = 1;
                    }
                }
            }
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetColumnNames 
#
# Description     : Get Database information
#
# Inputs          : table to rmMerge_process 
#
# Returns         : Ref to an array of data
#
sub GetColumnNames
{
    my ($tableName) = @_;
    my (@row);
    my $found;
    my @names;
    Verbose ("GetColumnNames: $tableName");

    my $m_sqlstr = "select COLUMN_NAME, data_type, NULLABLE, COLUMN_ID from ALL_TAB_COLUMNS where TABLE_NAME='$tableName'";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my @data = @row;
                    $names[$row[3]-1] = \@data;
#                    print join(' ', @row), "\n";
                    $found = 1;
                }
            }
            $sth->finish();
        }
        else
        {
            Error("Execute failure: $m_sqlstr", $sth->errstr() );
        }
    }
    else
    {
        Error("Prepare failure" );
    }

    Error("Internal. Table not found: $tableName") unless $found;
    return \@names;
}

#-------------------------------------------------------------------------------
# Function        : escapeRowData 
#
# Description     : Given an array of data items massage the data so that special characters
#                   can be serailaized and deserailised via perl
#                   
#                   Special chars include: tab,newline, return
#                   
#                   At the moment there is not cross ref to the type of field
#                   Assume that if it has narsy data init then its a string
#                   and we don't do much to those
#
# Inputs          : $row    - Ref to an array
#
# Returns         : Nothing. Data is rmMerge_processed in place 
#
sub escapeRowData
{
    my ($row) = @_;
    foreach my $value ( @$row) {

        $value =~ s/([\t\r\n%'])/"%" . uc(sprintf "%2.2x" , unpack("C", $1))/eg;
    }
}



#-------------------------------------------------------------------------------
# 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 );
    }
}

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

=pod

=for htmltoc    GENERAL::ClearCase::

=head1 NAME

rmMerge_suck - Extract all Package-Version info from RM

=head1 SYNOPSIS

jats rmMerge_suck [options] PackageName PackageVersion

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -outfile=name      - Name of the output file (optional)

=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

=head1 EXAMPLE

jats rmMerge_suck PackageName PackageVersion

=cut