Subversion Repositories DevTools

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

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

    }