Subversion Repositories DevTools

Rev

Rev 1356 | Rev 2429 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed 

########################################################################
# Copyright (C) 1998-2012 Vix Technology, All rights reserved
#
# Module name   : cc2svn_importpackage.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# 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
#                 Determine essential packages
#                 Prune uneeded packages
#
#                 Pump it into SVN
#
#                 Project Based Pumping, creating branches as needed
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsError;
use JatsRmApi;
use FileUtils;
use JatsSystem;
use HTTP::Date;
use JatsProperties;
use JatsEnv;
use ConfigurationFile;
use JatsSvn qw(:All);
use JatsLocateFiles;


#use Data::Dumper;
use Fcntl ':flock'; # import LOCK_* constants
use Cwd;
use DBI;
use Getopt::Long;
use Pod::Usage;                             # required for help support
use Encode;

#
#   Options
#
my $opt_help = 0;
my $opt_manual = 0;
my $opt_verbose = 0;
my $opt_repo_base = 'AUPERASVN01/';
my $opt_repo = '';
my $opt_flat;
my $opt_test;
my $opt_reuse;
my $opt_age;
my $opt_dump = 0;
my $opt_images = 0;
my $opt_retaincount = 2;
my $opt_pruneModeString;
my $opt_listTags;
my $opt_name;
my $opt_log = 0;
my @opt_tip;
my $opt_postimage = 1;
my $opt_workDir = '/work';
my $opt_vobMap;
my $opt_preserveProjectBase;
my $opt_ignoreProjectBaseErrors;
my $opt_delete;
my $opt_recentAge = 14;             # Days

################################################################################
#   List of Projects Suffixes and Branch Names to be used within SVN
#
#       Name        - Name of branch for the project
#       Trunk       - Can be a trunk project
#                     First one seen will be placed on the trunk
#                     Others will create project branches
#
my $ProjectTrunk;
my %ProjectsBaseCreated;
my %Projects = (
    '.sea'      => { Name => 'Seattle' },
    '.coct'     => { Name => 'CapeTown' },
    '.sls'      => { Name => 'Stockholm' },
    '.syd'      => { Name => 'Sydney' },
    '.vtk'      => { Name => 'Vasttrafik' },
    '.bei'      => { Name => 'Beijing' },
    '.bkk'      => { Name => 'Bangkok' },
    '.ndl'      => { Name => 'NewDelhi' },
    '.nzs'      => { Name => 'NewZealandStageCoach' },
    '.wdc'      => { Name => 'Washington' },
    '.oso'      => { Name => 'Oslo' },
    '.lvs'      => { Name => 'LasVegas' },
    '.mlc'      => { Name => 'BeijingMlc' },
    '.sfo'      => { Name => 'SanFrancisco' },
    '.sg'       => { Name => 'Singapore' },
    '.gmp'      => { Name => 'GmpteProject' },
    '.ssw'      => { Name => 'UkStageCoach' },
    '.uk'       => { Name => 'UkProject' },
    '.pmb'      => { Name => 'Pietermaritzburg' },
    '.vps'      => { Name => 'VixPayments' },
    '.ncc'      => { Name => 'NSWClubCard' },
    '.rm'       => { Name => 'Rome' },
    'unknown'   => { Name => 'UnknownProject' },

    '.ebr'      => { Name => 'eBrio' , Trunk => 1 },
    '.mas'      => { Name => 'Mass'  , Trunk => 1 },
    '.cr'       => { Name => 'Core'  , Trunk => 1 },
    '.cots'     => { Name => 'Cots'  , Trunk => 1 },
    '.tool'     => { Name => 'Tools' , Trunk => 1 },
);

my %suffixFixup = (
    '.sf'           => '.sfo',
    '.vt'           => '.vtk',
    '.lv'           => '.lvs',
    '.was'          => '.wdc',
    '.uk.1'         => '.uk',
    '.ssts.demo'    => '.ssts',
    '.u244.syd'     => '.syd',
    '.pxxx.sea'     => '.sea',
    '.pxxx.syd'     => '.syd',
    '.pxxx.sydddd'  => '.syd',
    '.oslo'         => '.oso',
    '.osl'          => '.oso',
);

my %specialPackages = (
    'core_devl' =>  ',all,protected,',
#    'core_devl' =>  ',all,',
    'daf_utils_mos' => ',flat,',
    'mos_packager'  => ',all,',

    # Need to be handled in a special manner
    # Not done by this utility
    #
    'linux_drivers_eb5600'  => ',protected,',
    'linux_drivers_viper'   => ',protected,',
    'linux_drivers_cobra'   => ',protected,',
    'linux_drivers_bcp4600' => ',protected,',
    'linux_drivers_etx86'   => ',protected,',
    'linux_drivers_tp5600'  => ',protected,',

    'ftp'                   => 'SetProjectBase,',

    'icl'                   => 'IgnoreProjectBase,',
    'itso'                  => 'IgnoreProjectBase,',
    'daf_osa_mos'           => 'IgnoreProjectBase,',
    'daf_utils_mos'         => 'IgnoreProjectBase,',
    'itso_ud'               => 'IgnoreProjectBase,',
#    'mos_api'               => 'IgnoreProjectBase,',
#    'mos_fonts'             => 'IgnoreProjectBase,',
#    'sntp'                  => 'IgnoreProjectBase,',
#    'time_it'               => 'IgnoreProjectBase,',

);

my %notCots = (
    'isl'       => 1,
);

################################################################################
#   Global data
#
my $VERSION = "1.0.0";
my $RM_DB;
my $last_pv_id;
my %pkg_ids;
my $first_pkg_id;
my %versions;
my %suffixes;
my @processOrder;
my @startPoints;
my @allStartPoints;
my @endPoints;
my $now = time();
my $logSummary;
my $firstVersionCreated;
my @EssentialPackages;
my $createBranch;
my $createSuffix;
my $currentBranchName;
my $singleProject;
my $pruneCount = 0;
my $trimCount = 0;
my $badVcsCount = 0;
my $ProjectCount = 0;
my $totalVersions = 0;
my $initialTrees = 0;
my $globalError;
my @unknownProjects;
my %knownProjects;
my $badSingletonCount = 0;
my @flatOrder;
my $pruneMode;
my $pruneModeString;
my $threadId = 0;
my $threadCount;
my %tipVersions;
my $allSvn;
my @multiplePaths;
my @badEssentials;
my %svnData;
my $cwd;

my $packageNames;
my @packageNames;
my $multiPackages = -1;
my $visitId = 0;
my $noTransfer;
my $rippleCount = 0;
my $svnRepo;
my $processCount = 0;
my $processTotal = 0;
my $recentCount = 0;

our $GBE_RM_URL;
my $UNIX = $ENV{'GBE_UNIX'};

my $result = GetOptions (
                "help+"         => \$opt_help,          # flag, multiple use allowed
                "manual:3"      => \$opt_help,
                "verbose:+"     => \$opt_verbose,       # Versose
                "repository:s"  => \$opt_repo,          # Name of repository
                'rbase:s'       => \$opt_repo_base,     # Base of the repo
                "flat!"         => \$opt_flat,          # Flat structure
                "test!"         => \$opt_test,          # Test operations
                "reuse!"        => \$opt_reuse,         # Reuse ClearCase views
                "age:i"         => \$opt_age,           # Only recent versions
                "dump:1"        => \$opt_dump,          # Dump Data
                "images:1"      => \$opt_images,        # Create DOT images
                "retain:i"      => \$opt_retaincount,   # Retain N packages
                "pruneMode:s"   => \$opt_pruneModeString,
                "listtags:i"    => \$opt_listTags,
                "name:s"        => \$opt_name,          # Alternate output
                "tip:s"         => \@opt_tip,           # Force tip version(s)
                "log!"          => \$opt_log,
                "delete!"       => \$opt_delete,
                "postimage!"    => \$opt_postimage,
                'workdir:s'     => \$opt_workDir,
                );

#
#   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
#
SystemConfig ('ExitOnError' => 1);
ErrorConfig( 'name'    =>'CC2SVN_IMPORT',
             'verbose' => $opt_verbose,
              );

Error("Workdir does not exist" ) unless ( -d $opt_workDir );
Error("Specify a package as 'name'" ) unless ( defined $ARGV[0] );
EnvImport('GBE_RM_URL');
$cwd = Getcwd();

#
#   Init the pruning mode
#
setPruneMode( $opt_pruneModeString || 'ripple');

#
#   Get data for all packages
#
foreach my $packageName ( @ARGV )
{
    next unless ( $packageName );
    Verbose( "Base Package: $packageName");

    my $pkg_id = GetPkgIdByName ( $packageName );
    GetData_by_pkg_id ( $pkg_id, $packageName  );
    $pkg_ids{$pkg_id} = 1;
    $first_pkg_id = $pkg_id unless ( $first_pkg_id );
    push @packageNames, $packageName;
    $multiPackages++;
}

{
    #
    #   Delete entries that have been created as we read in
    #   data, but don't exist in RM. They will not have a pvid.
    #
    foreach my $entry ( keys(%versions) )
    {
        delete $versions{$entry}
            unless ( exists $versions{$entry}{pvid} );
    }
}

$totalVersions = scalar keys %versions;
Error ("No packages specified") unless ( $multiPackages >= 0 );
Warning ("Multiple Packages being processed") if ( $multiPackages > 1 );
$packageNames = join ('_', @packageNames );
$packageNames = $opt_name if ( defined $opt_name );
Message ("PackageName: $packageNames" );

#
#   Save logging data
#
if ( $opt_log )
{
    my $opt_logfile = $packageNames . '.import';
    Message ("Logging outout: $opt_logfile" );
    open STDOUT, '>', $opt_logfile  or die "Can't redirect STDOUT: $!";
    open STDERR, ">&STDOUT"         or die "Can't dup STDOUT: $!";
}

#
#   Prepare tip version hash
#
$tipVersions{$_} = 1 foreach ( @opt_tip );

#
#   Read in external data and massage it all
#
getEssenialPackageVersions();
getVobMapping();
smartPackageType();                 # Determine special prune mode
ReportPathVariance();
massageData();
getSvnData();
smartPackageType();                 # Have another go

my @missedTips = keys %tipVersions;
Error ("Specified tip version not found: @missedTips") if ( @missedTips );

if ( $opt_flat )
{
#    @flatOrder = sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions);
#    @flatOrder = sort {$versions{$a}{created} cmp $versions{$b}{created}} keys(%versions);
    @flatOrder = sort {$a <=> $b} keys(%versions);
    my $tip = $flatOrder[-1];
    $versions{$tip}{Tip} = 1 if $tip;
}

#
#   Generate dumps and images
#
if ( $opt_images )
{
    createImages();
}

if ( $opt_dump )
{
    DebugDumpData ("Versions", \%versions );
    DebugDumpData ("Starts", \@startPoints );
    DebugDumpData ("Ends", \@endPoints );
    DebugDumpData ("Suffixes", \%suffixes );
}


#   Display VCS tags
#
if ( $opt_listTags )
{
    foreach my $entry (sort {$versions{$a}{version} cmp $versions{$b}{version}} keys(%versions) )
    {
        print $versions{$entry}{vcsTag} || '-' ,"\n";
    }
}
exit if ( ($opt_dump > 1) || ($opt_images > 1) );

transferPackageToSvn();

if ( $opt_postimage )
{
    getSvnData();
    createImages();
}

exit 0;

#-------------------------------------------------------------------------------
# Function        : transferPackageToSvn
#
# Description     : Transfer the package to SVN
#
# Inputs          : 
#
# Returns         : 
#
sub transferPackageToSvn
{
    Error ("Repository Path not setup")
        unless ( $svnRepo );

    #
    #   Going to do serious work
    #   Need to ensure we have more arguments
    #
    if ( $noTransfer )
    {
        Warning("Protected Package not transferred: $packageNames[0]");
        exit 0;
    }

    #
    #   Perform all the work in a package specific subdirectory
    #
    my $workDir = $opt_workDir . '/' . $packageNames;
    mkdir $workDir unless ( -d $workDir );
    chdir $workDir || Error ("Cannot cd to $workDir");

    #
    #   Process all packages
    #       Going to create versions based on RM structure
    #       May have several starting points: Process each
    #
    newPackage();
    if ( $opt_flat )
    {
        newProject();
        foreach my $entry (@flatOrder )
        {
            newPackageVersion( $entry, $versions{$entry}{suffix} );
        }
    }
    else
    {
        processBranch(@allStartPoints);
    }
    endPackage();

    chdir $cwd || Error ("Cannot cd back to $cwd");
    rmdir $workDir;
    Warning ("Work Directory still exists: $workDir");
    saveData();
}

#-------------------------------------------------------------------------------
# Function        : setPruneMode
#
# Description     : Set the pruning mode
#
# Inputs          : mode                    - Text mode value
#
# Returns         : Nothing
#
sub setPruneMode
{
    my ($mode) = @_;
    my $value;
    if ( $mode )
    {
        if ( $mode =~ m/none/i) {
            $value = 0;
        } elsif ( $mode =~ m/ripple/i) {
            $value = 1;
        } elsif ( $mode =~ m/retain/i) {
            $value = 2;
        } elsif ( $mode =~ m/severe/i) {
            $value = 3;
        } else {
            Error ("Unknown pruning mode", "Use: none, ripple, retain or severe");
        }

        $pruneModeString = $mode;
        $pruneMode = $value;
    }
}

#-------------------------------------------------------------------------------
# Function        : smartPackageType
#
# Description     : Have a look at the projects in the package set and
#                   attempt to determine what sort of mechanism to use
#
# Inputs          : Uses %suffixes data
#
# Returns         : 
#
my $packageType = 'UNKNOWN';
sub smartPackageType
{
    #
    #   Rebuild suffixes hash based on  post massaged versions
    #
    my %suffixes;
    my @unknown;
    foreach my $entry ( keys %versions )
    {
        my $suffix = $versions{$entry}{suffix} || '';
        push (@unknown, $entry) if ($suffix eq 'unknown');

        next if ( exists $suffixes{$suffix} );
        next if ( $versions{$entry}{badSingleton} );
        next if ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );
        $suffixes{$suffix} = 1;
        $knownProjects{$suffix}{seen} = 1;

    }

    #
    #   The 'unknown' suffix is really an 'empty' suffix
    #   Try to be clever
    #       Map unknown to 'cr' or 'mas' if present
    #
    #
    if ( exists $suffixes{'unknown'}  )
    {
        my $new_suffix;
        if ( exists $suffixes{'.cr'} ) {
            $new_suffix = '.cr';
        } elsif ( exists $suffixes{'.mas'} ) {
            $new_suffix = '.mas';
        }

        if ( $new_suffix )
        {
            foreach my $entry ( @unknown )
            {
                $versions{$entry}{suffix} = $new_suffix;
            }
            delete $suffixes{'unknown'};
            delete $knownProjects{'unknown'}{seen};
        }
    }

    if ( exists $suffixes{'.cots'} && !exists ($notCots{$packageNames}) ) {
        $packageType = 'COTS';
        $Projects{'.cots'}{Trunk} = 1;
        $singleProject = 1;
        $opt_flat = 1 unless defined $opt_flat;
        setPruneMode('none') unless (defined $opt_pruneModeString);

    } elsif ( exists $suffixes{'.tool'} ) {
        $packageType = 'TOOL';
        $Projects{'.tool'}{'Trunk'} = 1;
        $singleProject = 1;
        setPruneMode('none') unless (defined $opt_pruneModeString);
#        $opt_flat = 1;

    } elsif ( scalar (keys %suffixes ) == 1 ) {
        $packageType = 'SINGLE_PROJECT';
        $singleProject = 1;

    } else {
        $packageType = 'MULTIPLE_PROJECT';
    }

    #
    #   Some packages are special
    #

    if ( $packageNames[0] =~ m'^br_applet_' )
    {
        $opt_flat = 1 unless defined $opt_flat;
    }

    if ( exists $specialPackages{$packageNames[0]} )
    {
        my $data = $specialPackages{$packageNames[0]};
        if ( index( $data, ',all' ) >= 0) {
            setPruneMode('none') unless (defined $opt_pruneModeString);
        }
        
        if ( index( $data, 'protected,' ) >= 0) {
            $noTransfer = 1;
        }

        if ( index( $data, 'flat,' ) >= 0) {
            $opt_flat = 1;
        }

        if ( index( $data, 'SetProjectBase,' ) >= 0) {
            $opt_preserveProjectBase = 1;
            $opt_ignoreProjectBaseErrors = 1;
            Message ("Preserving ProjectBase");
        }

        if ( index( $data, 'IgnoreProjectBase,' ) >= 0) {
            $opt_ignoreProjectBaseErrors = 1;
            Message ("Ignore ProjectBase Errors");
        }

    }

    Message("Package Type: $packageType, $pruneModeString");
}


#-------------------------------------------------------------------------------
# Function        : massageData
#
# Description     : Massage all the data to create a tree of package versions
#                   that can be used to create images as well as an import order
#
# Inputs          : 
#
# Returns         : 
#
my $reprocess=0;
sub calcLinks
{
    #
    #   Process the 'versions' hash and:
    #   Add back references
    #   Find starts and ends
    #       Entry with no previous
    #       Entry with no next
    #
    $reprocess = 0;
    foreach my $entry ( keys(%versions) )
    {
        foreach ( @{ $versions{$entry}{next}} )
        {
            $versions{$_}{last} = $entry;
        }
    }
    @allStartPoints = ();
    @startPoints = ();
    @endPoints = ();
    foreach my $entry ( keys(%versions) )
    {
        push @startPoints, $entry
            unless ( exists $versions{$entry}{last} || $versions{$entry}{badSingleton} );

        push @allStartPoints, $entry
            unless ( exists $versions{$entry}{last} );
            
        push @endPoints, $entry
            unless ( @{$versions{$entry}{next}} > 0  )
    }
}

sub massageData
{
    #
    #   Report unknown suffixes
    #   Handle bad, or little known project suffixes by creating them
    #
    foreach my $suffix ( keys %suffixes )
    {
        if ( exists $Projects{$suffix} )
        {
            next;
        }
        Message ("Unknown project suffix: '$suffix'");
        push @unknownProjects, $suffix;
        my $cleanSuffix = ucfirst(lc(substr( $suffix, 1)));
        $Projects{$suffix}{Name} = 'Project_' . $cleanSuffix;
    }

    calcLinks();

    $initialTrees = scalar @allStartPoints;
    Message ('Total RM versions: ' . $totalVersions );
    Message ('Initial trees: ' . $initialTrees );
    #
    #   Attempt to glue all the start points into one chain.
    #   This should allow us to track projects that branch from each other
    #   in cases where the RM data is incorrect/incomplete
    #       Strays are those that have no next or last
    #
    #   Glue based on Name, then PVID (Creation Order)
    #
    {
        #
        #   Examine threads. If it is a single entry thats bad then drop it
        #   This is simple to do. Should examine all entries, but thats a
        #   bit harder. Perhaps later.
        #
        if (1) {
            Message ("Dropping Bad Singletons");
            my $badSingletons;
            foreach my $entry ( sort {$a <=> $b} @startPoints )
            {
                my $ep = $versions{$entry};
                unless ( $ep->{last} || $ep->{next}[0] )
                {
#                    if (  $ep->{isaWip}  )
                    if ( (exists $ep->{badVcsTag} && $ep->{badVcsTag}) || $ep->{isaWip}  )
                    {
                        $ep->{badSingleton} = 1;
                        $reprocess = 1;
                        $badSingletonCount++;

                        # Add to a list of its own.
                        if ( $badSingletons )
                        {
                            push @{$versions{$badSingletons}{next}}, $entry;
                        }
                        $badSingletons = $entry;
                    }
                }
            }
            calcLinks()
                if ( $reprocess );
        }

        #
        #   Create simple trees out of the chains
        #   Tree is based on suffix (project) and version
        #
        {
            my %trees;
            Message ("Entries into trees");
            foreach my $single ( @startPoints )
            {
                my $suffix = $versions{$single}{suffix} || '';
                push @{$trees{$suffix}}, $single;
            }

            foreach  ( keys %trees )
            {
                my $last;
                foreach my $entry ( sort { $versions{$a}{version} cmp $versions{$b}{version}  } @{$trees{$_}} )
                {
                    if ( $last )
                    {
                        $versions{$last}{MakeTree} = 1;
                        push @{$versions{$last}{next}}, $entry;
                        $reprocess = 1;
                    }
                    $last = $entry;
                }
            }
            calcLinks()
                if ( $reprocess );
        }

        #
        #   Have a number of trees that are project related
        #   Attempt to create a single tree by inserting
        #   Secondary trees into the main line at suitable points
        #
        my @AllVersions = sort { $a <=> $b } @startPoints;
        my $lastEntry = shift @AllVersions;
        Error ("Oldest entry has a previous version") if ( $versions{$lastEntry}{last}  );
#print "Oldest: $lastEntry\n";
        #
        #   Insert remaining entries into out list, which is now sorted
        #
        my @completeList;
        foreach my $base ( @AllVersions  )
        {
            push @completeList, recurseList($lastEntry);
            @completeList = sort {$a <=> $b} @completeList;
#            Message("Complete List: ", @completeList);
#            Message("Complete List($completeList[0]) Length: " . scalar @completeList);
            $lastEntry = $base;
            
            my $last;
            foreach my $entry ( @completeList )
            {
                if ( $entry > $base )
                {
                    Error ("Not expecting last to be empty. $base, $entry") unless ( $last );
                    last;
                }
                $last = $entry;
            }

            #
            #   Insert at end if point not yet found
            #
#print "Inserting $base at $last\n";
            push @{$versions{$last}{next}}, $base;
            $versions{$base}{GluedIn} = 1;
            $reprocess = 1;
        }

        #
        #   Recalc basic links if any processing done
        #
        calcLinks()
            if ( $reprocess );
        
    }


    #
    #   Remove Dead Ends
    #   Packages that were never released
    #       Not locked, unless essential or a branchpoint
    #   Won't consider these to be mainline path.
    #
    {
        Message ("Remove Dead Ends");
        foreach my $entry ( @endPoints )
        {
            my $deadWood;
            while ( $entry )
            {
                last if ( $versions{$entry}{Essential} );

                my @next = @{$versions{$entry}{next}};
                my $count = @next;
                last if ( $count > 1 );

                last unless ( $versions{$entry}{locked} eq 'N' || $versions{$entry}{isaWip} );

                $versions{$entry}{DeadWood} = 1;
                $trimCount++;
            } continue {
                $entry = $versions{$entry}{last};
            }
        }
    }

    #
    #   Walk each starting point list and determine new Projects
    #   branchpoints.
    #
    Message ("Locate Projects branch points");
    foreach my $bentry ( keys(%versions) )
    {
        my $baseSuffix = $versions{$bentry}{suffix};
        foreach my $entry ( @{$versions{$bentry}{next}} )
        {
            if ( $baseSuffix ne $versions{$entry}{suffix})
            {
                unless ( exists $versions{$entry}{DeadWood} || $versions{$entry}{badSingleton} )
                {
#print "--- Project Branch $versions{$entry}{vname}\n";
                    $versions{$entry}{branchPoint} = 1;
                    $versions{$entry}{newSuffix} = 1;
                }
            }
        }
    }
    
    #
    #   Prune
    #   Marks paths to root for all essential packages
    #   Marks the last-N from all essential packages
    #
    if ( $pruneMode )
    {
        Message ("Prune Tree: $pruneModeString");
        foreach ( @EssentialPackages )
        {
            #next unless ( exists $versions{$_} );      # Aleady deleted

            # Mark previous-N to be retained as well
            my $entry = $_;
            my $count = 0;
            while ( $entry )
            {
                last if ( $versions{$entry}{KeepMe} );
                unless ( $versions{$entry}{isaRipple} )
                {
                    my $keepFlag = ($count++ < $opt_retaincount);
                    last unless ( $keepFlag );
                    $versions{$entry}{KeepMe} = $keepFlag;
                }
                $entry = $versions{$entry}{last}
            }
        }

        #
        #   Keep recent versions
        #       Keep versions created in the last N days
        #       Will keep recent ripples too
        #
        if ( $pruneMode == 1 )
        {
            foreach my $entry ( keys(%versions) )
            {
                next unless ( $versions{$entry}{Age} <= $opt_recentAge  );
                $versions{$entry}{keepRecent} = 1;
                $recentCount++;
#print "--- Recent version $versions{$entry}{vname}, $versions{$entry}{Age} <= $opt_recentAge\n";
            }

#            #
#            #   Keep the tip of each branch
#            #
#            foreach my $entry ( @endPoints )
#            {
#                next if exists $versions{$entry}{keepRecent};
#                $versions{$entry}{keepRecent} = 1;
##print "--- Tip version $versions{$entry}{vname}\n";
#            }
        }
        
        #
        #   Keep versions that are common parents to Essential Versions
        #       Mark paths through the tree to essential versions
        #       Mark nodes with the number of essential versions that they sprout
        #   Don't do it if we are ripple pruning
        #
        Message ("Prune Tree keep common parents");
        if ( $pruneMode != 1 )
        {
            foreach my $entry ( @endPoints )
            {
                my $hasEssential = 0;
                $visitId++;
                while ( $entry )
                {
                    $hasEssential = 1 if ( exists ($versions{$entry}{Essential}) && $versions{$entry}{Essential} );
                    if ( $hasEssential )
                    {
                        if ( @{$versions{$entry}{next}} > 1 )
                        {
                            $versions{$entry}{EssentialSplitPoint}++;
                        }
                        last if ( exists $versions{$entry}{EssentialPath} );
                        $versions{$entry}{EssentialPath} = 1;
                    }

                    if ( ($versions{$entry}{visitId} || 0) == $visitId )
                    {
                        DebugDumpData ("Versions", \%versions );
                        Warning ("Circular dependency");
                        last;
                    }
                    $versions{$entry}{visitId} = $visitId;

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

        #
        #   Keep first version of each ripple. Must keep first
        #   Group ripples together so that they can be proccessed at the same time
        #
        calcRippleGroups()
            if ( $pruneMode == 1);

        #
        #   Delete all nodes that are not marked for retention
        #   This is rough on the tree
        #
        Message ("Prune Tree Deleting");

        # 0 - Keep me
        # 1 - Prune me
        sub pruneMe
        {
            my ($entry) = @_;

            return 0 unless ( exists $versions{$entry} );
            return 0 unless ( $versions{$entry}{last} );
            return 0 if ( ($pruneMode == 2) && exists $versions{$entry}{KeepMe} );
            return 0 if ( exists $versions{$entry}{Essential} );
            return 0 if ( $versions{$entry}{newSuffix} );
            return 0 if ( $versions{$entry}{newSuffix} && (exists $versions{$entry}{EssentialPath}) );
#            return 1 if ( exists $versions{$entry}{DeadWood} );
            return 0 if ( exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
            return 0 if ( exists $versions{$entry}{keepLowestRipple} &&  $versions{$entry}{keepLowestRipple} );
            return 0 if ( ($pruneMode == 1) && ! $versions{$entry}{isaRipple} );
            return 0 if ( exists $versions{$entry}{keepRecent} && $versions{$entry}{keepRecent} );
            return 1;
        }

        foreach my $entry ( keys(%versions) )
        {
#last;
            next unless ( pruneMe($entry) );
#print "--- Prune: $versions{$entry}{vname}\n";

            # Delete the current node
            #
            my @newNext;
            $pruneCount++;
            my $last = $versions{$entry}{last};
            foreach ( @{$versions{$last}{next}} )
            {
                next if ( $_ == $entry );
                push @newNext, $_;
            }
            foreach ( @{$versions{$entry}{next}} )
            {
                push @newNext, $_;
                $versions{$_}{last} = $last;
            }

            @{$versions{$last}{next}} = @newNext;
            delete $versions{$entry};
        }

        # Recalculate endpoints
        calcLinks();
    }
    else
    {
        #   No rippling happening
        #   Some process still need to happen
        #
        calcRippleGroups();
    }

    #
    #   Calculate best through-path for branches in the tree
    #   Attempt to keep that 'max' version on the mainline
    #   May be modified by -tip=nnnn
    #
    #   For each leaf (end point), walk backwards and mark each node with the
    #   max version see. If we get to a node which already has been marked then
    #   stop if our version is greater. We want the value to be the max version
    #   to a leaf
    #
    #   Account for 'suffix'. When suffix changes, then the 'max' version must
    #   be recalculated
    #

    Message ("Calculate Max Version");
    my $maxVersion;

    foreach my $entry ( @endPoints )
    {
        my $lastSuffix;
        my $forceTip;
        while ( $entry )
        {
            if (!defined($lastSuffix) || ($versions{$entry}{suffix} ne $lastSuffix) )
            {
                $maxVersion = '0';
                $visitId++;
                $forceTip = ( exists $tipVersions{$versions{$entry}{vname}} );
                delete $tipVersions{$versions{$entry}{vname}};
                $maxVersion = '999.999.999.999.zzz' if ( $forceTip );
                $lastSuffix = $versions{$entry}{suffix};
#print "---Tip Found\n" if $forceTip;
            }

            # Detect circular dependencies
            if ( ($versions{$entry}{visitId} || 0) == $visitId )
            {
                DebugDumpData ("Circular dependency: Versions", \%versions );
                Warning ("Circular dependency");
                last;
            }
            $versions{$entry}{visitId} = $visitId;

            my $thisVersion = $versions{$entry}{version} || '';
            if ( $thisVersion gt $maxVersion )
            {
                $maxVersion = $thisVersion;
            }

            if ( exists $versions{$entry}{maxVersion} )
            {
                if ( $versions{$entry}{maxVersion} gt $maxVersion )
                {
                    last;
                }
            }

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

    #
    #   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.
    #
    Message ("Calculate package version branches");
    foreach my $entry ( sort {$a <=> $b} keys(%versions) )
    {
        calculateWalkOrder($entry);
    }

    #
    #   Mark Project Branch Tips as they will be in the Repository
    #   Find each project head and walk primary entry to the end.
    #
    foreach my $entry ( keys(%versions) )
    {
        #
        #   Root of each tree is 'new'
        #
        unless ( defined $versions{$entry}{last})
        {
            unless ( $versions{$entry}{badSingleton} )
            {
                $versions{$entry}{newSuffix} = 1;
            }
        }

        #
        #   Update stats
        #
        $badVcsCount++ if ( $versions{$entry}{badVcsTag} );
        $ProjectCount++ if ( $versions{$entry}{newSuffix} );
        next if ( $opt_flat );

        next unless ($versions{$entry}{newSuffix} );
#print "--- Project new Suffix $versions{$entry}{vname}\n";


        my $suffix = $versions{$entry}{suffix};
        $knownProjects{$suffix}{count}++;

        my $next = $versions{$entry}{next}[0];
        my $tip;
        while ( $next )
        {
            last if ( $suffix ne $versions{$next}{suffix} );
            $tip = $next unless (exists ($versions{$next}{DeadWood}) || $versions{$next}{badSingleton});
            $next = $versions{$next}{next}[0];
        }

        $versions{$tip}{Tip} = 1 if $tip;
    }

    unless ( $opt_flat )
    {
        my $finalTrees = scalar @startPoints;
        Warning ("Still have multiple trees: $finalTrees") unless ( $finalTrees == 1 );
    }

    #
    #   Display warnings about multiple
    #
    foreach ( sort keys %knownProjects )
    {
        my $count = $knownProjects{$_}{count} || 0;
        Warning ("Multiple Project Roots: $_ ($count)" )
            if ( $count > 1 );
    }

    #
    #   Display warnings about Bad Essential Packages
    #
    $allSvn = 1;
    foreach my $entry ( keys(%versions) )
    {
        $rippleCount++ if ( exists($versions{$entry}{isaRipple}) && $versions{$entry}{isaRipple} );
        $allSvn = 0 unless ( $versions{$entry}{isSvn} );
        next unless ( exists $versions{$entry}{Essential}  );
        next unless ( $versions{$entry}{badVcsTag}  );
        push @badEssentials, $entry;
        Warning ("BadVCS Essential: " . GetVname($entry))
    }

    #
    #   All done
    #
    $processTotal = scalar keys %versions;
    Message("Retained entries: $processTotal" );
    Message("Pruned entries: $pruneCount");
    Message("Deadwood entries: $trimCount");
    Message("Bad Singletons: $badSingletonCount");
    Message("Ripples: $rippleCount");
    Message("Recent entries: $recentCount");
}

sub calculateWalkOrder
{
    my ($entry) = @_;
    my @next = @{$versions{$entry}{next}};
    my $count = @next;
    my @ordered;
    my $main;

    if ( $count > 1 )
    {
        # Array to hash to simplify removal
        my %nexts = map { $_ => 1 } @next;
        foreach my $e ( @next )
        {

            #
            #   Locate branch points that are not a part of a new project
            #   These will not be preferred paths for walking
            #
            if ( !defined($versions{$e}{branchPoint}) && $versions{$entry}{suffix} ne $versions{$e}{suffix} )
            {
                unless ( exists $versions{$e}{DeadWood} || $versions{$e}{badSingleton}  )
                {
#print "--- Project Branch (1) $versions{$e}{vname}\n";
                    $versions{$e}{branchPoint} = 1;
                    $versions{$e}{newSuffix} = 1;
                }
            }

            #
            #   Remove those that already have a branch,
            #
            if ( $versions{$e}{branchPoint} || $versions{$e}{newSuffix} || $versions{$e}{DeadWood}  )
            {
                push @ordered, $e;
                delete $nexts{$e};
            }
        }
        #
        #   Select longest arm as the non-branching path
        #   Note: Reverse sort order
        #         Done so that 'newest' item is given preference
        #         to the main trunk in cases where all subtrees are
        #         the same length
        #
        my $maxData = '';
        my $countEntry;
        foreach my $e ( sort {$b <=> $a} keys %nexts )
        {
            if ( $versions{$e}{maxVersion} gt $maxData )
            {
                $maxData = $versions{$e}{maxVersion};
                $countEntry = $e;
            }
        }
        if ($countEntry)
        {
            $main = $countEntry;
            delete $nexts{$countEntry};
        }

        #
        #   Append the remaining
        #
        push @ordered, keys %nexts;

        #
        #   Re-order 'next' so that the main path is first
        #   Sort (non main) by number
        #
        @ordered = sort {$a <=> $b} @ordered;
        unshift @ordered, $main if ( $main );
        @{$versions{$entry}{next}} = @ordered;

        #
        #   Ensure all except the first are a branch point
        #   First may still be a branch point
        #
        shift @ordered;
        foreach my $e ( @ordered )
        {
            $versions{$e}{branchPoint} = 1;
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : calcRippleGroups
#
# Description     : Locate and mark ripple groups
#                   packages that are ripples of each other
#                       Keep first version of each ripple. Must keep first
#                       Group ripples together so that they can be
#                       proccessed at the same time
#
# Inputs          : 
#
# Returns         : 
#
sub calcRippleGroups
{
    my %rippleVersions;
    foreach my $entry ( keys(%versions) )
    {
        my $ep = $versions{$entry};
        if ( defined $ep->{buildVersion} )
        {
            my $suffix = $ep->{suffix};
            my ($major, $minor, $patch, $build) = @{$ep->{buildVersion}};
#print "--- $major, $minor, $patch, $build, $suffix\n";
            $rippleVersions{$suffix}{"$major.$minor.$patch"}{count}++;
            my $rp = $rippleVersions{$suffix}{"$major.$minor.$patch"};
            $rp->{list}{$entry} = 1;

            next if ( $ep->{badVcsTag} );
            next if ( $ep->{locked} eq 'N');
            if (!defined ($rp->{min}) || $rp->{min} > $build )
            {
                $rp->{pvid} = $entry;
                $rp->{min} = $build;
            }
        }
    }
#            DebugDumpData("rippleVersions", \%rippleVersions );

    while ( my($suffix, $e1) = each %rippleVersions )
    {
        while ( my( $mmp, $e2) = each %{$e1} )
        {
            next unless ( exists  $e2->{pvid} );
            my $entry = $e2->{pvid};
            if ( !exists $versions{$entry} )
            {
                Error ("Internal: Expected entry not found: $entry, $mmp");
            }

            $versions{$entry}{keepLowestRipple} = 1;
#print "--- Keep Riple $versions{$entry}{vname}\n";

            #
            #   Update entry with list of associated ripples, removing lowest
            #
            delete $e2->{list}{$entry};
            my @rippleList = sort keys %{$e2->{list}};
            if ( @rippleList)
            {
#DebugDumpData("LIST: $entry", $e2->{list}, \@rippleList  );
                @{$versions{$entry}{rippleList}} = @rippleList;
            }
        }
    }
}

#-------------------------------------------------------------------------------
# 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();
            $createBranch = 1;
            $createSuffix = 1 if $versions{$entry}{newSuffix};
        }

        newPackageVersion( $entry );
no warnings "recursion";
        processBranch (@{$versions{$entry}{next}});
    }
}

#-------------------------------------------------------------------------------
# Function        : newPackageVersion
#
# Description     : Create a package version
#
# Inputs          : $entry              - Ref to entry being proccessed
#
# Returns         :
#
sub newPackageVersion
{
    my ($entry) = @_;
    my %data;
    my $flags = 'e';
    my $rv = 1;
    my $startTime = time();
    my $timestamp = localtime;

    $data{rmRef} = 'ERROR';
    $data{tag} = 'ERROR';

    #
    #   If its been processed then fake that its been done
    #   May have been a ripple that we processed
    #
    return if ($versions{$entry}{Processed});
    $processCount++;
    Message ("------------------------------------------------------------------" );
    Message ("Package $processCount of $processTotal");

    Message ("New package-version: " . GetVname($entry) . " Tag: " . $versions{$entry}{vcsTag} );

    #
    #   Detect user abort
    #
    if ( -f $cwd . '/stopfile' )
    {
        $globalError = 1;
        Message ("Stop file located");
    }

    #
    #   If we have a global error,then we pretend to process, but we
    #   report errors for the logging system
    #
    if ( $globalError )
    {
        Message ("Global error prevents futher importation");
    }
    else
    {
        #
        #   Call worker function
        #   It will exist on any error so that it can be logged
        #
        $rv = newPackageVersionBody( \%data, @_ );
        $globalError = 1 if ( $rv >= 10 );
    }

    #
    #   Highlight essential packages that failed to transfer
    #
    if ( $globalError ) {
        $flags = 'e';
    } elsif ( $rv && ( exists $versions{$entry}{Essential} ) ) {
        $flags = 'X';
    } elsif ( $rv ) {
        $flags = 'E';
    } else {
        $flags = 'G';
    }

    #
    #   Always log results to a file
    #   Flags:
    #       e - Error: Global Fatal causes other versions to be ignored
    #       X - Essential Package NOT proccessed
    #       E - Error processing package
    #       G - Good
    #
    my $duration = time() - $startTime;
    my $line = join(';',
            $flags,
            $entry,
            $packageNames,
            $versions{$entry}{vname},
            $data{rmRef},
            $data{tag},
            $timestamp,
            $duration,
            $data{errStr} || ''
            );
    logToFile( $cwd . '/importsummary.txt', ";$line;");
    #
    #   Sava data
    #
    $data{errFlags} = $flags;
    $data{duration} = $duration;
    $versions{$entry}{rmRef} = $data{rmRef};
    delete $data{rmRef};
    delete $data{tag};
    ##delete $data{ViewRoot};
    $versions{$entry}{data} = \%data;

    #
    #   Delete the created view
    #   Its just a directory, so delete it
    #
    if ( $data{ViewRoot} && -d $data{ViewRoot})
    {
        if ( !$opt_reuse || $rv )
        {
            Message ("Delete View: $data{ViewRoot}");
            RmDirTree ($data{ViewRoot} );
        }
        else
        {
            Message ("Retaining View: $data{ViewRoot}");
        }

    }
    else
    {
        Message ("No view to delete");
    }


    #
    #   If this version has any 'ripples' then process them while we have the
    #   main view. Note the ripple list may contain entries that do not
    #   exist - they will have been pruned.
    #
    foreach my $rentry ( @{$versions{$entry}{rippleList}} )
    {
        next unless( exists $versions{$rentry} );

        if ($versions{$rentry}{Processed})
        {
            Warning ("Ripple Processed before main entry");
            $versions{$rentry}{rippleProcessed} = 1;
        }

        Message ("Proccessing associated Ripple: " . GetVname($rentry));
        newPackageVersion($rentry);
    }
}

#-------------------------------------------------------------------------------
# Function        : newPackageVersionBody
#
# Description     : Perform the bulk of the work in creating a new PackageVersion
#                   Designed to return on error and have error processing
#                   performed by caller
#
# Inputs          : $data               - Shared data
#                   $entry              - Package entry to process
#
# Returns         : Error Code
#                         0 - All is well
#                       <10 - Recoverable error
#                       >10 - Fatal error
#
sub newPackageVersionBody
{
    my ($data, $entry) = @_;
    my $rv;
    my $cc_label;
    my $cc_path;

    #
    #   Init Data
    #
    $data->{rmRef} = 'ERROR';
    $data->{tag} = '';
    $data->{ViewRoot} = undef;
    $data->{ViewPath} = undef;
    $data->{errStr} = '';
    $versions{$entry}{Processed} = 1;
    
    
    SystemConfig ('ExitOnError' => 0);

    push @processOrder, $entry;
    return 0 if ( $opt_test );

#   Keep DeadWood. May be a WIP
#    if ( exists $versions{$entry}{DeadWood} && $versions{$entry}{DeadWood} )
#    {
#        $data->{errStr} = 'Package is DeadWood';
#        return 3;
#    }

    #
    #   Determine version information
    #
    $data->{tag} = $versions{$entry}{vcsTag} || '';
    if ( $versions{$entry}{badVcsTag} )
    {
        Warning ("Error: Bad VcsTag for: " . GetVname($entry),
                 "Tag: $data->{tag}" );
        $data->{errStr} = 'VCS Tag Marked as Bad';
        return 1;
    }


    $data->{tag} =~ m~^(.+?)::(.*?)(::(.+))?$~;
    $cc_label = $4;
    $cc_path = $2;
    $cc_path = '/' . $cc_path;
    $cc_path =~ tr~\\/~/~s;

    #
    #   Correct well known path mistakes
    #
    $cc_path =~ s~/MASS_Dev/Bus/~/MASS_Dev_Bus/~i;
    $cc_path =~ s~/MASS_Dev_Bus/Cbp/~/MASS_Dev_Bus/CBP/~i;
    $cc_path =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;
    $cc_path =~ s~/MREF_21/MREF_Package/~/MREF_Package/~i;


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

    #
    #   Create CC view
    #   Import into Subversion View
    #
    $data->{ViewRoot} = $opt_name ? $opt_name : "$cc_label";
    $data->{ViewPath} =  $data->{ViewRoot} . $cc_path;

    if ( $opt_preserveProjectBase )
    {
        my $cc_vob = $cc_path;
        $cc_vob =~ s~^/~~;
        $cc_vob =~ s~/.*~~;
        $data->{ViewPath} =  $data->{ViewRoot} . '/' . $cc_vob;
        Message ("Preserving Project Base");
    }
    $data->{ViewPath} =~  tr~/~/~s;

    if ( $opt_reuse && -d $data->{ViewPath}  )
    {
        Message ("Reusing view: $cc_label");
    }
    else
    {
        my @args;
        push (@args, '-view', $opt_name ) if ( defined $opt_name );
        $rv = JatsToolPrint ( 'jats_ccrelease', '-extractfiles', '-root=.' , '-noprefix',
                    "-label=$cc_label" ,
                    "-path=$cc_path",
                    @args
                    );

        unless ( -d $data->{ViewPath}  )
        {
            $data->{errStr} = 'Failed to extract files from CC';
            return 2;
        }
    }


    #
    #   Some really ugly packages make use of a Jats feature called 'SetProjectBase'
    #   Detect such packages as we will need to handle them differently
    #   Can't really handle it on the fly
    #   All we can do is detct it and report it - at the moment
    #
    if (detectProjectBaseUsage($data, $cc_path) )
    {
        unless ( $opt_ignoreProjectBaseErrors )
        {
            $data->{BadProjectBase}++;
            $data->{errStr} = 'Bad usage of ProjectBase detected';
            return 14;
        }
    }


    #
    #   Developers have been slack
    #       Sometime the mark the source path as 'GMTPE2005'
    #       Sometimes as 'GMTPE2005/Package/Fred/Jill/Harry'
    #
    #   Attempt to suck up empty directories below the specified
    #   source path
    #
    unless ( $opt_preserveProjectBase )
    {
        #
        #   Look in ViewPath
        #   If it contains only ONE directory then we can suck it up
        #
        my $testDir = findDirWithStuff( $data->{ViewPath} );

        unless ( $data->{ViewPath} eq $testDir  )
        {
            Message ("Adjust Base Dir: $testDir");
            $data->{adjustedPath} = $data->{ViewPath};
            $data->{ViewPath} = $testDir;
        }
    }
    

    #
    #   Have a CC view
    #   Now we can create the SVN package and branching point before we
    #   import the CC data into SVN
    #
    my @args;

    #
    #   Calculate args for functions
    #
    my $author = $versions{$entry}{created_id};
    if ( $author )
    {
        push @args, '-author', $author;
    }
    my $created = $versions{$entry}{created};
    if ( $created )
    {
        $created =~ s~ ~T~;
        $created .= '00000Z';
        push @args, '-date', $created;
    }

    my $log = $versions{$entry}{comment};
    if ( $log )
    {
        push @args, '-log', $log;
    }
        
    #
    #   Create package skeleton if needed
    #
    $rv = createPackage( $author, $created);
    if ( $rv )
    {
        $data->{errStr} = 'Failed to create Package';
        return 10;
    }

    #
    #   Calculate the label for the target package
    #   Use format <packageName>_<PackageVersion>
    #   Need to handle WIPs too.
    #
    my $import_label = saneLabel($entry);

    #
    #   May need to create the branchpoint
    #   The process is delayed until its needed so avoid creating unneeded
    #   branch points
    #
    if ( $createBranch )
    {
        $rv = createBranchPoint ($entry, $author, $created);
        $createBranch = 0;
        $createSuffix = 0;
        if ( $rv )
        {
            $data->{errStr} = 'Failed to create Branch Point';
            return 11;
        }
    }
    push @args, "-branch=$currentBranchName" if ( defined $currentBranchName );

    my $datafile = "importdata.$import_label.properties";
    $rv = JatsToolPrint ( 'jats_svn', 'import', '-reuse' ,
                    "-package=$svnRepo/$packageNames",
                    "-dir=$data->{ViewPath}",
                    "-label=$import_label",
                    "-datafile=$datafile",
                    @args,
                     );

    if ( $rv )
    {
        $data->{errStr} = 'Failed to import to SVN';
        return 12;
    }

    $versions{$entry}{TagCreated} = 1;
    $firstVersionCreated = $entry unless ( $firstVersionCreated );

    #
    #   Read in the Rm Reference
    #   Retain entries in a global file
    #
    if ( -f $datafile  )
    {
        my $rmData = JatsProperties::New($datafile);
        $data->{rmRef} = 'SVN::' . $rmData->getProperty('subversion.tag');
    }

    unless ( $data->{rmRef}  )
    {
        $data->{errStr} = 'Failed to determine Rm Reference';
        return 13;
    }


    #
    #   Add supplemental tags if this version is in a 'Release'
    #   But only for some packages - els looks like a mess
    #   Just a solution for the ITSO guys
    #
    foreach my $rtag_id ( keys %{$versions{$entry}{Releases}}  )
    {
        next unless ( $svnRepo =~ m~/ITSO_TRACS(/|$)~);

        my $prog_id = $versions{$entry}{Releases}{$rtag_id}{proj_id};
        Message ("Adding Release Tag:$prog_id:$rtag_id");

        my $rtext = 'Release_' . saneString($versions{$entry}{Releases}{$rtag_id}{rname});
        my @comment;
        push @comment, "Tagged by ClearCase to Subversion import";
        push @comment, "Project:$prog_id:$versions{$entry}{Releases}{$rtag_id}{pname}";
        push @comment, "Release:$rtag_id:$versions{$entry}{Releases}{$rtag_id}{rname}";

        $data->{ReleaseTag}{$prog_id}{$rtag_id}{name} = $rtext;

        $rv = JatsToolPrint ( 'jats_svnlabel' ,
                    '-comment', encode('UTF-8', join("\n", @comment), Encode::FB_DEFAULT),
                    $data->{rmRef},
                    '-clone',
                    $rtext,
#                    @args,
                    '-author=buildadm',
                     );
        $data->{ReleaseTag}{$prog_id}{$rtag_id}{eState} = $rv;
        $data->{ReleaseTag}{tCount}++;

        if ( $rv )
        {
            $data->{ReleaseTag}{eCount}++;
            Warning("Failed to add Release Tag: $rtext");
        }
    }


    Message ("RM Ref: $data->{rmRef}");
    unlink $datafile;

    #
    #   All is good
    #
    $data->{errStr} = '';
    return 0;
}


#-------------------------------------------------------------------------------
# Function        : newProject
#
# Description     : Start a new project within a package
#
# Inputs          : 
#
# Returns         : 
#
sub newProject
{
#    Message ("---- New Project");
    $createSuffix = 0;
    
    #
    #   New project
    #   Kill the running import directory
    #
    RmDirTree ('SvnImportDir');
}

#-------------------------------------------------------------------------------
# Function        : newPackage
#
# Description     : Start processing a new package
#
# Inputs          : 
#
# Returns         : 
#
my $createPackageDone;
sub newPackage
{
#    Message( "---- New Package");

    #
    #   Create a package specific log file
    #
    $logSummary = $packageNames . ".summary.log";
    unlink $logSummary;
    Message( "PackageName: $packageNames");
    $createPackageDone = 1;
    $createBranch = 0;
    $createSuffix = 0;

    #
    #   First entry being created
    #   Prime the work area
    #
    RmDirTree ('SvnImportDir');
}

#-------------------------------------------------------------------------------
# Function        : createPackage
#
# Description     : Create a new Package in SVN
#                   Called before any serious SVN operation to ensure that the
#                   package has been created. Don't create a package until
#                   we expect to put something into it.
#
#                   Will only create a package once

#
# Inputs          : $author         - Who done it
#                   $date           - When
#
# Returns         : 
#
sub createPackage
{
    my ($author, $date) = @_;
    my @opts;
    push (@opts, '-date', $date) if ( $date );
    push (@opts, '-author', $author) if ( $author );
    #
    #   Only do once
    #
    return unless ( $createPackageDone );
    $createPackageDone = 0;

    #
    #   Real import
    #       Do not Delete package if it exists
    #       Package must NOT exist
    #
    Message ("Creating new SVN package: $packageNames");
    if ( $opt_delete )
    {
        Message ("Delete existing version of package: $packageNames");
        JatsToolPrint ( 'jats_svn', 'delete-package', '-noerror',  "$svnRepo/$packageNames" );
    }
    JatsToolPrint ( 'jats_svn', 'create', "$svnRepo/$packageNames", '-new', @opts );
}


#-------------------------------------------------------------------------------
# Function        : createBranchPoint
#
# Description     : Create a branch point for the current work
#                   Perform the calculation to determine the details of
#                   the branch point. The work will only be done when its
#                   needed. This will avoid the creation of branchpoints
#                   that are not used.
#
# Inputs          : $entry                  Entry being processed
#                   $author         - Who done it
#                   $date           - When
#
# Returns         : 
#
sub createBranchPoint
{
    my ($entry, $author, $date) = @_;
    my $forceNewProject;

#    Message ("---- Create Branch Point");

    #
    #   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
    #   If we transferred any software at all, then use the first
    #   version as the base for this disconnected version
    #
    #   Otherwise we create a new, and empty, view
    #
    unless ( $last )
    {
        if ( $firstVersionCreated )
        {
            Warning ("Cannot find previous version to branch. Use first version");
            $last = $firstVersionCreated;
        }
        else
        {
            Warning ("Forcing First instance of a Project");
            $forceNewProject = 1;
        }
    }

    #
    #   Determine source name
    #   This MUST have been created before we can branch
    #
    my $src_label;
    $src_label = saneLabel($last) if $last;

    #
    #   Create target name
    #
    my $tgt_label;
    if ( $forceNewProject || $versions{$entry}{newSuffix} || $createSuffix || !defined $src_label )
    {
        #
        #   Create target name based on project
        #
        return if ( $singleProject );

        my $suffix = $versions{$entry}{suffix};
        if ( $suffix )
        {
            Error ("Unknown Project: $suffix") unless ( defined $Projects{$suffix} );

            #
            #   If this project can be considered to be a truck, then 'claim' the
            #   truck for the first created element.
            #
            if ( $Projects{$suffix}{Trunk} )
            {
                # This project can use the trunk, if it has not been allocated.
                $ProjectTrunk = $suffix unless ( defined $ProjectTrunk );
                
                #
                #   If this package has multiple instances of the potential
                #   trunk, then don't place either of them on the trunk as it
                #   may cause confusion
                #
                if ($knownProjects{$suffix}{count} < 2 )
                {
                    if ( $suffix eq $ProjectTrunk )
                    {
                        return unless $currentBranchName;
                    }
                }
            }

            $tgt_label = $Projects{$suffix}{Name};
            $tgt_label = $versions{$entry}{name} . '_' . $tgt_label if ($multiPackages);
            if ( !exists $ProjectsBaseCreated{$tgt_label}  )
            {
                $ProjectsBaseCreated{$tgt_label} = 1;
            }
            else
            {
                #   Project Base Already taken
                #   Have disjoint starting points
                $tgt_label .= '.' . $ProjectsBaseCreated{$tgt_label} ++;
            }
        }
        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 = saneLabel($entry, $src_label . '_for_');
    }

    #
    #   Save branch name for use when populating sandbox
    #
    $currentBranchName = $tgt_label;

    #
    #   Perform the branch
    #
    if ( defined $src_label )
    {
        #
        #   The 'clone' operation will backtrack the branch point
        #   to the source of the label. This will make the output version
        #   tree much prettier
        #
        my @opts;
        push (@opts, '-date', $date) if ( $date );
        push (@opts, '-author', $author) if ( $author );
        
        JatsToolPrint ( 'jats_svnlabel',
                        '-packagebase', "$svnRepo/$packageNames",
                        'tags/' . $src_label,
                        '-branch',
                        '-clone', $tgt_label,
                        @opts
                      );
    }
}


#-------------------------------------------------------------------------------
# Function        : endPackage
#
# Description     : End of package processing
#                   Clean up and display problems
#
# Inputs          : 
#
# Returns         : 
#
sub endPackage
{
    RmDirTree ('SvnImportDir');

    #
    #   Display versions that did get captured
    #
    foreach my $entry ( @processOrder )
    {
        $versions{$entry}{Scanned} = 1;
        next unless ( $versions{$entry}{TagCreated} );
        Warning ("Processed: " . GetVname($entry) . ' :: ' . $versions{$entry}{rmRef} || $versions{$entry}{errStr} || '???' );
    }

    #
    #   Display versions that did not get created
    #
    foreach my $entry ( @processOrder )
    {
        $versions{$entry}{Scanned} = 1;
        next if ( $versions{$entry}{TagCreated} );
        Warning ("Not Processed: " . GetVname($entry) );
    }

    foreach my $entry ( keys(%versions) )
    {
        next if ( $versions{$entry}{Scanned} );
        Warning ("(E) INTERNAL ERROR. Package Not Processed: " . GetVname($entry) );
    }

    Message ("All Done");
}

#-------------------------------------------------------------------------------
# Function        : detectProjectBaseUsage
#
# Description     : Detect and report usage of the SetProjectBase directive
#
# Inputs          : $data               - Ref to a hash of bits
#                   $cc_path            - Packages cc_path
#
# Returns         : true    - Bad usage (Really good usage not detected)
#                   false   - Good usage detected
#
sub detectProjectBaseUsage
{
    my ($data, $cc_path) = @_;
    my $retval = 0;
    my $eSuf = $opt_ignoreProjectBaseErrors ? '' : 'Error';

    #
    #   Find makefile.pl
    #
    Message ("Locate JATS makefiles");
    my $usesProjectBase = 0;
    my $definesProjectBase = 0;
    my $definitionError = 0;

    my $search = JatsLocateFiles->new("--Recurse=1",
                                       "--FilterIn=makefile.pl",
                                       );
    my @makefiles = $search->search($data->{ViewRoot});
    foreach my $file ( @makefiles )
    {
        if ( open( my $fh, '<', "$data->{ViewRoot}/$file" ) )
        {
            while ( <$fh> )
            {
                s~\s+$~~;
                s~^\s+~~;
                next if ( m~^#~ );

                if ( m~\$ProjectBase~ )
                {
                    $usesProjectBase++;
                    Message ("Project Base Use: $_");
                    $data->{UsesProjectBase}++;
                }

                if ( m~^SetProjectBase~ )
                {
                    $definesProjectBase++;
                    $data->{DefinesProjectBase}++;
                    Warning ("Package uses SetProjectBase:",
                             "Line: " . $_,
                             "Root: " . "$data->{ViewRoot}",
                             "File: " . "$data->{ViewRoot}/$file",
                            );

                    # The only problem is if the user attempts to escape
                    # from the root of the view.
                    #
                    # Examine the depth of the makefile with the directive
                    # Examine the depth of the view base
                    #
                    #
                    # Locate the build.pl file
                    # This is the basis for for the directive
                    #
                    my $blevel;
                    my @bpaths = split ('/', $file );
                    while ( @bpaths )
                    {
                        $bpaths[-1] = 'build.pl';
                        my $bfile = join '/', @bpaths ;
                        if ( -f "$data->{ViewRoot}/$bfile" )
                        {
                            $blevel = scalar @bpaths;
                            last;
                        }
                        pop @bpaths;
                    }
                    unless (defined $blevel)
                    {
                        Warning ("SetProjectBase$eSuf calculation failed - can't find build.pl");
                        $retval = 1;
                    }
                    else
                    {
                        #
                        #   Determine the depth of the view root
                        #   This is given by cc_path, but cc_path has a leading /
                        #
                        my @cpaths = split ('/', $cc_path );
                        my $clevel = (scalar @cpaths) - 1;
                        my $max_up = $blevel - $clevel - 1;

                        m~--Up=(\d+)~i;
                        my $ulevel = $1;
                        if ( defined $ulevel )
                        {
                            my @paths = split ('/', $file );
                            my $plevel = scalar @paths;

#print "--- blevel: $blevel\n";
#print "--- bpaths: @bpaths\n";
#print "--- ulevel: $ulevel\n";
#print "--- paths: @paths\n";
#print "--- plevel: $plevel\n";
#print "--- cpaths: @cpaths\n";
#print "--- clevel: $clevel\n";
#print "--- max_up: $max_up\n";

                            if ( $ulevel > $max_up )
                            {
                                Warning ("SetProjectBase escapes view. MaxUp: $max_up, Up: $ulevel");
                                $definitionError++;
                            }
                        }
                        else
                        {
                            $retval = 1;
                            Warning ("SetProjectBase$eSuf MAY escape view - can't detect level")
                        }
                    }
                }
            }
            close $fh;
        }
        else
        {
            Warning ("SetProjectBase$eSuf - Cannot open makefile: $file");
            $retval = 1;
        }
    }

    #
    #   Detect defined, but not used
    #
    if ( $usesProjectBase && ! $definesProjectBase )
    {
        Warning ("SetProjectBase - Uses ProjectBase without defining it");
    }

    if ( ! $usesProjectBase && $definesProjectBase )
    {
        Warning ("SetProjectBase - Defines ProjectBase without using it");
    }

    if ( $usesProjectBase && $definesProjectBase && $definitionError )
    {
        Warning ("SetProjectBase$eSuf - Problem detected");
        $retval = 1;
    }
    return $retval;
}

#-------------------------------------------------------------------------------
# Function        : findDirWithStuff
#
# Description     : Find a directory that contains more than just another subdir
#
# Inputs          : $base               - Start of the scan
#
# Returns         : Path to dir with more than just a single dir in it
#
sub findDirWithStuff
{
    my ($base) = @_;

    while ( $base )
    {
    my $fileCount = 0;
    my $dirCount = 0;
    my $firstDir;

    my @list = glob( $base . '/*');
    foreach ( @list )
    {
        next if ( $_ eq '.' );
        next if ( $_ eq '..' );
        if ( -d $_ )
        {
            $dirCount++;
            $firstDir = $_ unless ( defined $firstDir );
            return $base if ( $dirCount > 1  );
        }
        elsif ( -e $_ )
        {
            return $base;
        }

        # else its probably a dead symlink
    }
    return $base unless ( $dirCount == 1  );
    $base = $firstDir;
    }
}


#-------------------------------------------------------------------------------
# Function        : JatsToolPrint
#
# Description     : Print and Execuate a JatsTool command
#
# Inputs          : 
#
# Returns         : 
#

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

sub saneLabel
{
    my ($entry, $pkgname) = @_;
    my $me;
    $me = $versions{$entry}{vname};
    $pkgname = $versions{$entry}{name} unless ( defined $pkgname );

    Error ("Package does have a version string: pvid: $entry")
        unless ( defined $me );

    #
    #   Convert Wip format (xxxx) into a string that can be used for a label
    #
    if ( $me =~ m~^(.*)\((.*)\)(.*)$~ )
    {
        $me = $1 . '_' . $2 . '_' . $3 . '.WIP';
        $me =~ s~_\.~.~;
        $me =~ s~^_~~;
    }

    #
    #   Allow for WIPS
    #   Get rid of multiple '_'
    #   Replace space with -
    #
    $me = $pkgname . '_' . $me;
    $me =~ tr~ ~-~s;
    $me =~ tr~-~-~s;
    $me =~ tr~_~_~s;

    return $me;
}

sub saneString
{
    my ($string) = @_;
    #
    #   Get rid of multiple '_'
    #   Replace space with -
    #
    $string =~ s~\W~_~g;
    $string =~ tr~ ~_~s;
    $string =~ tr~_-~-~s;
    $string =~ tr~-_~-~s;
    $string =~ tr~-~-~s;
    $string =~ tr~_~_~s;
    $string =~ s~-$~~;
    $string =~ s~_$~~;

    return $string;
}


exit 0;


#-------------------------------------------------------------------------------
# Function        : GetPkgIdByName
#
# Description     :
#
# Inputs          : pkg_name
#
# Returns         : pkg_id
#
sub GetPkgIdByName
{
    my ( $pkg_name ) = @_;
    my (@row);
    my $pv_id;
    my $pkg_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" );
    }

    return $pkg_id;
}

#-------------------------------------------------------------------------------
# Function        : GetData_by_pkg_id
#
# Description     :
#
# Inputs          : pv_id
#
# Returns         :
#
sub GetData_by_pkg_id
{
    my ( $pkg_id, $packageName ) = @_;
    my (@row);

    #
    #   Establish a connection to Release Manager
    #
    Message ("Extract package versions from Release Manager: $packageName");
    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, pv.CREATOR_ID ".
                   " 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 amu.USER_ID (+) = pv.CREATOR_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';
                       $pkg_ver =~ s~\s+$~~;
                       $pkg_ver =~ s~^\s+~~;
                    my $pv_id = $row[3] || 'Unknown';
                    my $last_pv_id = $row[4];
                    my $created =  $row[5] || 'Unknown';
                    my $vcstag =  $row[6] || 'Unknown';

                    my $created_id =  $row[7] || ($row[10] ? "Userid_$row[10]" :'Unknown');
                    my $comment =  $row[8] || '';
                    my $locked =  $row[9] || 'N';

                    #
                    #   Some developers have a 'special' package version
                    #   We really need to ignore them
                    #
                    next if ( $pkg_ver eq '23.23.23.ssw' );
                    
                    #
                    #   Add data to the hash
                    #       Remove entries that address themselves
                    #
                    push (@{$versions{$last_pv_id}{next}}, $pv_id) unless ($pv_id == $last_pv_id || $last_pv_id == 0) ;
                    $versions{$pv_id}{name} = $pkg_name;
                    $versions{$pv_id}{pvid} = $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;
                    $versions{$pv_id}{TimeStamp} = str2time( $created );
                    $versions{$pv_id}{Age} = ($now - $versions{$pv_id}{TimeStamp}) / (60 * 60 * 24);
                    $versions{$pv_id}{TooOld} = 1 if ( $opt_age && $opt_age <= $versions{$pv_id}{Age} );
                    examineVcsTag($pv_id);

                    #
                    #   Process version number
                    #
                    my ($suffix, $version, $isaR, $isaWip, $buildVersion ) = massageVersion($pkg_ver, $pkg_name);

                    $versions{$pv_id}{version} = $version;
                    $versions{$pv_id}{buildVersion} = $buildVersion;
                    $versions{$pv_id}{isaRipple} = 1 if ( $isaR );
                    $versions{$pv_id}{isaWip} = 1 if ( $isaWip );

                    #
                    #   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, $locked, $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" );
    }
}

#-------------------------------------------------------------------------------
# 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 $buildVersion;
    my $isaRipple;
    my $isaWIP;
    $build = 0;

#print "--- $name, $version\n";
    $version =~ s~^_~~;
    $version =~ s~^${name}_~~;

    #
    #   xxxxxxxxx.nnnn.cots
    #
    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
    #   Don't flag as ripples - they are patches
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-.p][p]?(\d+)([-.](.*))?$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = $4;
        $suffix = defined $6 ? ".$6" : '';
        $isaRipple = 0;
    }
    #
    #       nn.nnn.nnnnn.xxx
    #       nn.nnn.nnnnn-xxx
    #       nnn.nnn.nnnx.xxx
    #   Don't flag as ripples - they are patches
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)\w?([-.](.*))?$~ ) {
        $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" : '';
    }

    #
    #       nnn.nnn.nnn
    #       nnn.nnn-nnn
    #       nnn.nnn_nnn
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)[-._](\d+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $suffix = '';
    }

    #
    #       nnn.nnn.nnn.nnn
    #       nnn.nnn.nnn-nnn
    #       nnn.nnn.nnn_nnn
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)[-._](\d+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = $4;
        $suffix = '';
        $isaRipple = 0;
    }
    

    #
    #       nnn.nnn
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = 0;
        $suffix = '';
    }
    #
    #       nnn.nnn.xxx
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)(\.\w+)$~ ) {
        $major = $1;
        $minor = $2;
        $patch = 0;
        $suffix = $3;
    }
    
    #
    #       nnn.nnn.nnnz
    #
    elsif ( $version =~ m~^(\d+)\.(\d+)\.(\d+)([a-z])$~ ) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = ord($4) - ord('a');
        $suffix = '.cots';
        $isaRipple = 0;
    }
    #
    #       ???REV=???
    #
    elsif ( $version =~ m~REV=~ ) {
        $suffix = '.cots';
        $result = $version . '.0000.cots';
    }

    #
    #   Wip Packages
    #   (nnnnnn).xxx
    #   Should be essential, but want to sort very low
    #
    elsif ($version =~ m~\((.*)\)(\..*)?~) {
        $suffix = $2 || '';
        $result = "000.000.000.000$suffix";
        $isaWIP = 1;
    }

    #
    #   !current
    #
    elsif ($version eq '!current' || $version eq 'current_$USER' || $version eq 'current' || $version eq 'beta' || $version eq 'latest' || $version eq 'beta.cr' || $version eq 'CREATE') {
        $suffix = '';
        $result = "000.000.000.000$suffix";
        $isaWIP = 1;
    }
    
    #
    #   Also WIP: FINRUN.103649.BEI.WIP
    elsif ($version =~ m~(\.[a-zA-Z]+)\.WIP$~) {
        $suffix = lc($1);
        $result = "000.000.000.000$suffix";
        $isaWIP = 1;
    }

    #
    #   Also ERGOFSSLS190100_015
    #   Don't flag as a ripple
    elsif ($version =~ m~^ERG[A-Z]+(\d\d)(\d\d)(\d\d)[-_](\d+)(\.\w+)?$~) {
        $major = $1;
        $minor = $2;
        $patch = $3;
        $build = $4;
        $suffix = $5 || '.sls';
        $isaRipple = 0;
    }
    
    #
    #   Stuff we don't yet handle
    #
    else  {
        Warning ("Unknown version number: $name,$version");
        $version =~ m~(\.\w+)$~;
        $suffix = $1 || '';
        $result = $version;
    }

    $isaRipple = ($build > 0) unless defined $isaRipple;
    unless ( $result )
    {
        # Major and minor of 99.99 are normally funy versions
        # Don't make important desicions on them
        #
        if ( $major == 99 && $minor == 99 )
        {
            $major = 0;
            $minor = 0;
            $patch = 0;
        }
        
        $result = sprintf("%3.3d.%3.3d.%3.3d.%3.3d%s", $major,$minor,$patch,$build,$suffix || '.0000');
        $buildVersion = [ $major, $minor, $patch, $build ];
    }

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

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

#-------------------------------------------------------------------------------
# Function        : vcsCleanup
#
# Description     : Cleanup and rewrite a vcstag
#
#                   DUPLICATED IN:
#                       - cc2svn_procdata
#                       - cc2svn_importpackage
#
# Inputs          : vcstag
#
# Returns         : Cleaned up vcs tag
#
sub vcsCleanup
{
    my ($tag) = @_;
    $tag =~ tr~\\/~/~;
    if ( $tag =~ m~^CC::~ )
    {
        $tag =~ s~CC::\s+~CC::~;
        $tag =~ s~MASS_Dev_Bus/Cbp/~MASS_Dev_Bus/CBP/~i;
        $tag =~ s~MASS_Dev_Bus~MASS_Dev_Bus~i;
        $tag =~ s~/MASS_Dev/Infra~MASS_Dev_Infra~i;
        $tag =~ s~/MASS_Dev/Bus/web~/MASS_Dev_Bus/web~i;

        $tag =~ s~/Vastraffik/~/Vasttrafik/~;
        $tag =~ s~/MREF_Package/ergpostmongui$~/MREF_Package/ergpostmongui~i;
        $tag =~ s~DPC_SWCode/~DPG_SWCode/~i;
    }
    return $tag;
}

#-------------------------------------------------------------------------------
# Function        : examineVcsTag
#
# Description     : Examine a VCS Tag and determine if it looks like rubbish
#                   Give it a clean
#
# Inputs          : $entry
#
# Returns         : Will add Data to the $entry
#
sub examineVcsTag
{
    my ($entry) = @_;
    my $bad = 0;

    $versions{$entry}{vcsTag} = vcsCleanup($versions{$entry}{vcsTag});
    my $vcstag = $versions{$entry}{vcsTag};
    
    if ( $vcstag =~ m~^SVN::~ ) {
        $versions{$entry}{isSvn} = 1;

    } elsif ( $vcstag =~ m~^CC::(.*?)(::(.+))?$~ ) {
        my $path = $1  || '';
        my $label = $2 || '';
        $bad = 1 unless ( $label );
        $bad = 1 if ( $label =~ m~^N/A$~i || $label  =~ m~^na$~i );

        $bad = 1 unless ( $path );
        $bad = 1 if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
        $bad = 1 if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
        $bad = 1 if ( $path =~ m~^/devl/~ || $path  =~ m~^devl/~ );
        $bad = 1 if ( $path =~ m~^CVS~ );
        $bad = 1 if ( $path =~ m~^http:~i );
        $bad = 1 if ( $path =~ m~^[A-Za-z]\:~ );
        $bad = 1 if ( $path =~ m~^//~ );
        $bad = 1 if ( $path =~ m~^/*none~i );
        $bad = 1 if ( $path =~ m~^/*NoWhere~i );
        $bad = 1 if ( $path =~ m~^-$~i );
        $bad = 1 if ( $path =~ m~^cvsserver:~ );
        $bad = 1 if ( $path =~ m~,\s*module:~ );
#        $bad = 1 unless ( $path =~ m~^/~ );
    }
    else
    {
        $bad = 1;
    }
    $versions{$entry}{badVcsTag} = 1 if ( $bad );
}

#-------------------------------------------------------------------------------
# Function        : logToFile
#
# Description     : Log some data to a named file
#                   Use file locking to allow multiple process to log
#
# Inputs          : $filename           - Name of file to log
#                   ...                 - Data to log
#
# Returns         : Nothing
#
sub logToFile
{
    my ($file, @data) = @_;

    open  (LOGFILE, '>>', $file);
    flock (LOGFILE, LOCK_EX);
    print  LOGFILE "@data\n";
    flock (LOGFILE, LOCK_UN);
    close (LOGFILE);
}

#-------------------------------------------------------------------------------
# Function        : createImages
#
# Description     : Create nice images of the RM version tree
#
# Inputs          : 
#
# Returns         : 
#
sub createImages
{

    my $filebase = "${packageNames}";
    open (FH, '>', "$filebase.dot" ) or die "Cannot open output";
    print FH "digraph \"${packageNames}\" {\n";
    #print FH "rankdir=LR;\n";
    print FH "node[fontsize=16];\n";
    print FH "node[target=_graphviz];\n";
#    print FH "subgraph cluster_A {\n";
#    print FH "node[fontsize=12];\n";

    {
        my @text;
        push @text, $packageNames;
        push @text, 'HyperLinked to Release Manager';
        push @text, 'Created:' . localtime();
        push @text, '|';

        push @text, 'Total RM versions: ' . $totalVersions;
        push @text, 'Essential Entries: ' . scalar @EssentialPackages;
        push @text, 'Initial trees: ' . $initialTrees;

        push @text, 'Number of Entries: ' . $processTotal;
        push @text, 'Type : ' . $packageType;
        push @text, 'All versions in Subversion' if ( $allSvn );

        push @text, '|';
        push @text, 'Total Project Branches: ' . $ProjectCount;
        foreach ( sort keys %knownProjects )
        {
            my $count = $knownProjects{$_}{count} || 0;
            if ( $count )
            {
                my $text = 'Project Branch: ' . $_;
                $text .= " (" . $count . ")" if ( $count > 1 );
                push @text, $text;
            }
        }
    
        push @text, '|';
        push @text, 'Bad VCS : ' . $badVcsCount;
        push @text, 'Bad Singletions : ' . $badSingletonCount;
        push @text, 'Deadwood entries : ' . $trimCount;
        push @text, 'Walking Mode : Flat' if ($opt_flat);
        push @text, 'Pruned Mode : ' . $pruneModeString;
        push @text, 'Pruned entries : ' . $pruneCount;
        push @text, 'Recent entries : ' . $recentCount;

        if ( @unknownProjects )
        {
            push @text, '|';
            push @text, 'Unknown Projects';
            push @text, 'Unknown Project: ' . $_ foreach (sort @unknownProjects );
        }
        
        #
        #   Multiple Paths
        #
        if ( scalar @multiplePaths > 1 )
        {
            push @text, '|';
            push @text, 'Multiple Paths';
            push @text, @multiplePaths;
        }

        #
        #   Bad essentials
        #
        if ( @badEssentials  )
        {
            push @text, '|';
            push @text, 'Bad Essential Versions';
            push @text, GetVname($_) foreach ( @badEssentials );
        }

        #
        #   Subversion Data
        #
        if ( %svnData )
        {
            push @text, '|';
            push @text, 'Subversion';
            push @text, 'Trunk used' if exists $svnData{branches}{trunk} ;
            push @text, 'Labels: ' . scalar keys %{$svnData{tags}} ;
            push @text, 'Branches: ' . scalar keys %{$svnData{branches}} ;
        }

        push @text, '';
        my $text = join '\l', @text;
        $text =~ s~\|\\l~|~g;

        my @attributes;
        push @attributes, "shape=record";
        push @attributes, "label=\"{$text}\"";
        push @attributes, "tooltip=\"$packageNames\"";
        push (@attributes, "URL=\"" . $GBE_RM_URL . "/view_by_version.asp?pkg_id=$first_pkg_id" . "\"" )if $first_pkg_id;
        push @attributes, "color=red";
        my $attr = join( ' ', @attributes);

        my $tld_done = 'TitleBlock';
        print FH "$tld_done [$attr]\n";
    }

    #
    #   Generate Legend
    #
    {
        my @text;
        push @text, 'Legend';
        push @text, '|';
        push @text, 'Node Content';
        push @text, 'Package Version';
#        push @text, 'Release Manager Ref (pvid)';
        push @text, 'Creation Date: yyyy-mm-dd';
        push @text, '(Coded information)';
        push @text, '|{Code';
        push @text, '|{N: Not Locked';
        push @text, 'b: Bad Singleton';
        push @text, 'B: Bad VCS Tag';
        push @text, 'D: DeadWood';
        push @text, 'E: Essential Release Version';
        push @text, 'G: Glued into Version Tree';
        push @text, 'r: Recent version';
        push @text, 'R: Ripple';
        push @text, 'S: Splitpoint';
        push @text, 't: Glued into Project Tree';
        push @text, 'T: Tip version';
        push @text, 'V: In SVN';
        push @text, '+: In Subversion';
        push @text, '}}';

        push @text, '|';
        push @text, 'Outline';
        push @text, 'Red: Dead or Bad VCS Tag';
        push @text, 'Orange: Project Branch Root';
        push @text, 'Green: Ripple Build Version';
        push @text, 'Blue: Essential Version';
        push @text, 'Darkmagenta: Entry Glued into tree';
        push @text, 'Magenta: Entry added to project tree';


        push @text, '|';
        push @text, 'Fill';
        push @text, 'PowderBlue: Essential Version';
        push @text, 'Red: Bad Essential Version';
        push @text, 'Light Green: Migrated to SVN';
#        push @text, 'Red: Entry Glued into tree';
#        push @text, 'Green: Entry added to project tree';

        push @text, '|';
        push @text, 'Shape';
        push @text, 'Oval: Normal Package Version';
        push @text, 'Invhouse: Project Branch Root';
        push @text, 'Octagon: Branch Point';
        push @text, 'Box: Bad Single version with no history';
        push @text, 'Doublecircle: Tip of a Project Branch';

        push @text, '';
        my $text = join '\l', @text;
        $text =~ s~\|\\l~|~g;
        $text =~ s~\}\\l~}~g;

        my @attributes;
        push @attributes, "shape=record";
        push @attributes, "label=\"{$text}\"";
        push @attributes, "color=red";
        my $attr = join( ' ', @attributes);

        my $tld_done = 'LegendBlock';
        print FH "$tld_done [$attr]\n";
    }

#    print FH "\n}\n";
    print FH "TitleBlock -> LegendBlock [style=invis]\n";

    sub genLabelText
    {
        my ($entry) = @_;
        my @label;
        push @label, $versions{$entry}{name} if ( $multiPackages );
        push @label, $versions{$entry}{vname};
#        push @label, $entry;       # Add PVID
        push @label, substr( $versions{$entry}{created}, 0, 10); #  2008-02-19
#        push @label, 'V=' . $versions{$entry}{maxVersion};
#        push @label, 'B=' . $versions{$entry}{svnBranchTip} if ( exists $versions{$entry}{svnBranchTip} );


        my $stateText = '';
        $stateText .= 'N' if ($versions{$entry}{locked} eq 'N');
        $stateText .= 'b' if (exists $versions{$entry}{badSingleton});
        $stateText .= 'B' if (exists $versions{$entry}{badVcsTag});
        $stateText .= 'G' if (exists $versions{$entry}{GluedIn});
        $stateText .= 't' if (exists $versions{$entry}{MakeTree});
        $stateText .= 'E' if (exists $versions{$entry}{Essential});
        $stateText .= 'D' if (exists $versions{$entry}{DeadWood});
        $stateText .= 'R' if ( $versions{$entry}{isaRipple} );
        $stateText .= 'r' if (exists $versions{$entry}{keepRecent} && $versions{$entry}{keepRecent} );
        $stateText .= 'S' if (exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
        $stateText .= 'T' if (exists $versions{$entry}{Tip} );
        $stateText .= 'V' if (exists $versions{$entry}{isSvn} );
        $stateText .= '+' if (exists $versions{$entry}{svnVersion} );
#        $stateText .= 's' if (exists $versions{$entry}{branchPoint} );
#        $stateText .= ' T='. $versions{$entry}{threadId} if (exists $versions{$entry}{threadId});
#        $stateText .= ' EssentalPath' if (exists $versions{$entry}{EssentialPath});
#        $stateText .= ' Count='. $versions{$entry}{EssentialSplitPoint} if (exists $versions{$entry}{EssentialSplitPoint});
#        $stateText .= ' M='. $versions{$entry}{maxVersion} if (exists $versions{$entry}{maxVersion});

        push @label, "(${stateText})" if ( $stateText );

##       Insert Release Names
#        foreach my $rtag_id ( keys %{$versions{$entry}{Releases}}  ) {
#            push @label, "Release: $versions{$entry}{Releases}{$rtag_id}{rname}";
#        }

        return join ('\n', @label );
    }

    sub genAttributes
    {
        my ($entry) = @_;
        my @attributes;
        push @attributes, 'label="' . genLabelText($entry) . '"';
        push @attributes, 'URL="' . dotUrl($entry) . '"';
        push @attributes, 'tooltip="' . "Goto: $versions{$entry}{vname}, PVID=$entry" ,'"';
        my $shape;
            $shape = 'box' if ($versions{$entry}{badSingleton});
            $shape = 'octagon'  if ($versions{$entry}{branchPoint});
            $shape = 'invhouse' if ($versions{$entry}{newSuffix});
            $shape = 'doublecircle' if ($versions{$entry}{Tip});


        push @attributes, 'shape=' . $shape if ( $shape );

        my $color;
        my $fill;
           $color = 'color=green style=bold' if ( $versions{$entry}{isaRipple} );
           $color = 'color=orange style=bold' if ( $versions{$entry}{newSuffix} );
           $color = 'color=red style=bold' if ( $versions{$entry}{DeadWood} || $versions{$entry}{badVcsTag} );
           $color = 'color=blue style=bold' if ( $versions{$entry}{Essential} );
           $color = 'color=darkmagenta style=bold' if ( $versions{$entry}{GluedIn} );
           $color = 'color=magenta style=bold' if ( $versions{$entry}{MakeTree} );

           $fill = 'style=filled fillcolor=powderblue' if ( $versions{$entry}{Essential} );
           $fill = 'style=filled fillcolor=red' if ( $versions{$entry}{Essential} && $versions{$entry}{badVcsTag} );
           $fill = 'style=filled fillcolor="#99FF99"' if ( exists $versions{$entry}{svnVersion} );

           
        push @attributes, $color if ( $color );
        push @attributes, $fill if ( $fill );

        return '[' . join( ' ', @attributes) . ']';
    }

    sub genArrowAttributes
    {
        my ($not_first, $entry) = @_;
        my @attributes;

        push @attributes, 'arrowhead=empty' if ( $not_first );
        push ( @attributes, 'label="' . $versions{$entry}{svnBranchTip} .'"' ) if ( exists $versions{$entry}{svnBranchTip} );

        return ('[' . join( ' ', @attributes) . ']') if ( @attributes ) ;
        return '';
    }

    #
    #   Flat
    #
    if ( $opt_flat )
    {
        my $last = 0;
        foreach my $entry (@flatOrder )
        {
            if ( $last )
            {
                my $me = dotTag($last);

                print FH pentry($me)  ,' -> ', pentry(dotTag($entry)), genArrowAttributes(0, $entry) ,";\n";
                print FH pentry($me)  ,genAttributes($last) . ";\n";
            }
            $last = $entry;
        }
        print FH pentry(dotTag($last))  ,genAttributes($last) . ";\n";
        
    }
    else
    {
        foreach my $entry ( sort {$a <=> $b} keys(%versions) )
        {
            my $me = dotTag($entry);
            my @versions = @{ $versions{$entry}{next}};
            my $ii = 0;
            foreach ( @versions )
            {
                print FH pentry($me)  ," -> ",pentry(dotTag($_)), genArrowAttributes($ii++, $_), ";\n";
            }

            print FH pentry($me)  ,genAttributes($entry) . ";\n";
        }
    }

    print FH "\n};\n";
    close FH;

    #
    #   Convert DOT to a SVG
    #
    unless ( $UNIX )
    {
    print "Generating graphical images\n";
#    system( "dot $filebase.dot -Tjpg -o$filebase.jpg" );  # -v
    system( "dot $filebase.dot -Tsvg -o$filebase.svg" );  # -v
#    unlink("$filebase.dot");

    #
    #   Display a list of terminal packages
    #   These are packages that are not used by any other package
    #
    print "\n";
#    print "Generated: $filebase.dot\n";
#    print "Generated: $filebase.jpg\n";
    print "Generated: $filebase.svg\n";
    }
    else
    {
        print "Generated: $filebase.dot\n";
    }
}

sub dotTag
{
    my ($entry) = @_;

    my $label = '';
    $label .= $versions{$entry}{name} if $multiPackages;
    $label .= $versions{$entry}{vname};
    $label =~ s~[-() ]~_~g;
    return $label;
}

sub dotUrl
{
    my ($entry) = @_;

    my $pv_base = $GBE_RM_URL . "/fixed_issues.asp?pv_id=$entry";
}

#-------------------------------------------------------------------------------
# Function        : pentry
#
# Description     : Generate an entry list as text
#                   Replace "." with "_" since DOT doesn't like .'s
#                   Seperate the arguments
#
# Inputs          : @_          - An array of entries to process
#
# Returns         : A string
#
sub pentry
{
    my ($data) = @_;
    $data =~ s~\.~_~g;
    $result = '"' . $data . '"' ;
    return $result;
}

#-------------------------------------------------------------------------------
# Function        : getVobMapping
#
# Description     : Read in Package to Repository Mapping
#
# Inputs          : 
#
# Returns         : Populates %VobMapping
#                             Mapping of PackageName to RepoName[/Subdir]
#
our %ScmRepoMap;
sub getVobMapping
{
    Message ("Read in Vob Mapping");

    my $fname = 'cc2svn.repo.dat';
    Error "Cannot locate $fname" unless ( -f $fname );
    require $fname;

    Error "Data in $fname is not valid\n"
        unless ( keys(%ScmRepoMap) >= 0 );

    $opt_vobMap = $ScmRepoMap{$packageNames}{repo}
        if (exists $ScmRepoMap{$packageNames});

    #
    #   Free the memory
    #
    %ScmRepoMap = ();

    #
    #   Calculate Target Repo
    #
    Warning ("No VOB Mapping found")
        unless ($opt_vobMap);
    Error("No repository specified. ie -repo=DevTools or -repo=COTS")
        unless ( $opt_repo || $opt_vobMap );

    my $r1 = ($opt_repo || '') . '/' . ($opt_vobMap || '');
    $r1 =~ s~^/~~;
    $r1 =~ s~/$~~;
    $svnRepo = $opt_repo_base . $r1;

    Verbose( "Repo URL: $svnRepo");
}


#-------------------------------------------------------------------------------
# Function        : getEssenialPackageVersions
#
# Description     : Determine the 'Essental' Package Versions
#                   Read the data in from an external file
#
# Inputs          : 
#
# Returns         : Populates @EssentialPackages
#

our %ScmReleases;
our %ScmPackages;
our %ScmSuffixes;
sub getEssenialPackageVersions
{
    Message ("Read in Essential Package Versions");

    my $fname = 'cc2svn.raw.txt';
    Error "Cannot locate $fname" unless ( -f $fname );
    require $fname;

    Error "Data in $fname is not valid\n"
        unless ( keys(%ScmReleases) >= 0 );

#    DebugDumpData("ScmReleases", \%ScmReleases );
#    DebugDumpData("ScmPackages", \%ScmPackages );
#    DebugDumpData("ScmSuffixes", \%ScmSuffixes );

    #
    #   Create a list of essential packages
    #   Retain packages-versions used in this program
    #
    foreach ( keys %ScmPackages )
    {
        next unless ( exists  $pkg_ids{ $ScmPackages{$_}{pkgid} } );
        push @EssentialPackages, $_;
        Error ("Essential Package Version not in extracted Release Manager Data: $_")
            unless ( exists $versions{$_} );
        $versions{$_}{Essential} = 1;

        # Retain which RM Release this package-version is the tip
        # Release of
        foreach my $rtag_id ( @{$ScmPackages{$_}{'release'}} )
        {
            $versions{$_}{Releases}{$rtag_id}{rname}   = $ScmReleases{$rtag_id}{name};
            $versions{$_}{Releases}{$rtag_id}{pname}   = $ScmReleases{$rtag_id}{pName};
            $versions{$_}{Releases}{$rtag_id}{proj_id} = $ScmReleases{$rtag_id}{proj_id};
        }
        
        #print "ESSENTIAL: $versions{$_}{name} $versions{$_}{vname}\n";
    }


    #
    #   Free memory
    #
    %ScmReleases = ();
    %ScmPackages = ();
    %ScmSuffixes = ();

#    DebugDumpData("Essential", \@EssentialPackages );
    Message ("Essential Versions: " . scalar @EssentialPackages );
}

#-------------------------------------------------------------------------------
# Function        : ReportPathVariance
#
# Description     : Report variance in paths used by the versions
#
# Inputs          : 
#
# Returns         : 
#
my %VobPaths;
sub ReportPathVariance
{
    Message ("Detect Multiple Paths");
    foreach my $entry ( keys(%versions) )
    {
        my $e = $versions{$entry};
        next if ( isSet ($e, 'DeadWood' ) );
        next if ( isSet ($e, 'badVcsTag') );
        next if ( isSet ($e, 'isSvn') );
        my $tag = $e->{vcsTag};
        next unless ( $tag );

        $tag =~ m~^(.+?)::(.*?)(::(.+))?$~;
        my $vcsType = $1;
        my $cc_label = $4;
        my $cc_path = $2;
        $cc_path = '/' . $cc_path;
        $cc_path =~ tr~\\/~/~s;

        $VobPaths{$cc_path}++;
    }

    @multiplePaths = sort keys %VobPaths;
    if ( scalar @multiplePaths > 1 )
    {
        Warning ("Multiple Paths:" . $_ ) foreach (@multiplePaths);
    }
}

sub isSet
{
    my ($base, $element) = @_;
    return 0 unless ( exists $base->{$element} );
    return $base->{$element};
}


#-------------------------------------------------------------------------------
# Function        : recurseList
#
# Description     : Return a list of all element below a given head element
#
# Inputs          : $head               - Head element
#
# Returns         : A list, not in any particular order
#

our @recurseList;
sub recurseList
{
    @recurseList = ();
    recurseListBody (@_);
    return @recurseList;
}
sub recurseListBody
{
    foreach my $entry ( @_ )
    {
        push @recurseList, $entry;
no warnings "recursion";
        recurseListBody (@{$versions{$entry}{next}});
    }
}

#-------------------------------------------------------------------------------
# Function        : getSvnData
#
# Description     : Read the SVN tree and see what we have
#
# Inputs          : 
#
# Returns         : 
#
my @svnDataItems;
sub getSvnData
{
    Message ("Examine Subversion Tree");

    #
    #   Re-init data
    #
    @svnDataItems = ();
    %svnData = ();
    
    #
    #   Create an SVN session
    #
    return unless ( $svnRepo );
    my $svn = NewSessionByUrl ( "$svnRepo/$packageNames" );
    return unless ( $svn );

    #
    #   extract data
    #
#    DebugDumpData("SVN", $svn );
    $svn->SvnCmd ( 'log', '-v', '--xml', '--stop-on-copy', $svn->Full()
                    , { 'credentials' => 1,
                        'process' => \&ProcessSvnLog,
                         }
                        );

    #
    #   Process data
    foreach my $entry ( @svnDataItems )
    {
        my $name;
        my $isaBranch;
        my $target = $entry->{target};
        if ( $target =~ m~/tags/(.*)~ ) {
            $name = $1;
            $svnData{tags}{$name} = 1;
        } elsif ( $target =~ m~/branches/(.*)~ )  {
            $name = $1;
    #        $branches{$1} = 1;
        } else {
            $svnData{nonTag}{$target} = 1;
        }

        my $fromBranch;
        if ( $entry->{fromPath} =~ m~/trunk$~  ) {
            $fromBranch = 'trunk';
        } elsif ( $entry->{fromPath} =~ m~/branches/(.*)~ ) {
            $fromBranch = $1;
        }

        # largest Rev number on branch
        if ( exists $svnData{max}{$fromBranch} )
        {
            if ( $svnData{max}{$fromBranch}{rev} <  $entry->{fromRev} )
            {
                $svnData{max}{$fromBranch}{rev} =  $entry->{fromRev};
                $svnData{max}{$fromBranch}{name} = $name;
            }
        }
        else
        {
            $svnData{max}{$fromBranch}{rev} =  $entry->{fromRev};
            $svnData{max}{$fromBranch}{name} = $name;
        }
    }

    foreach my $branch ( keys %{$svnData{max}} )
    {
        $svnData{tips}{$svnData{max}{$branch}{name}} = $branch;
    }
#    DebugDumpData("svnDataItems", \@svnDataItems);
#    DebugDumpData("SvnData", \%svnData);


    foreach my $entry ( keys(%versions) )
    {
        my $import_label = saneLabel($entry);
        delete $versions{$entry}{svnVersion};
        delete $versions{$entry}{svnBranchTip};

        if ( exists $svnData{tags}{$import_label} )
        {
            $versions{$entry}{svnVersion} = 1;
        }

        if ( exists $svnData{tips}{$import_label} )
        {
            $versions{$entry}{svnBranchTip} = $svnData{tips}{$import_label};
        }
    }

    Message ( 'Trunk used: ' . (exists $svnData{'max'}{trunk} ? 'Yes' : 'No') );
    Message ( 'Labels    : ' . scalar keys %{$svnData{tags}} );
    Message ( 'Branches  : ' . scalar keys %{$svnData{'max'}} );
}

#-------------------------------------------------------------------------------
# Function        : ProcessSvnLog
#
# Description     :
#                   Parse
#                       <logentry
#                          revision="24272">
#                       <author>bivey</author>
#                       <date>2005-07-25T15:45:35.000000Z</date>
#                       <paths>
#                       <path
#                          prop-mods="false"
#                          text-mods="false"
#                          kind="dir"
#                          copyfrom-path="/enqdef/branches/Stockholm"
#                          copyfrom-rev="24271"
#                          action="A">/enqdef/tags/enqdef_24.0.1.sls</path>
#                       </paths>
#                       <msg>COTS/enqdef: Tagged by Jats Svn Import</msg>
#                       </logentry>
#
# Inputs          : 
#
# Returns         : 
#
my $entryData;
sub  ProcessSvnLog
{
    my ($self, $line ) = @_;
#print "----- $line\n";
    if ( $line =~ m~^<logentry~ ) {
        $entryData = ();

    } elsif ( $line =~ m~^\s+revision="(\d+)"~ ) {
        $entryData->{Rev} = $1;

    } elsif ( $line =~ m~^\s+copyfrom-path="(.*)"~ ) {
        $entryData->{fromPath} = $1;

    } elsif ( $line =~ m~^\s+copyfrom-rev="(\d+)"~ ) {
        $entryData->{fromRev} = $1;
        
    } elsif ( $line =~ m~\s+action=.*?>(.*)</path~ ) {
        $entryData->{target} = $1;

    } elsif ( $line =~ m~</logentry~ ) {
        if ( exists $entryData->{fromPath} )
        {
#            DebugDumpData("Data", $entryData);
            push @svnDataItems, $entryData;
        }
    }

    #
    #   Return 0 to keep on going
    return 0;
}

#-------------------------------------------------------------------------------
# Function        : saveData
#
# Description     : Save essential data
#
# Inputs          : 
#
# Returns         : 
#
sub saveData
{
    my $file = $cwd . "/${packageNames}.data";

    Message ("Create: $file");
    my $fh = ConfigurationFile::New( $file );

    $fh->DumpData(
        "\n# ScmVersions.\n#\n",
        "ScmVersions", \%versions );

    #
    #   Close out the file
    #
    $fh->Close();
}


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

=pod

=for htmltoc    SYSUTIL::cc2svn::

=head1 NAME

cc2svn_gendata - CC2SVN tool to import an entire package into SVN

=head1 SYNOPSIS

  jats cc2svn_importpackage [options] package_name

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -repository=name   - Specify target repository
    -[no]flat          - Do not create project tree. Def: -noflat
    -prunemode=mode    - Mode: none, ripple, retain, severe, Def=ripple
    -retain=N          - Specify retain count for pruning. Def=2
    -[no]test          - Do not create packages. Def:-notest
    -[no]reuse         - Keep and reuse ClearCase views
    -age=nnDays        - Only keep recent package
    -dump[=n]          - Dump raw data. N=0,1,2
    -images[=n]        - Create SVG of version tree. N=0,1,2
    -name=aaa          - Alternate output package name. Test Only
    -[no]log           - Write output to log file. Def: -nolog
    -[no]postimage     - Create image after transger: Def: -post
    -workdir=path      - Use for temp storage (def:/work)
    -delete            - Delete SVN package before test

=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<-prunemode=mode>

This option control the manner in which excess versions will be pruned. Valid
modes are:

=over 8

=item   none

No pruning will be performed

=item   ripple

Non-Essential packages that are ripple builds will be removed.

=item   retain

Versions that preceed an Essential version will be retained.

=item   severe

Only Essential Versions, and Branching points will be retained.

=back

=back

=head1 DESCRIPTION

This program is a tool used in the conversion of ClearCase VOBS to subversion.
It will take a complete package and all relevent versions from ClearCase and
insert them into subversion in a sessible manner. It will attempt to retain
file change order and history.

It will:

=over 8

=item *

Read in the Essential Package Version list.

=item *

Extract, from Release Manager, all known versions of the specified package.

=item *

It will attempt to determine the type of package: COTS, TOOL, CORE, PROJECT
and alter the processing accordingly.

=item *

It will create a version dependency tree and determine 'new' project branch
points. It will remove (prune) versions that are excess to requirements.

=item *

It will extract source from ClearCase and insert it into SVN, creating
branches and tags as it goes.

=back

The program can also be used to create a SVG image of the version dependency
tree. This does not work on Linux; only Windows with 'dot' installed.

=cut