Subversion Repositories DevTools

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

# Copyright ( C ) 2004 ERG Limited, All rights reserved

#

# Module name   : jats.sh

# Module type   : Makefile system

# Compiler(s)   : n/a

# Environment(s): jats

#

# Description   : Get package information for a package name specified on the

#                 command line.

#

#                 Determine the package id

#                 Locate all packages that have the same package name

#

#                 Pump it into SVN

#

#                 Project Based Pumping

#

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

require 5.006_001;

use strict;

use warnings;

use JatsError;

use JatsRmApi;

use FileUtils;

use JatsSystem;

#use Data::Dumper;

use Cwd;

use DBI;

use Getopt::Long;

use Pod::Usage;                             # required for help support

my $RM_DB;

my $opt_repo_base = 'https://auperasvn01.aupera.erggroup.com/svn/';

my $opt_repo;

my $opt_package;

my $opt_resume;

my $opt_flat;

my $opt_test;

my $opt_reuse;

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

#   List of Projects Suffixes and Branch Names to be used within SVN

#

my %ProjectsBaseCreated;

my %Projects = (

    '.sea' => 'Seattle',

    '.coct' => 'CapeTown',

    '.sls'  => 'Stockholm',

    '.syd'  => 'Sydney',

    '.vtk'  => 'Vasttrafik',

    '.bei'  => 'Beijing',

    '.bkk'  => 'Bangkok',

    '.mas'  => 'Mass',

    '.ndl'  => 'NewDeli',

    '.nzs'  => 'NewZealandStageCoach',

    '.was'  => 'Washington',

    '.wdc'  => 'Washington',

);

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

#   Global data

#

my $VERSION = "1.0.0";

my $currentBranchName;

my $last_pv_id;

my $pkg_id;

my %versions;

my %suffixes;

my @processOrder;

#

#   Options

#

my $opt_help = 0;

my $opt_manual = 0;

my $opt_verbose = 0;

my $result = GetOptions (

                "help+"         => \$opt_help,          # Help

                "manual"        => \$opt_manual,        # Help

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

                "repository:s"  => \$opt_repo,          # Name of repository

                "resume:s"      => \$opt_resume,        # Resume at given version

                "flat!"         => \$opt_flat,          # Flat structure

                "test!"         => \$opt_test,          # Test operations

                "reuse!"        => \$opt_reuse,         # Reuse ClearCase views

                );

#

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

#

#   Configure the error reporting process now that we have the user options

#

ErrorConfig( 'name'    =>'PLAY9d',

             'verbose' => $opt_verbose );

Error("No repository specified. ie -repo=DevTools, COTS") unless ( defined $opt_repo );

Error("Specify a package as 'name'" ) unless ( defined $ARGV[0] );

$opt_package = $ARGV[0];

$opt_repo = $opt_repo_base . $opt_repo;

Verbose( "Base Package: $opt_package");

Verbose( "Repo URL: $opt_repo");

#

#   Body of the process

#

GetPkgIdByName ( $opt_package );

GetData_by_pkg_id ( $pkg_id );

#

# Process the 'versions' hash and add back references

#

foreach my $entry ( keys(%versions) )

{

    foreach ( @{ $versions{$entry}{next}} )

    {

        $versions{$_}{last} = $entry;

    }

}

#

#   Find starts and ends

#       Entry with no previous

#       Entry with no next

#

my @startPoints;

my @endPoints;

foreach my $entry ( keys(%versions) )

{

    unless ( exists $versions{$entry}{last} )

    {

        push @startPoints, $entry;

    }

    unless ( @{$versions{$entry}{next}} > 0  )

    {

        push @endPoints, $entry;

    }

}

#

#   Create lists of entries starting at each start point

#

my $last_entry;

my @list;

my %startLists;

foreach my $entry ( @startPoints )

{

    $last_entry = 0;

    @list = ();

    processBranchLists($entry);

    @{$startLists{$entry}} = @list;

    sub processBranchLists

    {

        foreach my $entry ( @_ )

        {

            if ( $entry > $last_entry )

            {

                $last_entry = $entry;

            }

            push @list, $entry;

            processBranchLists (@{$versions{$entry}{next}});

        }

    }

}

#

#   Walk each starting point list and determine new Projects

#

#DebugDumpData("Lists", \%startLists );

my %seenSuffixes;

foreach ( @startPoints )

{

    foreach my $entry ( @{$startLists{$_}} )

    {

        my $s = $versions{$entry}{suffix};

        unless ( exists $seenSuffixes{$s} )

        {

            $seenSuffixes{$s} = 1;

            $versions{$entry}{branchPoint} = 1;

            $versions{$entry}{newSuffix} = 1;

        }

    }

}

#

#   For each leaf ( end point ), walk backwards and mark each node with the

#   distance frm the end. If we get to a node which already has been marked then

#   stop if our length is less.

#

my $distanceCount;

foreach my $entry ( @endPoints )

{

    $distanceCount = 0;

    calcDistance($entry);

}

#

#   Locate all instances where a package-version branches

#   Determine the version that should be on the non-branching path

#

#   Reorder the 'next' list so that the first item is the non-branching

#   path. This will be used in the data-insertion phase to simplify the

#   processing.

#

foreach my $entry ( sort keys(%versions) )

{

    my @next = @{$versions{$entry}{next}};

    my $count = @next;

    my @ordered;

    my $main;

    if ( $count > 0 )

    {

        my %nexts = map { $_ => 1 } @next;

        foreach my $e ( @next )

        {

            #

            #   Remove those that already have a branch

            #

            if ( $versions{$e}{branchPoint} || $versions{$e}{newSuffix}  )

            {

                push @ordered, $e;

                delete $nexts{$e};

            }

        }

        #

        #   Select longest arm as the non-branching path

        #

        my $count = -1;

        my $countEntry;

        foreach my $e ( sort keys %nexts )

        {

            if ( $versions{$e}{distance} > $count )

            {

                $count = $versions{$e}{distance};

                $countEntry = $e;

            }

        }

        if ($countEntry)

        {

            $main = $countEntry;

            delete $nexts{$countEntry};

        }

        #

        #   Mark remaining as non-main

        #

        foreach my $e ( keys %nexts )

        {

            push @ordered, $e;

            $versions{$e}{branchPoint} = 1;

        }

        #

        #   Re-order 'next' so that the main path is first

        #

        @ordered = sort @ordered;

        unshift @ordered, $main if ( $main );

        @{$versions{$entry}{next}} = @ordered;

    }

}

sub calcDistance

{

    my ($entry) = @_;

    while ( $entry )

    {

        if ( defined $versions{$entry}{distance} )

        {

            if ( $versions{$entry}{distance} > $distanceCount )

            {

                last;

            }

        }

        $versions{$entry}{distance} = $distanceCount++;

        $entry = $versions{$entry}{last};

    }

}

DebugDumpData ("Versions", \%versions );

DebugDumpData ("Starts", \@startPoints );

DebugDumpData ("Ends", \@endPoints );

DebugDumpData ("Suffixes", \%suffixes );

#

#   Process all packages

#       Going to create versions based on RM structure

#       May have several starting points: Process each

#

newPackage();

processBranch(@startPoints);

endPackage();

exit 0;

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

# Function        : processBranch

#

# Description     : Process one complete branch within the tree of versions

#                   May be called recursivly to walk the tree

#

# Inputs          : Array of package-version ID to process

#

# Returns         : Nothing

#

sub processBranch

{

    foreach my $entry ( @_ )

    {

        #

        #   Do we need to create a branch before we can process this package

        #

        if ( $versions{$entry}{newSuffix} || $versions{$entry}{branchPoint} )

        {

            newProject();

            createBranchPoint ($entry);

        }

        processPackage( $entry, $versions{$entry}{suffix} );

        processBranch (@{$versions{$entry}{next}});

    }

}

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

# Function        : processPackage

#

# Description     : Process a package version

#

# Inputs          : $entry              - Ref to entry being proccessed

#                   $suffix             - Project Suffix

#

# Returns         :

#

my $ProjectName;

sub processPackage

{

    my ($entry, $suffix) = @_;

    my $rv;

    print "--- Entry:",GetVname($entry)," Tag: ",$versions{$entry}{vcsTag},"\n";

    push @processOrder, $entry;

    return if ( $opt_test );

    #

    #   Allow resumption

    #   Assumes a great deal ...

    #   Designed to allow manual recovery

    #

    if ( $opt_resume )

    {

        return if ( $opt_resume ne GetVname($entry) );

        $opt_resume = undef;

    }

    #

    #   Determine version information

    #

    my $opt_label = $opt_package . '_' . GetVname($entry);

    my $tag = $versions{$entry}{vcsTag} || '';

    $tag =~ s~\\~/~g;

    $tag =~ m~^(.+?)::(.*?)(::(.+))?$~;

    my $opt_path = $2 || '';

    $opt_path =~ s~\\~/~g;

    $opt_path =~ s~//~/~g;

    my $cc_label = $4;

    if ( !defined $opt_path || ! defined $cc_label )

    {

        print "--- (E) Error: Bad Config Spec for:",GetVname($entry),"\n";

        return;

    }

print "--- Path: $opt_path, Label: $cc_label\n";

    my @author;

    my $author = $versions{$entry}{created_id};

    if ( $author )

    {

        push @author, '-author', $author;

    }

    my $created = $versions{$entry}{created};

    if ( $created )

    {

        $created =~ s~ ~T~;

        $created .= '00000Z';

        push @author, '-date', $created;

    }

    my $log = $versions{$entry}{comment};

    if ( $log )

    {

        push @author, '-log', $log;

    }

    #

    #   Projects are stored on a branch

    #

    if ( $suffix )

    {

        Error ("Unknown Project: $suffix") unless ( defined $Projects{$suffix} );

        $ProjectName = $Projects{$suffix};

    }

    $ProjectName = $currentBranchName;

    #

    #   Create CC view

    #   Import into Subversion View

    #

    SystemConfig ('ExitOnError' => 0);

    if ( $opt_reuse && -d ($cc_label) )

    {

        Message ("Reusing view: $cc_label");

        $rv = 0;

    }

    else

    {

        $rv = JatsToolPrint ( 'jats_ccrelease', '-extractfiles', '-root=.' , '-noprefix',

                    "-label=$cc_label" ,

                    "-path=$opt_path");

    }

    unless ( $rv )

    {

        SystemConfig ('ExitOnError' => 1);

        my $import_label = $opt_label;

        $import_label = $cc_label if ( $cc_label =~ m~WIP$~ );

        JatsToolPrint ( 'jats_svn', 'import', '-reuse' ,

                        "-package=$opt_repo/$opt_package",

                        "-dir=$cc_label/$opt_path",

                        "-label=$import_label",

                        "-branch=$ProjectName",

                        @author

                         );

        $versions{$entry}{TagCreated} = 1;

    }

    #

    #   Delete the created view

    #   Its just a directory, so delete it

    #

    RmDirTree ($cc_label) if -d ($cc_label && ! $opt_reuse);

}

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

# Function        : newProject

#

# Description     : Start a new project within a package

#

# Inputs          : 

#

# Returns         : 

#

sub newProject

{

    print "---- New Project\n";

    return if ( $opt_resume  );

    #

    #   New project

    #   Kill the running import directory

    #

    RmDirTree ('SvnImportDir');

}

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

# Function        : newPackage

#

# Description     : Start processing a new package

#

# Inputs          : 

#

# Returns         : 

#

sub newPackage

{

    print "---- New Package\n";

    return if ( $opt_resume  );

    #

    #   First entry being created

    #   Prime the work area

    #

    SystemConfig ('ExitOnError' => 1);

    JatsToolPrint ( 'jats_svn', 'delete-package', '-noerror',  "$opt_repo/$opt_package" );

    JatsToolPrint ( 'jats_svn', 'create', "$opt_repo/$opt_package" );

    RmDirTree ('SvnImportDir');

}

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

# Function        : createBranchPoint

#

# Description     : Create a branch point for the current work

#

# Inputs          : $entry                  Entry being processed

#

# Returns         : 

#

sub createBranchPoint

{

    my ($entry) = @_;

    my $forceNewProject;

    print "---- Create Branch Point\n";

    #

    #   Find previous good tag

    #   We are walking a tree so something should have been created, but

    #   the one we want may have had an error

    #

    #   Walk backwards looking for one that has been created

    #

    my $last = $versions{$entry}{last};

    while ( $last )

    {

        unless ( $versions{$last}{TagCreated} )

        {

            $last = $versions{$last}{last};

        }

        else

        {

            last;

        }

    }

    #

    #   If we have walked back to the base of the tree then we will create

    #   an empty view

    #

    unless ( $last )

    {

    print "---- Create Branch Point: New Root Branch\n";

        $forceNewProject = 1;

    }

    #

    #   Determine source name

    #   This MUST have been created before we can branch

    #

    my $src_label;

    $src_label = ($opt_package . '_' . GetVname($last)) if $last;

    #

    #   Create target name

    #

    my $tgt_label;

    if ( $forceNewProject || $versions{$entry}{newSuffix} || !defined $src_label )

    {

        #

        #   Create target name based on project

        #

        my $suffix = $versions{$entry}{suffix};

        if ( $suffix )

        {

            Error ("Unknown Project: $suffix") unless ( defined $Projects{$suffix} );

            if ( ! exists $ProjectsBaseCreated{$suffix} )

            {

                $tgt_label = $Projects{$suffix};

                $ProjectsBaseCreated{$suffix} = 1;

            }

            else

            {

                #

                #   Project Base Already taken

                #   Have disjoint starting points

                #

                $tgt_label = $Projects{$suffix} . '.' . $ProjectsBaseCreated{$suffix};

                $ProjectsBaseCreated{$suffix}++;

            }

        }

        else

        {

            #

            #   No suffix in use

            #

            #   Currently not handled

            #   May have to force the use of the trunk

            #

            Error ("INTERNAL ERROR: No suffix present");

        }

    }

    else

    {

        $tgt_label = $src_label . '_for_' . $opt_package . '_' . GetVname($entry);

    }

    #

    #   Save branch name for use when populating sandbox

    #

    $currentBranchName = $tgt_label;

print "----- src: $src_label\n";

print "------tgt: $tgt_label\n";

    #

    #   Perform the branch

    #

    if ( $src_label )

    {

        SystemConfig ('ExitOnError' => 1);

        JatsToolPrint ( 'jats_svnlabel',

                        '-packagebase', "$opt_repo/$opt_package",

                        'tags/' . $src_label,

                        '-branch',

                        '-clone', $tgt_label,

                      );

    }

}

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

# Function        : endPackage

#

# Description     : End of package processing

#                   Clean up and display problems

#

# Inputs          : 

#

# Returns         : 

#

sub endPackage

{

    RmDirTree ('SvnImportDir');

    #

    #   Display versions that did not get created

    #

    foreach my $entry ( @processOrder )

    {

        $versions{$entry}{Scanned} = 1;

        next if ( $versions{$entry}{TagCreated} );

        print "(E) Not Processed: ",GetVname($entry),"\n";

    }

    foreach my $entry ( keys(%versions) )

    {

        next if ( $versions{$entry}{Scanned} );

        print "(E) INTERNAL ERROR. Package Not Processed: ",GetVname($entry),"\n";

    }

    Message ("All Done");

}

sub JatsToolPrint

{

    Information ("Command: @_");

    JatsTool @_;

}

sub GetVname

{

    my ($entry) = @_;

    my $me = 'NONE';

    if ( $entry )

        {

        $me = $versions{$entry}{vname};

        unless ( $me )

        {

            $me = 'Unknown-' . $entry;

        }

    }

    return $me;

}

exit 0;

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

# Function        : GetPkgIdByName

#

# Description     :

#

# Inputs          : pkg_name

#

# Returns         :

#

sub GetPkgIdByName

{

    my ( $pkg_name ) = @_;

    my (@row);

    my $pv_id;

    #

    #   Establish a connection to Release Manager

    #

    connectRM(\$RM_DB) unless ( $RM_DB );

    #

    #   Extract data from Release Manager

    #

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

                   " FROM RELEASE_MANAGER.PACKAGES pkg" .

                   " WHERE pkg.PKG_NAME = \'$pkg_name\'";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

                    Verbose( "DATA: " . join(',', @row) );

                    $pkg_id = $row[1] || 0;

                    last;

                }

            }

            else

            {

                Error ("GetPkgIdByName:No Data for package: $pkg_name");

            }

            $sth->finish();

        }

    }

    else

    {

        Error("GetPkgIdByName:Prepare failure" );

    }

}

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

# Function        : GetData_by_pkg_id

#

# Description     :

#

# Inputs          : pv_id

#

# Returns         :

#

sub GetData_by_pkg_id

{

    my ( $pkg_id ) = @_;

    my (@row);

    #

    #   Establish a connection to Release Manager

    #

    connectRM(\$RM_DB) unless ( $RM_DB );

    #

    #   Extract data from Release Manager

    #

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

                   " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, ACCESS_MANAGER.USERS amu" .

                   " WHERE pv.PKG_ID = \'$pkg_id\' AND pkg.PKG_ID = pv.PKG_ID AND pv.CREATOR_ID = amu.USER_ID";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

                    Verbose( "DATA: " . join(',', @row) );

                    my $pkg_name = $row[0] || 'Unknown';

                    my $pkg_ver = $row[1] || 'Unknown';

                    my $pv_id = $row[3] || 'Unknown';

                    my $last_pv_id = $row[4] || 'Unknown';

                    my $created =  $row[5] || 'Unknown';

                    my $vcstag =  $row[6] || 'Unknown';

                    my $created_id =  $row[7] || 0;

                    my $comment =  $row[8] || '';

                    my $locked =  $row[9] || 'N';

                    #

                    #   Add data to the hash

                    #       Remove entries that address themselves

                    #

                    push (@{$versions{$last_pv_id}{next}}, $pv_id) unless ($pv_id == $last_pv_id) ;

                    $versions{$pv_id}{vname} = $pkg_ver;

                    $versions{$pv_id}{vcsTag} = $vcstag;

                    $versions{$pv_id}{created} = $created;

                    $versions{$pv_id}{created_id} = $created_id;

                    $versions{$pv_id}{comment} = $comment;

                    $versions{$pv_id}{locked} = $locked;

                    #

                    #   Convert version into full form for comparisions

                    #

                    my $version = $pkg_ver;

                    my $suffix;

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

                        my $cots_base = $1;

                        $suffix = '.cots';

                        unless ( $version =~ m~(.*)(\.[0-9]4)\.cots~ )

                        {

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

                        }

                    }

                    elsif ( $version =~ m~(\d+)\.(\d+)\.(\d+)(\.(.*))?~ )

                    {

                        my $patch = $3;

                        my $build = '000';

                        if ( length( $patch) >= 4 )

                        {

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

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

                        }

                        $version = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $1,$2,$patch,$build,$4 || '.0000');

                        $suffix = $4 || '';

                    }

                    else

                    {

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

                        $suffix = $1 || '';

                    }

                    $versions{$pv_id}{version} = $version;

                    #

                    #   Process suffix

                    #

                    $suffix = 'Unknown' unless ( $suffix );

                    $suffix = lc ($suffix);

                    $versions{$pv_id}{suffix} = $suffix;

                    push @{$suffixes{$suffix}}, $pv_id;

                    print "$pkg_name, $pkg_ver, $pv_id, $last_pv_id, $created, $created_id, $suffix\n";

                }

            }

            else

            {

                Error ("GetData_by_pkg_id: No Data: $m_sqlstr");

            }

            $sth->finish();

        }

        else

        {

                Error ("GetData_by_pkg_id: Execute: $m_sqlstr");

        }

    }

    else

    {

        Error("GetData_by_pkg_id:Prepare failure" );

    }

}