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

#       Merge ripples package versions

#           Just keep one

#           At the moment, simply ignore ripples in release comparisons.

#

#       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'} = $opt_verbose;

$Config->{GBE_RM_LOCATION} = $ENV{GBE_RM_LOCATION};

$Config->{GBE_RM_USERNAME} = $ENV{GBE_RM_USERNAME};

$Config->{GBE_RM_PASSWORD} = $ENV{GBE_RM_PASSWORD};

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

#

#   Use local Database config - if provided

#

$ENV{GBE_RM_LOCATION} = $Config->{GBE_RM_LOCATION};

$ENV{GBE_RM_USERNAME} = $Config->{GBE_RM_USERNAME};

$ENV{GBE_RM_PASSWORD} = $Config->{GBE_RM_PASSWORD};

#

#   Perform the hard work

#

getReleaseData();

updateReleaseViews() if $opt_createVersions;

cleanReleaseViews();

rebuildLxrConfig()  if $opt_index;

buildIndexes() if $opt_index;

updateReleaseManager();

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

#                   Cleanup non-indexable files

#   

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

                #

                #   Clean up the extracted views

                #   Use lxr_clean_dir.sh

                #

                if (-d $fullPath)

                {

                    Verbose("Running lxr_clean_dir.sh");

                    System('--NoExit', '--NoShell', catfile($scriptDir,'lxr_clean_dir.sh') , $fullPath);

                }

            }

        }

        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 package versions in the current Release. 

#                   Ignore ripple built packages as these only have dependent changes

#

# 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+$~~;

            $data = baseVersionNumber ($data );

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

        $fullName = baseVersionNumber ($fullName );

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

        $entry->{release}{LXRSTATE} = 'D' unless (exists $entry->{release}{LXRSTATE});

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

        next if ($entry->{release}{LXRSTATE} eq 'D');

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

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

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

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

        my $stateTxt = $entry->{release}{ACTIVE} ? 'Active' : 'InActive';

        #$stateTxt .= ' [' . $entry->{release}{ACTIVE} . ']';

        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;

            $line =~ s~\@STATE\@~$stateTxt~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};

        next if ($entry->{release}{LXRSTATE} eq 'D');

        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 install 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

               {

                   Warning("Error indexing $rtagid ($rv)");

               }

            }

            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

            $ReleaseData{$rdirEntry}{release}{LXRSTATE} = 'C';

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

            {

                $ReleaseData{$rdirEntry}{release}{LXRSTATE} = 'D';

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

                    Message("Delete Glimpse Subdir: $glimpseData");

                    RmDirTree($glimpseData);

                }

            }

            else

            {

                #

                #   Build up the list of known versions

                #

                foreach my $entry ( getReleaseVersions($vdirName) )

                {

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

                }

            }

        }

        else

        {

            $ReleaseData{$rdirEntry}{release}{LXRSTATE} = 'I';

            deleteAgeMarker($vdirName);

            #   Release is configured

            #   Keep the last x created

            #   Note: Create time is a kludge

            #

            #   Process each version within the Release

            #

            my $keepCount = 0;

            foreach my $entry ( getReleaseVersions($vdirName) )

            {

                #DebugDumpData("$rdirEntry, getReleaseVersions:Entry", $entry);

                $keepCount++;

                if ($keepCount > 5)

                {

                    #   Version is no longer needed - remove it

                    #   Remove glimpse data too

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

                    RmDirTree($entry->{path});

                    if ( defined $Config->{glimpseDir} )

                    {

                        my $glimpseEntry = catdir( $Config->{glimpseDir}, $rdirEntry, $entry->{name} );

                        Message("Delete Glimpse Data: $glimpseEntry");

                        RmDirTree($glimpseEntry);

                        Warning("Glimpse Data Dir still present: $glimpseEntry") if ( -d $glimpseEntry);

                    }

                }

                else

                {

                    #   Note which versions we have

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

                }

            }

        }

    }

    close ($rdir);

}

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

# Function        : getReleaseVersions 

#

# Description     : Get the Versions in a Release

#

# Inputs          : $vdirName         - Path to process

#

# Returns         : A sorted array of data items (Most recent first)

#                   Each items consists of:

#                       {name}

#                       {path}

#                       {ctime}    

#

sub getReleaseVersions

{

    my ($vdirName) = @_;

    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 @sortedList = sort { $b->{ctime} <=> $a->{ctime}} @versionData;

    #DebugDumpData("SortedVersionData",\@sortedList);

    return @sortedList;

}

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

# 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~^\.~);