Subversion Repositories DevTools

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

# Copyright (c) VIX TECHNOLOGY (AUST) LTD

#

# Module name   : jats_lxr.pl

# Module type   : JATS Utility

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Tools to maintain LXR information

#

# Possible imporvements

#       Delete files we don't want to index

#           .DMP,.dmp,.so,.gz,.zip,.lib,.bz,.bz2,.tbz,.jar,.deb,.exe,.a,.msb

#

#       Merge ripples package versions

#           Just keep one

#

#       Cots packages

#           Use contents from dpkg_archive instead of the package

#

#       Better Version-Aging algorithm

#           Currently keep the last 5

#           Perhaps keep one from a month ago and one from 6 months ago.

#

#       Indication back into ReleaseManager of Releases that are present

#

# Usage         : See POD at the end of this file

#

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

require 5.008_002;

use strict;

use warnings;

use Pod::Usage;

use Getopt::Long;

use File::Path;

use FindBin;

use Socket;

use Fcntl ':flock';

use JatsError;

use JatsRmApi;

use DBI;

use JatsSystem;

use FileUtils;

#

#   Config Options

#

my $VERSION = "1.0.0";                      # Update this

my $opt_help = 0;

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_createVersions = 1;

my $opt_index = 1;

my $opt_purge = 1;

my $opt_extract = 1;

my $opt_logfile = 1;

my $opt_forceViews;

my $opt_config;

#

#   Globals

#

my $scriptDir;

my $RM_DB;

my $Config;

my @addressList;

my %ReleaseData;

my %Packages;

my $PackageStore;

my $ReleaseStore;

my $StampTime = time;

my $lockFile = '/tmp/JATSLXR_LOCK';

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

# Function        : Main

#

# Description     : Main entry point

#                   Parse user options

#

# Inputs          :

#

# Returns         :

#

my $result = GetOptions (

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

                "manual:3"          => \$opt_help,              # flag, multiple use allowed

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

                "createVersions!"   => \$opt_createVersions,

                "purge!"            => \$opt_purge,

                "index!"            => \$opt_index,

                "extract!"          => \$opt_extract,

                "logfile!"          => \$opt_logfile,

                "config:s"          => \$opt_config,

                "forceViews!"       => \$opt_forceViews,

                );

#

#   Process help and manual options

#

pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);

pod2usage(-verbose => 1)  if ($opt_help == 2 );

pod2usage(-verbose => 2)  if ($opt_help > 2);

#

#   Capture all logging to a file

#   Could be done by the jats wrapper, but this way we can control its location

#

ErrorConfig( 'name'    => 'LXR',

             'verbose' => $opt_verbose );

#

#   Sanity test

#

$scriptDir = $FindBin::Bin;

InitFileUtils();

#

#   Read the tool configuration

#   Sed with Default config

#

$Config->{'releaseAge'} = 0;

$Config->{'packageAge'} = 0;

$Config->{'logAge'} = 0;

$Config->{'verbose'} = 0;

readConfig();

#

#   Start logging

#

startLogFile();

Message ("Start of LXR. " . localtime(time) ) if $opt_logfile;

Message("ScriptDir: $scriptDir");

DebugDumpData("Config", \$Config) if (IsVerbose(1));

#

#   Sanity Testing

#   

Error ("No LXR Data directory defined") unless( exists $Config->{lxrFiles});

Error ("No LXR Data directory found", $Config->{lxrFiles}) unless( -d $Config->{lxrFiles});

Error ("No LXR Install directory defined") unless( exists $Config->{lxr});

Error ("No LXR Install directory found",$Config->{lxr}) unless( -d $Config->{lxr});

Error ("No Glimpse Data directory defined") unless( exists $Config->{glimpseDir});

Warning ("No Glimpse Data directory found",$Config->{glimpseDir}) unless( -d $Config->{glimpseDir});

ErrorConfig( 'verbose' => $Config->{'verbose'} );

#

#   Prevent multiple instances of the program running

#

#   PerlMonks say to use $0 as the lock file, but that did not work.

#   Perhaps the file was open in an editor

#   Solution: Create my own file

#

open( FW, '>',$lockFile);

print FW '';

close FW;

open (my $self, '<', $lockFile)    || Error("Couldn't open self: $!");

flock ($self, (LOCK_EX | LOCK_NB)) || Error("This script is already running");

#

#   Check required paths exist

#

$PackageStore = catdir($Config->{lxrFiles}, 'Packages');

$ReleaseStore = catdir($Config->{lxrFiles}, 'Releases');

mkpath($PackageStore);

mkpath($ReleaseStore);

Error ("Package Store not found ",$PackageStore) unless( -d $PackageStore);

Error ("Release Store not found ",$ReleaseStore) unless( -d $ReleaseStore);

#

#   Determine the various names for this machine

#   Include all the IP addresses too

#

my ($canonname, $aliases, $addrtype, $length, @addrs) = gethostbyname($ENV{GBE_HOSTNAME});

push @addressList, $canonname ;

push (@addressList, $aliases) if ($aliases) ;

push (@addressList, $ENV{GBE_HOSTNAME});

foreach (@addrs) {

    push @addressList, inet_ntoa($_); 

}

Message("IpAddress: @addressList");

#

#   Perform the hard work

#

getReleaseData();

updateReleaseViews() if $opt_createVersions;

cleanReleaseViews();

rebuildLxrConfig()  if $opt_index;

buildIndexes() if $opt_index;

cleanPackageStore() if $opt_purge;

cleanupLogFiles() if $opt_purge;

#

#   All done

#

unlink $lockFile;

Message ("End of LXR. " . localtime(time) ) if $opt_logfile;

exit 0;

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

# Function        : extractPackages 

#

# Description     : Extract Packages from VCS

#                   Don't extract them if they already exist

#   

#                   Kludge: Prevent extraction from MASS_Dev_Crypto Repo

#

# Inputs          : $rtagid         - Release To Process

#                                     Conatins PackageVersion data  

#

# Returns         : 

#

sub extractPackages

{

    my ($rtagid) = @_;

    foreach my $pvid (keys %{$ReleaseData{$rtagid}{data}})

    {

        my $entry = $Packages{$pvid};

        #DebugDumpData("Entry", \$entry);

        my $fullName = join('_', $entry->{name}, $entry->{ver});

        my $fullPath = catfile($PackageStore , $fullName);

        next unless defined $entry->{vcs};

        next if ( $entry->{vcs} ) =~ m~^UC::~;

        unless (-d $fullPath ) 

        {

            Message("Extracting: $entry->{name}, $entry->{ver}");

            if ($opt_extract)

            {

                Verbose("Extracting into: $fullPath");

                my $result = 'ERROR';

                if ($entry->{vcs} =~ m~/MASS_Dev_Crypto/~)

                {

                    $result = 'SUPPRESSED';

                }

                else

                {

                    my $rv = JatsCmd ('jats_vcsrelease', '-devmode=escrow', '-extractfiles', "-view=$fullName", "-label=$entry->{vcs}", "-root=$PackageStore", "-noprefix");

                    if ($rv)

                    {

                        $result = 'ERROR';

                        $entry->{bad} = 1;

                    }

                    else

                    {

                        $result = 'SUCCESS';

                    }

                }

                Message("Extraction Result: $result");

            }

        }

        else

        {

            #   Package already extracted

            #   Ensure that it does not get aged out

            deleteAgeMarker($fullPath);

        }

    }

}

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

# Function        : updateReleaseViews 

#

# Description     : 

#

# Inputs          : 

#

# Returns         : 

#

sub updateReleaseViews

{

    #

    #   Process each known Release

    #

    foreach my $rtagid (sort keys \%ReleaseData)

    {

        Verbose("updateReleaseViews: $rtagid"); 

        if ($ReleaseData{$rtagid}{release}{ACTIVE})

        {

            #

            #   Determinte last created view in this Release

            #

            my ($latestView, $latestAge) = getLatestVersion(catdir($ReleaseStore, $rtagid ));

            if ( ! defined($latestView) || $latestAge > 1 || $opt_forceViews)

            {

                #

                #   If there is no latest view, then we need to create a new view

                #   If there is a recent view, but its older than a day then we may need

                #   to refresh it.

                #

                getReleasePakageData($rtagid);

                if (checkViewDiffs($latestView,$rtagid) || $opt_forceViews)

                {

                    #

                    #   Need to create a view

                    #       Either one does not exist

                    #       Content has changed

                    #

                    createReleaseView($rtagid);

                }

                else

                {

                    #   No need to create a new view

                    #   Do need to tag it so that we don't examine it again ( for a while )

                    Message("No Changes to LXR View: $rtagid");

                    if (defined $latestView)

                    {

                        my $rv = utime $StampTime,$StampTime, $latestView; 

                        Debug("Utime $rv: $latestView");

                    }

                }

            }

            else

            {

                Message("Recent LXR View: $rtagid");

            }

        }

        else

        {

            Message("Inactive LXR View: $rtagid");

        }

    }

}

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

# Function        : checkViewDiffs 

#

# Description     : Check a view against the current package versions in the

#                   Release 

#

# Inputs          : $vdir       - View entry to process

#                   $rtagid     - RtagId

#

# Returns         : True, If we need to create a new view

#                         No view exists

#                         View does not match Release Content

#

sub checkViewDiffs

{

    my ($vdir, $rtagid) = @_;

    #   No entry to process, then we need to create a view

    return 1 if not defined $vdir;

    #

    #   Read in the View List

    #

    my %pkgsUsed;

    my $releaseListFile = catfile($vdir, '.lxrRelease');

    if (open (my $rf, '<', $releaseListFile ))

    {

        while (my $data = <$rf>)

        {

            $data =~ s~\s+$~~;

            $pkgsUsed{$data} = 2;

        }

    }

    else

    {

        Warning ("Cannot find Release List: $releaseListFile", $!);

        return 1;

    }

    #

    #   Compare the packages in the Release against those required

    #

    foreach my $pvid (keys %{$ReleaseData{$rtagid}{data}})

    {

        my $entry = $Packages{$pvid};

        my $fullName = join('_', $entry->{name}, $entry->{ver});

        $pkgsUsed{$fullName}++;

    }

    my $needNewView = 0;

    #

    #   Scan the pkgUsed

    #   A value of 1 indicates that it is used only in the New Version

    #   A value of 2 indicates that it is only used on the Last Version

    #   A value of 3 indicates that its used in both

    #   Detect those that are not a 3

    #

    foreach ( keys %pkgsUsed)

    {

        if ($pkgsUsed{$_} != 3)

        {

            $needNewView = 1;

            last;

        }

    }

    Warning("Release Contents don't match: $rtagid") if $needNewView;

    #DebugDumpData("pkgsUsed",\%pkgsUsed);

    return $needNewView;

}

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

# Function        : createReleaseView 

#

# Description     : Create a new view for a single Release

#

# Inputs          : $rtagid     - RtagId

#

# Returns         : 

#

sub createReleaseView

{

    my ($rtagid) = @_;

    my @ReleaseList;

    #

    #   Ensure that packages have been extracted

    #

    extractPackages($rtagid);

    #

    #   Create the actual view directory

    #   Its simply a bunch of symlinks back to the package store

    #

    #

    #   Create directory for the new view

    #   Based on current date. Some tools (glimpse and ctags) can't handle spaces in paths

    #

    my $dateTag = localtime($StampTime);

    $dateTag =~ s~\s+~_~g;

    Message("Creating LXR View: $rtagid, $dateTag");

    my $releaseDir = catdir($ReleaseStore, $rtagid, $dateTag);

    mkpath($releaseDir);

    if (-d $releaseDir)

    {

        foreach my $pvid (keys %{$ReleaseData{$rtagid}{data}})

        {

            my $entry = $Packages{$pvid};

            my $alias = join('', $entry->{name}, $entry->{ext});

            my $fullName = join('_', $entry->{name}, $entry->{ver});

            my $PackageStore = catdir($PackageStore , $fullName);

            my $pkgDir = catdir($releaseDir, $alias );

            push @ReleaseList, $fullName;

            next if -l $pkgDir;

            next if -d $pkgDir;

            #

            #   

            #   Glimpse will not follow symlinks - which would be nice

            #   Clone the Package using hardlinks - still saves space

            #

            Verbose("HardLink $PackageStore, $releaseDir");

            my $rv = System('--NoExit', '--NoShell', 'cp','-al', $PackageStore, $pkgDir);

            Warning("Could not duplicate $PackageStore, $releaseDir") if $rv;

#           Verbose("Symlink $PackageStore, $releaseDir");

#           my $rv = symlink ($PackageStore, $releaseDir);

#           Warning("Could not link $PackageStore, $releaseDir") unless ($rv);

        }

        #

        #   Generate a list of package-vesrions in the release

        #   Used so that we can detect changes to the release

        #

        FileCreate(catfile($releaseDir, '.lxrRelease'), \@ReleaseList);

    }

    Verbose("createReleaseView - End");

}

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

# Function        : rebuildLxrConfig 

#

# Description     : Rebuild the LXR Configuration file

#                   This MAY be a bit LXR version specific, but since LXR doesn't

#                   provide a scriptable way to update configuration

#

#                   Uses template files that have been handcrafted after taken from

#                   LXR. Basically we to a text replace and a glue together

#

#                   For each release we need

#                       Long Release Name

#                       Short Release Name

#                       List of Versions

#

#

# Inputs          : Assumes Data has been added to %ReleaseData by other subroutines

#

# Returns         : 

#

sub rebuildLxrConfig

{

    my @lxrTreeText;

    #

    #   Sort Sub

    #   Sort ReleaseData by Project and Name

    #   $a and $b are special to the sort

    #

    sub ReleaseDataSort

    {

        my $rv = lc($ReleaseData{$a}{release}{Project}) cmp lc($ReleaseData{$b}{release}{Project});

        if ($rv == 0)

        {

            $rv = lc($ReleaseData{$a}{release}{Name}) cmp lc($ReleaseData{$b}{release}{Name});

        }

        return $rv;

    }

    #

    #   Process configured releases

    #   Generate in the order we wish to display the Releases

    #

    #DebugDumpData("ReleaseData", \%ReleaseData);

    foreach my $rtagid ( sort ReleaseDataSort keys %ReleaseData )

    {

        my $entry = $ReleaseData{$rtagid};

        Information("Entry: $entry->{release}{Project}, $entry->{release}{Name}, $rtagid");

        $entry->{release}{VersionsString} = join( ',', map { '"' . $_ .'"'} @{$entry->{Versions}} );

        $entry->{release}{dbName} = genDatabaseName($rtagid);

        $entry->{release}{root} = catdir($ReleaseStore, $rtagid );

        #DebugDumpData("ENTRY", \$entry);

        my $tfileName = 'lxr.tree.template';

        open( my $tf, '<', $tfileName) || Error ("Cannot open $tfileName. $!");

        while (my $line = <$tf>)

        {

            # Chomp trailing write space

            $line =~ s~\s+$~~;

            #   Replace known bits in the template

            $line =~ s~\@CAPTION\@~$entry->{release}{Project}::$entry->{release}{Name}~g;

            $line =~ s~\@SHORT_NAME\@~$rtagid~g;

            $line =~ s~\@RELEASE_ROOT\@~$entry->{release}{root}~g;

            $line =~ s~\@VERSIONS_LIST\@~$entry->{release}{VersionsString}~g;

            $line =~ s~\@DBNAME\@~$entry->{release}{dbName}~g;

            push @lxrTreeText, $line

        }

        close $tf;

    }

    #

    #   Insert tree sections into the main config file template

    #

    my $hostList = join( ',', map { '\'http://' . $_ .'\''} @addressList );

    my $tfileName = catfile($scriptDir, 'lxr.template');

    my $lxrFileName = catfile($Config->{lxr}, 'lxr.new.conf');

    unlink $lxrFileName;

    open( my $tf, '<', $tfileName) || Error ("Cannot open $tfileName. $!");

    open( my $to, '>', $lxrFileName) || Error ("Cannot open $lxrFileName. $!");

    while (my $line = <$tf>)

    {

        # Chomp trailing write space

        $line =~ s~\s+$~~;

        #   Replace known bits in the template

        if ($line =~ m~\@TREE_SECTIONS\@~)

        {

            foreach (@lxrTreeText)

            {

                print $to $_, "\n";

            }

        }

        else

        {

            $line =~ s~\@HOSTLIST\@~$hostList~g;

            print $to $line, "\n";

        }

    }

    close $tf;

    close $to;

    #

    #   Install the new config files

    #

    my $lxrLive = catfile($Config->{lxr}, 'lxr.conf');

    my $lxrBackup = catfile($Config->{lxr}, 'lxr.conf.bak');

    unlink $lxrBackup;

    rename ($lxrLive, $lxrBackup) || Warning("Renaming $lxrLive, $lxrBackup", $!);

    rename ($lxrFileName, $lxrLive) || Warning("Renaming $lxrFileName, $lxrLive", $!);

    #

    #   Create new database tables if required

    #   Use a customized shell script to do the hard work

    #

    foreach my $rtagid ( sort keys %ReleaseData )

    {

        my $entry = $ReleaseData{$rtagid};

        Verbose("Database:$entry->{release}{Name}, $entry->{release}{dbName} ");

        System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.initdb.sh'), $entry->{release}{dbName});

    }

}

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

# Function        : buildIndexes 

#

# Description     : Build (Generate) indexes for all versions of all releases

#                   that don't have an index

#                   

#                   Place a marker file in the 'version' directory when the

#                   index has been created

#

#                   Notes:

#                   The 'genxref' program needs to be run from the lxr insatll directory

#                   chdir to that directory for each invocation

#

#                   genxref uses DBI - and must find the proper PERL DBI and not the one

#                   within JATS.. Solution:

#                       Kill the PERL5LIB EnvVar

#

#

#

# Inputs          : 

#

# Returns         : 

#

sub buildIndexes

{

    #

    #   Prep envonment for calling genxref

    #   See notes above

    #

    chdir ($Config->{lxr}) || Error ("Cannot chnage directory:$Config->{lxr}, $!");

    delete $ENV{PERL5LIB};

    #

    #   Examine each Version in each Release

    #   Generate command line like:

    #   genxref --tree RTAGID --url http://HOSTNAME/lxr --version 'VERSION'

    foreach my $rtagid ( sort keys %ReleaseData )

    {

        my $entry = $ReleaseData{$rtagid};

        foreach my $version (@{$entry->{Versions}})

        {

            my $markerFile = catfile(catdir($ReleaseStore, $rtagid ), $version, '.lxrIndexed');

            unless (-f $markerFile) {

                Message("Must index: $rtagid, $version");

                my $rv = System('--NoExit', 

                       '--NoShell', 

                       catfile($Config->{lxr}, 'genxref'),

                       '--url', 'http://' . $ENV{GBE_HOSTNAME} . '/lxr',

                       '--tree', $rtagid,

                       '--version', $version

                       );

               Verbose("genxref exit: $rv");

               unless ($rv) {

                   TouchFile($markerFile);

               }

            }

            else

            {

                Verbose("Already indexed: $rtagid, $version");

            }

        }

    }

    #

    #   Restore current directory

    #

    chdir($FileUtils::CwdFull);

}

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

# Function        : cleanReleaseViews 

#

# Description     : Clean up unused Releases and Release Views

#                   Maintain the list of retained versions

#

#                   Two classes

#                   Active - Marked as having LXR support

#                       Retain the last 5 Versions

#

#                  InActive - Not having LXR support

#                       Retain for 10 days then delete all versions

#

# Inputs          : 

#

# Returns         : 

#

sub cleanReleaseViews

{

    #

    #   Scan Releases and delete all that are not currently configured

    #

    opendir (my $rdir, $ReleaseStore) || Error ("Cannot open directory: $ReleaseStore", $!);

    while (my $rdirEntry = readdir($rdir))

    {

        #   Skip hidden files and directories

        next if ($rdirEntry =~ m~^\.~);

        my $vdirName = catdir($ReleaseStore, $rdirEntry );

        next unless ( -d $vdirName );

        unless(exists $ReleaseData{$rdirEntry} && $ReleaseData{$rdirEntry}{release}{ACTIVE} )

        {

            #   Release is no longer configured - age it out

            #   Assume $rdirEntry is an rtag_id

            if (processAgeMarker($vdirName, $Config->{'releaseAge'} ))

            {

                Message("Delete Release: $rdirEntry");

                RmDirTree($vdirName);

                System('--NoExit', '--NoShell', catfile($scriptDir, 'lxr.dropdb.sh'), genDatabaseName($rdirEntry));

                if ( defined $Config->{glimpseDir} )

                {

                    my $glimpseData = catdir( $Config->{glimpseDir}, $rdirEntry );

                    RmDirTree($glimpseData);

                }

            }

        }

        else

        {

            deleteAgeMarker($vdirName);

            #   Release is configured

            #   Keep the last x created

            #   Note: Create time is a kludge

            #

            #   Process each version within the Release

            #

            my @versionData;

            opendir (my $vdir, $vdirName) || Warning ("Cannot open directory: $vdirName", $!);

            while (my $vdirEntry = readdir($vdir))

            {

                #   Skip hidden files and directories

                next if ($vdirEntry =~ m~^\.~);

                my $ldirName = catdir($vdirName, $vdirEntry );

                next unless ( -d $ldirName );

                my $data;

                $data->{name} = $vdirEntry; 

                $data->{path} = $ldirName; 

                $data->{ctime} = (stat $ldirName)[9];

                push @versionData  , $data;

            }

            close ($vdir);

            #DebugDumpData("versionData",\@versionData);

            my $keepCount = 0;

            foreach my $entry ( sort { $b->{ctime} <=> $a->{ctime}} @versionData )

            {

                #DebugDumpData("Entry", $entry);

                $keepCount++;

                if ($keepCount > 5)

                {

                    #   Version is no longer needed - remove it

                    Message("Delete Version: $rdirEntry, $entry->{name}, $entry->{ctime}");

                    RmDirTree($entry->{path});

                }

                else

                {

                    #   Note which versions we have

                    push @{$ReleaseData{$rdirEntry}{Versions}}, $entry->{name};

                }

            }

        }

    }

    close ($rdir);

}

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

# Function        : getLatestVersion 

#

# Description     : For a specified directory return the newest subdir

#

#                   Used to determine the most recent version

#

# Inputs          : $vdirName - Dir to process - expecting a Release directory

#

# Returns         : latestName  - Patch to the latest directory

#                   Age (days ) - Of the named directory

#

sub getLatestVersion

{

    my  ($vdirName) = @_;

    my $latestName;

    my $latestAge = 0;

    if (-d $vdirName )

    {

        opendir (my $vdir, $vdirName) || Warning ("Cannot open directory: $vdirName", $!);

        while (my $vdirEntry = readdir($vdir))

        {

            #   Skip hidden files and directories

            next if ($vdirEntry =~ m~^\.~);

            my $ldirName = catdir($vdirName, $vdirEntry );

            next unless ( -d $ldirName );

            my $age = (stat $ldirName)[9];

            Verbose3("Age: $ldirName, $age");

            if  ($age > $latestAge )

            {

                $latestAge = $age;

                $latestName = $ldirName;

            }

        }

        close ($vdir);

        #   Convert to Days ago

        $latestAge = ($StampTime - $latestAge) / (60*60*24);

        #DebugDumpData("versionDataSorted",\@versionDataSorted);

        Verbose("Latest: $latestName, $latestAge");

    }

    else

    {

        Verbose("Latest: No directory found: $vdirName");

    }

    return $latestName, $latestAge;

}

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

# Function        : cleanPackageStore 

#

# Description     : Delete unused Packages from the package store

#                   Each View in each Release will have a .lxrRelease file that contains the

#                   package versions that the view needs.

#

# Inputs          : 

#

# Returns         : 

#

sub cleanPackageStore

{

    Verbose ("cleanPackageStore");

    my %pkgsUsed;

    #

    #   Examime ALL versions in ALL Releases and build up a hash of

    #   Package Versions used

    #

    opendir (my $rdir, $ReleaseStore) || Error ("Cannot open directory: $ReleaseStore", $!);

    while (my $rdirEntry = readdir($rdir))

    {

        #   Skip hidden files and directories

        next if ($rdirEntry =~ m~^\.~);

        my $vdirName = catdir($ReleaseStore, $rdirEntry );

        next unless ( -d $vdirName );

        #

        #   Process each version within the Release

        #

        opendir (my $vdir, $vdirName) || Warning ("Cannot open directory: $vdirName", $!);

        while (my $vdirEntry = readdir($vdir))

        {

            #   Skip hidden files and directories

            next if ($vdirEntry =~ m~^\.~);

            my $ldirName = catdir($vdirName, $vdirEntry );

            next unless ( -d $ldirName );

            #

            #   Read in the View List

            #

            my $releaseListFile = catfile($ldirName, '.lxrRelease');

            if (open (my $rf, '<', $releaseListFile ))

            {

                Verbose2("Found ", $releaseListFile);

                while (my $data = <$rf>)

                {

                    $data =~ s~\s+$~~;

                    $pkgsUsed{$data}++;

                }

            }

            else

            {

                Warning ("Cannot find Release List: $releaseListFile", $!);

            }

        }

        close ($vdir);

    }

    close ($rdir);

    #

    #   Process the Packages directory and remove those not currently used

    #

    #

    #   Process each entry within the Version

    #

    opendir (my $pdir, $PackageStore) || Error ("Cannot open directory: $PackageStore", $!);

    while (my $pdirEntry = readdir($pdir))

    {

        #   Skip hidden files and directories

        next if ($pdirEntry =~ m~^\.~);

        my $pdirName = catdir($PackageStore, $pdirEntry );

        next unless ( -d $pdirName );

        next if (exists $pkgsUsed{$pdirEntry} );

        if (processAgeMarker($pdirName, $Config->{packageAge})) 

        {

            Message("Purge Package: $pdirEntry");

            RmDirTree($pdirName);

        }

    }

    close ($pdir);

    #DebugDumpData("pkgsUsed", \%pkgsUsed);

}

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

# Function        : getReleaseData 

#

# Description     : Get all the required Release Data 

#

# Inputs          :  

#

# Returns         : 

#

sub getReleaseData

{

    my ($rtagid) = @_;

    my (@row);

    my @releaseList;

    my $partSql = '';

    Verbose("getReleaseData");

    connectRM(\$RM_DB) unless $RM_DB;

    #

    #   Determine list of existing Releases

    #   Build up a Clause for the extraction SQL

    #   This is used to get data for Releases that exist in the Store but may have been

    #   deconfigured.

    #

    if ( opendir (my $rdir, $ReleaseStore) )

    {

        while (my $rdirEntry = readdir($rdir))

        {

            #   Skip hidden files and directories

            next if ($rdirEntry =~ m~^\.~);

            my $vdirName = catdir($ReleaseStore, $rdirEntry );

            next unless ( -d $vdirName );

            push @releaseList, $rdirEntry;

        }

        close $rdir;

    }

    if (@releaseList)

    {

        $partSql = ' OR rt.rtag_id in (' . join(',', @releaseList ) . ')' 

    }

    #

    # Determine which Releases need LXR support

    #

    my $m_sqlstr = 

        "SELECT rtag_id, " .

        "  rt.proj_id, " .

        "  p.PROJ_NAME, " .

        "  rtag_name, " .

        "  official, " .

        "  NVL(TRUNC (SYSDATE - rt.official_stamp),0) AS OFFICIAL_STAMP_DAYS, " .

        "  rt.lxr " .

        "FROM release_tags rt, " .

        "  projects p " .

        "WHERE ( rt.lxr  = 'Y'" . $partSql . ")" .

        " AND p.PROJ_ID = rt.proj_id ";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

                    my $rtagid = $row[0];