Subversion Repositories DevTools

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

# Copyright (C) 1998-2012 Vix Technology, All rights reserved

#

# Module name   : cc2svn_gendata.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Get all packages that are used in all releases

#                 Create a data file that can be used offline

#

#                 The process will exclude some old releases

#

#                 Generate data on Essential Package Versions to be

#                 transferred from CC to Subversion

#

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

require 5.006_001;

use strict;

use warnings;

use JatsError;

use JatsSystem;

use Getopt::Long;

use Pod::Usage;                             # required for help support

use JatsRmApi;

use ConfigurationFile;

use DBI;

use HTTP::Date;

my $VERSION = "1.2.3";                      # Update this

my $opt_verbose = 0;

my $opt_help = 0;

my $opt_manual;

my $opt_test;

my $opt_limit;

my $opt_quick;

my $RM_DB;

my $now = time();

#

#   Package information

#

my %Releases;

my %Packages;

my %Suffixes;

my @StrayPackages;

my %AllPackages;

my $doAllReleases = 0;

my $doIncludeOnly = 0;

my @includedProjects = (

#        481,    # UK BUS HOPS

);

my @includedReleases = (

        6222,   # HOME > UK STAGE COACH (SSW) > Mainline

        14503,  # HOME > UK STAGE COACH (SSW) > ITSO_HOPS_3

        21303,  # HOME > UK STAGE COACH (SSW) > SUPPORT_HOPS_REPORTS

        21343,  # HOME > UK STAGE COACH (SSW) > SUPPORT_CIPP

        17223,  # HOME > UK STAGE COACH (SSW) > ITSO HOPS 4

);

my @excludeProjects = ( 162,            # WASHINGTON (WDC)

                        341,            # TUTORIAL (TUT)

                        142,            # SYDNEY (SYD)

                        182 ,           # ROME (ROM)

                        6 ,             # GMPTE/PCL (GMP)

                        521,            # NSW CLUB CARD

                        221,            # NZ STAGE COACH (NZS)

                        82              # LVS

                        );

my @excludeReleases = ( 20424,          # MASS_REF (MAS) > test

                        9043,           # TECHNOLOGY GROUP > Development Environment - For Test Setup

                        #9263,           # TECHNOLOGY GROUP > Buildtool DEVI&TEST

                        14383,          # TECHNOLOGY GROUP > eBrio TDS

                        20463,          # TECHNOLOGY GROUP > TPIT - BackOffice Linux build

                        14603,          # TECHNOLOGY GROUP > TPIT - BackOffice 64 bit [CCB Mode!]

                        22163,          # GLOBAL PRODUCT MGMT > Rio Tinto - Remote Draught Survey

                        19483,          # SEATTLE (SEA) > Phase 2 - I18 [backup] [Restrictive Mode]

                        20403,          # SEATTLE (SEA) > Phase 2 - I19 [backup]

                        20983,          # ??? May have been deleted

                        );

my %sillyVersions =

(

    '2b6'           => '2.6.0.cots',

    '1.0b2'         => '1.0.2.cots',

    '1.6.x'         => '1.6.0.cots',

    '3.5beta12.5'   => '3.5.12.5.cots',

);

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

# Function        : Main Entry

#

# Description     :

#

# Inputs          :

#

# Returns         :

#

my $result = GetOptions (

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

                "manual"        => \$opt_manual,        # flag

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

                "test:s"        => \$opt_test,          # Test a version string

                "limit:n"       => \$opt_limit,         #

                "quick"         => \$opt_quick,         # Don't look for indirects

                );

#

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

if ( $opt_test )

{

    my @results = massageVersion( $opt_test, 'DummyName' );

    Message ("Version", $opt_test, @results);

    exit 1;

}

ErrorConfig( 'name'    =>'CC2SVN_GENDATA' );

GetAllPackageNames();

getReleaseDetails();

getPkgDetailsByRTAG_ID();

my $count;

$count = keys %Packages;

print "Directly referenced Packages: $count\n";

LocateStrays() unless ($opt_quick);

$count = keys %Packages;

print "Indirectly referenced Packages: $count\n";

outputData();

if ( $opt_verbose > 1 )

{

    print "=========================================================================\n";

    DebugDumpData("Releases", \%Releases);

    print "=========================================================================\n";

    DebugDumpData("Packages", \%Packages );

    print "=========================================================================\n";

    DebugDumpData("Suffixes", \%Suffixes );

}

$count = keys %Packages;

print "Total References Packages: $count\n";

exit;

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

# Function        : getReleaseDetails

#

# Description     : Determine all candiate releases

#

# Inputs          : 

#

# Returns         : 

#

sub getReleaseDetails

{

    my (@row);

    # if we are not or cannot connect then return 0 as we have not found anything

    connectRM(\$RM_DB) unless $RM_DB;

    # First get all packages that are referenced in a Release

    # This will only get the top level packages

    # From non-archived releases

    my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .

                   " FROM release_manager.release_tags rt, release_manager.projects prj" .

                   " WHERE prj.PROJ_ID = rt.PROJ_ID " .

                   "   AND rt.official != 'A' AND rt.official != 'Y'" .

                   " order by prj.PROJ_NAME";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

#            print "--- Execute\n";

            if ( $sth->rows )

            {

#                print "--- Execute ROWS\n";

                while ( @row = $sth->fetchrow_array )

                {

                    my $rtag_id =$row[3];

                    my $proj_id = $row[2];

                    $Releases{$rtag_id}{pName} = $row[0];

                    $Releases{$rtag_id}{name} = $row[1];

                    $Releases{$rtag_id}{proj_id} = $proj_id;

                    $Releases{$rtag_id}{rtag_id} = $rtag_id;

                    $Releases{$rtag_id}{official} = $row[4];

                    unless ( $doAllReleases )

                    {

                        if (grep {$_ eq $proj_id} @excludeProjects) {

                            $Releases{$rtag_id}{excluded} = 'E';

                        }

                        if (grep {$_ eq $rtag_id} @excludeReleases) {

                            $Releases{$rtag_id}{excluded} = 'E';

                        }

                    }

                    if ( $doIncludeOnly )

                    {

                        if (grep {$_ eq $proj_id} @includedProjects)

                        {

                            delete $Releases{$rtag_id}{excluded};

                        }

                        else

                        {

                            $Releases{$rtag_id}{excluded} = 'E';

                        }

                        if (grep {$_ eq $rtag_id} @includedReleases)

                        {

                            delete $Releases{$rtag_id}{excluded};

                        }

                    }

                    unshift @row, $Releases{$rtag_id}{excluded} || ' ';

                    print join (',',@row), "\n" if ($opt_verbose);

                }

            }

#            print "--- Finish\n";

            $sth->finish();

        }

        else

        {

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

        }

    }

    else

    {

        Error("Prepare failure" );

    }

}

sub getPkgDetailsByRTAG_ID

{

    my (@row);

    my $excludes = '';

    my $count = 0;

    # if we are not or cannot connect then return 0 as we have not found anything

    connectRM(\$RM_DB) unless $RM_DB;

    Message ("Extract toplevel dependencies");

    # First get all packages that are referenced in a Release

    # This will only get the top level packages

    # From non-archived releases

    unless ($doAllReleases)

    {

        foreach  ( @excludeProjects )

        {

            $excludes .= " AND prj.PROJ_ID != $_ ";

        }

        foreach  ( @excludeReleases )

        {

            $excludes .= " AND rt.RTAG_ID != $_ ";

        }

    }

    my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.DLOCKED" .

                   "    , release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), pv.PKG_ID" .

                   "    , rt.RTAG_ID, rmv.VIEW_NAME, pv.MODIFIED_STAMP, prj.PROJ_ID" .

                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv,".

                   "      RELEASE_MANAGER.PACKAGES pkg, release_manager.release_tags rt, release_manager.projects prj" .

                   "    , release_manager.views rmv" .

                   " WHERE rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .

                   "   AND rmv.VIEW_ID = rc.BASE_VIEW_ID" .

                   "   AND prj.PROJ_ID = rt.PROJ_ID and rt.RTAG_ID = rc.RTAG_ID" .

                   "   AND rt.official != 'A' AND rt.official != 'Y'" .

                   $excludes .

                   " order by pkg.PKG_NAME";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

#            print "--- Execute\n";

            if ( $sth->rows )

            {

#                print "--- Execute ROWS\n";

                while ( @row = $sth->fetchrow_array )

                {

                    print join (',',@row), "\n" if ($opt_verbose);

                    my $pvid = $row[0];

                    unless ( exists $Packages{$pvid}{name} )

                    {

                        $Packages{$pvid}{name} = $row[1];

                        $Packages{$pvid}{version} = $row[2];

                        $Packages{$pvid}{locked} = $row[3];

                        $row[4] =~ tr~\\/~/~;

                        $Packages{$pvid}{vcstag} = $row[4];

                        $Packages{$pvid}{pkgid} = $row[5];

                        $Packages{$pvid}{tlp} = 1;

                        ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version}, $Packages{$pvid}{name} );

                        $Suffixes{$Packages{$pvid}{suffix}}++;

                        push @StrayPackages, $pvid;

                    }

                    my $rtag_id = $row[6];

                    push @{$Packages{$pvid}{release}}, $rtag_id;

                    $Packages{$pvid}{view}{$row[7]}++ if ( $row[7] );

                    $Packages{$pvid}{Age} = ($now - str2time( $row[8] )) / (60 * 60 * 24);

                    my $proj_id = $row[9];

                    push @{$Packages{$pvid}{projects}}, $proj_id;

                    if ( $doIncludeOnly )

                    {

                        if (grep {$_ eq $proj_id} @includedProjects)

                        {

                            $Packages{$pvid}{NamedProject} = 1;

                        }

                        if (grep {$_ eq $rtag_id} @includedReleases)

                        {

                            $Packages{$pvid}{NamedProject} = 1;

                        }

                    }

                    else

                    {

                        $Packages{$pvid}{NamedProject} = 1;

                    }

                    if ( $opt_limit )

                    {

                        last if ( $count++ > $opt_limit );

                    }

                }

            }

#            print "--- Finish\n";

            $sth->finish();

        }

        else

        {

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

        }

    }

    else

    {

        Error("Prepare failure" );

    }

}

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

# Function        : GetDepends

#

# Description     :

#

# Inputs          : $pvid

#

# Returns         :

#

sub GetDepends

{

    my ($pv_id ) = @_;

    #

    #   Now extract the package dependacies

    #

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.DLOCKED, release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), pv.PKG_ID, pv.MODIFIED_STAMP" .

                  " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .

                  " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID" .

                  "       AND pv.PKG_ID = pkg.PKG_ID";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( my @row = $sth->fetchrow_array )

                {

                    my $pvid = $row[0];

                    unless ( exists $Packages{$pvid}{name} )

                    {

                        print join (',',@row), "\n" if ($opt_verbose) ;

                        $Packages{$pvid}{name} = $row[1];

                        $Packages{$pvid}{version} = $row[2];

                        $Packages{$pvid}{locked} = $row[3];

                        $row[4] =~ tr~\\/~/~;

                        $Packages{$pvid}{vcstag} = $row[4];

                        $Packages{$pvid}{pkgid} = $row[5];

                        $Packages{$pvid}{Age} = ($now - str2time( $row[6] )) / (60 * 60 * 24);

                        $Packages{$pvid}{depend} = 1;

                        ($Packages{$pvid}{suffix}, $Packages{$pvid}{fullVersion},$Packages{$pvid}{isaRipple} ) = massageVersion( $Packages{$pvid}{version},$Packages{$pvid}{name} );

                        $Suffixes{$Packages{$pvid}{suffix}}++;

                        push @StrayPackages, $pvid;

                    }

                    push @{$Packages{$pvid}{usedBy}}, $pv_id;

                }

            }

            $sth->finish();

        }

        else

        {

        Error("GetDepends:Execute failure" );

        }

    }

    else

    {

        Error("GetDepends:Prepare failure" );

    }

}

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

# Function        : GetAllPackageNames

#

# Description     :

#

# Inputs          : None

#

# Returns         :

#

sub GetAllPackageNames

{

    # if we are not or cannot connect then return 0 as we have not found anything

    connectRM(\$RM_DB) unless $RM_DB;

    #

    #   Now extract all the package names

    #

    my $m_sqlstr = "SELECT pkg.PKG_ID, pkg.PKG_NAME" .

                  " FROM RELEASE_MANAGER.PACKAGES pkg";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( my @row = $sth->fetchrow_array )

                {

                    my $id = $row[0];

                    my $name = $row[1];

                    next unless ( $id );

                    $AllPackages{$id} = $name;

                }

            }

            $sth->finish();

        }

        else

        {

        Error("GetAllPackageNames:Execute failure" );

        }

    }

    else

    {

        Error("GetAllPackageNames:Prepare failure" );

    }

}

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

# Function        : massageVersion

#

# Description     : Process a version number and return usful bits

#

# Inputs          : Version Number

#                   Package Name - debug only

#

# Returns         : An array

#                       suffix

#                       multipart version string useful for text comparisons

#

sub massageVersion

{

    my ($version, $name) = @_;

    my ($major, $minor, $patch, $build, $suffix);

    my $result;

    my $isaRipple;

    my $isaWIP;

    $build = 0;

    #

    #   Pre-massage some silly ones

    #

    if ( exists $sillyVersions{$version} ) {

        $version = $sillyVersions{$version};

    }

    if ( $version =~ m~(.*)\.cots$~ ) {

        my $cots_base = $1;

        $suffix = '.cots';

        if ( $version =~ m~(.*?)\.([0-9]{4})\.cots$~ )

        {

            $result = $1 . sprintf (".%4.4d", $2) . $suffix;

        }

        else

        {

            $result = $cots_base . '.0000.cots';

        }

    }

    #

    #   Convert version into full form for comparisions

    #       nnn.nnn.nnn.[p]nnn.xxx

    #       nnn.nnn.nnn.[p]nnn-xxx

    #       nnn.nnn.nnn-[p]nnn.xxx

    #       nnn.nnn.nnn-[p]nnn-xxx

    #       nnn.nnn.nnn[p]nnn-xxx

    #

    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {

        $major = $1;

        $minor = $2;

        $patch = $3;

        $build = $4;

        $suffix = defined $6 ? ".$6" : '';

    }

    #

    #       nn.nnn.nnnnn.xxx

    #       nn.nnn.nnnnn-xxx

    #

    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([-.](.*))?$~ ) {

        $major = $1;

        $minor = $2;

        $patch = $3;

        if ( length( $patch) >= 4 )

        {

            $build = substr( $patch, -3 ,3);

            $patch = substr( $patch,  0 ,length($patch)-3);

        }

        $suffix = defined $5 ? ".$5" : '';

    }

    #

    #       nn.nnn.nnn_nnn

    #

    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-_.](\d+)$~ ) {

        $major = $1;

        $minor = $2;

        $patch = $3;

        $build = $4;

        $suffix = '';

    }

    #

    #       nnn.nnn.nnn

    #       nnn.nnn-nnn

    #

    elsif ( $version =~ m~^(\d+)\.(\d+)[-.](\d+)$~ ) {

        $major = $1;

        $minor = $2;

        $patch = $3;

        $suffix = '';

    }

    #

    #       nnn.nnn

    #

    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {

        $major = $1;

        $minor = $2;

        $patch = 0;

        $suffix = '';

    }

    #

    #       nnn.nnn.nnnz

    #

    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {

        $major = $1;

        $minor = $2;

        $patch = $3;

        $build = ord($4) - ord('a');

        $suffix = '.cots';

    }

    #

    #       ???REV=???

    #

    elsif ( $version =~ m~REV=~ ) {

        $suffix = '.cots';

        $result = $version . '.0000.cots';

    }

    #

    #   Wip Packages

    #   Should be essential, but want to sort very low

    #

    elsif ($version =~ m~\((.*)\)(\.*)~) {

        $suffix = $2;

        $result = "000.000.000.000.$suffix";

        $isaWIP = 1;

    }

    #

    #   zzzzzzzzzzzzzzz.cots

    #   zzzzzzzzzz.nnnn.cots

    #

    else  {

        Warning ("Unknown version number: '$name','$version'");

        $version =~ m~(\.\w+)$~;

        $suffix = $1 || '';

        $result = $version;

    }

    $isaRipple = ($build > 0);

    unless ( $result )

    {

        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');

    }

#    $suffix = $suffixFixup{$suffix} if ( exists $suffixFixup{$suffix} );

    return ($suffix, $result, $isaRipple, $isaWIP );

}

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

# Function        : LocateStrays

#

# Description     :

#

# Inputs          :

#

# Returns         :

#

sub LocateStrays

{

    Message ("Locate indirectly referenced packages");

    while ( $#StrayPackages >= 0 )

    {

        my $pv_id = pop @StrayPackages;

        next if ( exists $Packages{$pv_id}{done} );

#print "... ",$#StrayPackages,"\n";

        GetDepends( $pv_id);

        $Packages{$pv_id}{done} = 1;

    }

}

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

# Function        : outputData

#

# Description     : Write out data in a form to allow post processing

#

# Inputs          : 

#

# Returns         : 

#

sub outputData

{

    my $file = "cc2svn.raw.txt";

    Message ("Create: $file");

    my $fh = ConfigurationFile::New( $file );

    $fh->DumpData(

        "\n# Releases.\n#\n",

        "ScmReleases", \%Releases );

    foreach ( keys %Packages )

    {

        delete $Packages{$_}{done};

        next if ( $Packages{$_}{name} =~ ~m~CSWcfengine~ );

        if ($Packages{$_}{name} eq 'Activestate Perl - Solaris')

        {

            delete $Packages{$_};

            next;

        }

        if ( $Packages{$_}{name} =~ m/^CSW/ || $Packages{$_}{name} =~ m/^Solaris$/)

        {

            delete $Packages{$_};

            next;

        }

        if ( $Packages{$_}{name} =~ m/^jats_/)

        {

            delete $Packages{$_};

            next;

        }

    }

    $fh->DumpData(

        "\n# Packages.\n#\n",

        "ScmPackages", \%Packages );

    $fh->DumpData(

        "\n# Suffixes.\n#\n",

        "ScmSuffixes", \%Suffixes );

    $fh->DumpData(

        "\n# All Package Names.\n#\n",

        "ScmAllPackages", \%AllPackages );

    #

    #   Close out the file

    #

    $fh->Close();

#    #

#    #   Split up package data into small files for easy consumption

#    #

#

#    foreach ( keys %Packages )

#    {

#        my $file = "cc2svn.raw.${_}.txt";

#        Message ("Create: $file");

#        my $fh = ConfigurationFile::New( $file );

#

#        $fh->DumpData(

#            "\n# Releases.\n#\n",

#            "ScmReleases", \$Packages{$_} );

#        $fh->Close();

#    }

}

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

#   Documentation

#

=pod

=for htmltoc    SYSUTIL::cc2svn::

=head1 NAME

cc2svn_gendata - Extract CC2SVN Essential Package Data from Release Manager

=head1 SYNOPSIS

  jats cc2svn_gendata [options]

 Options:

    -help              - brief help message

    -help -help        - Detailed help message

    -man               - Full documentation

    -test=version      - Test a version string, then exit

    -limit=n           - Limit packages processed. Test only

=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.

=item B<-man>

Prints the manual page and exits.

=item B<-test=version>

Examine a package version string and report how the tool will parse it.

=item B<-limit=n>

Limit the number of packages processed by the tool. This is only used to

simplify testing of the program

=back

=head1 DESCRIPTION

This program is a tool used in the conversion of ClearCase VOBS to subversion.

It will:

=over 8

=item *

Determine all Releases in Release manager and mark those that

are to be excluded.

=item *

Determine all the package-versions used by the releases that are

not excluded. These are called 'direct' dependencies.

=item *

Recursively find all the dependent packages of all packages. New package

versions are called 'indirect' dependencies. They are buried. This process can

take several minutes.

=back

The data collected is dumped into a text file for later processing.

=cut