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   : Tiools to maintain LXR information

#

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

#

#   Globals

#

my $scriptDir;

my $RM_DB;

our $config;

my @addressList;

my %ReleaseData;

my %Packages;

my $PackageStore;

my $ReleaseStore;

my $stamptime = time;

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

# 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,

                );

#

#   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

#

readConfig();

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

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

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

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

#

#   Start logging

#

startLogFile();

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

Message("ScriptDir: $scriptDir");

#

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

determineDataToExtract();

createReleaseViews() if $opt_createVersions;

cleanReleaseViews();

rebuildLxrConfig();

buildIndexes() if $opt_index;

cleanPackageStore() if $opt_purge;

cleanupLogFiles() if $opt_purge;

#

#   All done

#

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

exit 0;

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

# Function        : determineDataToExtract 

#

# Description     : Determine the packages that need to be extracted

#                   Don't extract them if they already exist

#

# Inputs          : 

#

# Returns         : 

#

sub determineDataToExtract

{

    foreach my $pvid ( keys{%Packages})

    {

        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("Need to extract: $entry->{name}, $entry->{ver}");

            if ($opt_extract)

            {

                Verbose0("Extracting into: $fullPath");

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

                print "$fullName : SUCCESS\n" unless $rv;

                print "$fullName : ERROR\n" if $rv;

                $entry->{bad} = 1;

            }

        }

    }

}

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

# Function        : createReleaseViews 

#

# Description     : Create a new view for each Release

#                   Each view is basically a bunch of symlinks

#

# Inputs          : 

#

# Returns         : 

#

sub createReleaseViews

{

    #

    #   Create a name for the releases - based on a date-time

    #   Will be unqiue(ish)

    #

    my $dateTag = localtime($stamptime);

    foreach my $rtagid (keys \%ReleaseData)

    {

        my $entry = $ReleaseData{$rtagid};

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

        my  $needNewView = 1;

        #

        #   Check to see if we really need to create a new view

        #   If the LATEST view contins all the package-versions that we need then

        #   don't create a new one.

        #

        #   Scan each entry within the Last View

        #

        if ($latestView)

        {

            my %pkgsUsed;

            opendir (my $ldir, $latestView) || Warning ("Cannot open directory: $latestView", $!);

            while (my $ldirEntry = readdir($ldir))

            {

                #   Skip hidden files

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

                my $dirName = catdir($latestView, $ldirEntry );

                #

                #   Process each entry within the Version

                #

                my $pkgName = $ldirEntry;

                if (-l $dirName)

                {

                    $pkgName = readlink($dirName);

                    $pkgName =~ s~.*/~~;

                }

                $pkgsUsed{$pkgName} = 2;

            }

            close ($ldir);

            #

            #   Compare Package-Versions against those we need

            # 

            foreach my $pvid (keys $entry->{data})

            {

                my $entry = $Packages{$pvid};

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

                $pkgsUsed{$fullName}++;

            }

            #

            #   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

            #

            $needNewView = 0;

            foreach ( keys %pkgsUsed)

            {

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

                {

                    $needNewView = 1;

                    last;

                }

            }

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

        }

        unless ($needNewView)

        {

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

        }

        else

        {

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

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

            mkpath($releaseDir);

            if (-d $releaseDir)

            {

                #

                #   Insert metadata

                #   Used to allow ordering and aging of the releases

                #    

                my $metaDataName = catfile( $releaseDir, '.jatslxr');

                open (my $md, '>' , $metaDataName) || Error ("Cannot create $metaDataName, $!");

                print $md $stamptime;

                close $md;

                #

                #   Populate with symlinks to the actual package-versions

                #

                foreach my $pvid (keys $entry->{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 $releaseDir = catdir($releaseDir, $alias );

                    next if -l $releaseDir;

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

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

                    unless ($rv)

                    {

                        Warning("Could not link $PackageStore, $releaseDir")

                    }

                }

            }

        }

    }

}

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

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

    #

    #   Process configured releases

    #

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

    foreach my $rtagid ( keys %ReleaseData )

    {

        my $entry = $ReleaseData{$rtagid};

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

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

        $entry->{release}{dbName} = genDatabaseName($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 ( keys %ReleaseData )

    {

        my $entry = $ReleaseData{$rtagid};

        Information("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 ( keys %ReleaseData )

    {

        my $entry = $ReleaseData{$rtagid};

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

        {

            my $markerFile = catfile($entry->{release}{root}, $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}{LXR} )

        {

            #   Release is no longer configured - remove it

            #   Assume $rdirEntry is an rtag_id

            Message("Delete Release: $rdirEntry");

            RmDirTree($vdirName);

            my $entry = $ReleaseData{$rdirEntry};

            #DebugDumpData("ReleaseData:",$entry);

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

        }

        else

        {

            $ReleaseData{$rdirEntry}{release}{root} = $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          : Dir to process - expecting a Release directory

#

# Returns         : 

#

sub getLatestVersion

{

    my  ($vdirName) = @_;

    my $latestName;

    my $latestAge = 0;

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

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

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

    return $latestName;

}

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

# Function        : cleanPackageStore 

#

# Description     : Delete unused PAckages fromthe package store

#

# Inputs          : 

#

# Returns         : 

#

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

            #

            #   Process each entry within the Version

            #

            opendir (my $ldir, $ldirName) || Warning ("Cannot open directory: $ldirName", $!);

            while (my $ldirEntry = readdir($ldir))

            {

                #   Skip hidden files and directories (also borken symlinks )

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

                my $dirName = catdir($ldirName, $ldirEntry );

                next unless ( -d $dirName );

                #

                #   Process each entry within the Version

                #

                my $pkgName = $ldirEntry;

                if (-l $dirName)

                {

                    $pkgName = readlink($dirName);

                    $pkgName =~ s~.*/~~;

                }

                $pkgsUsed{$pkgName}++;

            }

            close ($ldir);

        }

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

        Message("Cleanup: $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);

    Information("getReleaseData");

    connectRM(\$RM_DB) unless $RM_DB;

    #

    # 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 " .

        "FROM release_tags rt, " .

        "  projects p " .

        "WHERE rt.lxr  = 'Y' " .

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

                    my $data;

                    $data->{Project} = $row[2];

                    $data->{Name} = $row[3];

                    $data->{official} = substr($row[4],0,1);

                    $data->{official_stamp_days} = $row[5];

                    #

                    #   Determine if this request for an LXR release is OK

                    #   Ok If the release is Open, CCB or Restricted

                    #   Ok if closed and has been closed to < 10 days

                    #

                    if (index('NRC', $data->{official}) >= 0)

                    {

                        $data->{LXR} = 1;

                    }

                    elsif ($data->{official} eq 'Y' && $data->{official_stamp_days} < 10)

                    {

                        $data->{LXR} = 2;

                    }

                    $ReleaseData{$rtagid}{release} = $data;

                }

            }

            $sth->finish();

        }

    }

    else

    {

        Error("getReleaseData:Prepare failure" );

    }

    DebugDumpData("ReleaseData", \%ReleaseData);

    foreach my $rtagid ( keys %ReleaseData)

    {

        next unless $ReleaseData{$rtagid}{release}{LXR};

        Information("Entry: RtagId $rtagid");

        getOneRelease($rtagid);

    }

}

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

# Function        : getOneRelease

#

# Description     : Get data for one Release

#

# Inputs          : rtagid

#

# Returns         : 

#

sub getOneRelease

{

    my ($rtagid) = @_;

    my (@row);

    connectRM(\$RM_DB) unless $RM_DB;

    # Get details for each package in the Release

    #   Don't worry about dependent packages

    #

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.V_EXT, release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID)".

                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .

                   " WHERE rc.RTAG_ID = $rtagid AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";

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

    if ( defined($sth) )

    {

        if ( $sth->execute( ) )

        {

            if ( $sth->rows )

            {

                while ( @row = $sth->fetchrow_array )

                {

                    my $data;

                    my $pvid = $row[0];

                    unless (exists $Packages{$pvid}) {

                        $data->{pv_id} = $row[0];

                        $data->{name} = $row[1];

                        $data->{ver} = $row[2];

                        $data->{ext} = $row[3] || '';

                        $data->{vcs} = $row[4] || '';

                        $Packages{$pvid} = $data;

                    }

                    my $rdata;

                    $rdata->{required} = 1;

                    $ReleaseData{$rtagid}{data}{$pvid} = $rdata;

                }

            }

            $sth->finish();

        }

    }

    else

    {

        Error("getOneRelease:Prepare failure" );

    }

}

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

# Function        : genDatabaseName 

#

# Description     : Genertate the name of a database

#

# Inputs          : rtag_id 

#

# Returns         : Text Name of the database

#

sub genDatabaseName

{

    my ($rtag_id) = @_;

    return 'LXR_' . $rtag_id;

}

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

# Function        : readConfig 

#

# Description     : Read the basic LXR config

#                   This is held in a Perl structure 

#

# Inputs          : None 

#

# Returns         : Populate Global Data

#

sub readConfig

{

    my $cfile = catfile($scriptDir,'jats_lxr.conf');

    Error ("Expected config file not found: $cfile") unless ( -f $cfile );

    require $cfile;

#   #

#   #   Create data

#   #

#   my %hash = (

#   number => 42,

#   string => 'This is a string',

#   array  => [ 1 .. 10 ],

#   hash   => { apple => 'red', banana => 'yellow' },

#   );

#

#   # Print structure to file

#   open (my $out, '>', $cfile) || Error("Can't create $cfile. $!");

#   DebugDumpData("Hash", \%hash);

#   print {$out} Data::Dumper->Dump([\%hash], ['$config']);

#   close $out;

    #DebugDumpData("config", \$config);

}

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

# Function        : startLogFile 

#

# Description     : Start logging to a log file

#                   Generate a nice name for the log file

#

# Inputs          : 

#

# Returns         : 

#

sub startLogFile

{

    if ( $opt_logfile )

    {

        if (exists $config->{lxrLogDir})

        {

            my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($stamptime);

            my $name = sprintf("jats-lxr-%4.4d%2.2d%2.2d.%2.2d%2.2d%2.2d.log", 1900+$year, 1+$mon, $mday, $hour, $min, $sec);

            $name = catdir($config->{lxrLogDir}, $name);

            mkpath($config->{lxrLogDir}); 

            if (-d $config->{lxrLogDir} )

            {

                open STDOUT, '>', $name  or die "Can't redirect STDOUT: $!";

                open STDERR, ">&STDOUT"  or die "Can't dup STDOUT: $!";

            }

            else

            {

                Warning("Can't create log dir: $config->{lxrLogDir}. $!");

            }

        }

    }

}

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

# Function        : cleanupLogFiles 

#

# Description     : Remove old log files

#

# Inputs          : 

#

# Returns         : 

#

sub cleanupLogFiles

{

    if (exists $config->{lxrLogDir} && exists $config->{logAge}  && $config->{logAge} > 0 )

    {

        Verbose("cleanupLogFiles:$config->{lxrLogDir}, $config->{logAge}");

        if ( opendir my $logDir, $config->{lxrLogDir} )

        {

            foreach my $fileName (readdir $logDir)

            {

                my $file = catfile($config->{lxrLogDir}, $fileName);

                next unless -f $file;

                next unless -M $file > $config->{logAge};

                Verbose("Purge logfile: $fileName");

                unlink $file;

            }

            closedir $logDir;

        }

    }

}

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

#   Documentation

#

=pod

=head1 NAME

jats_lxr - Maintain LXR Releases

=head1 SYNOPSIS

  jats jats_lxr [options]

 Options:

    -help               - brief help message

    -help -help         - Detailed help message

    -man                - Full documentation

    -[no]createVersions - Create new versions. Default:Create

    -[no]extract        - Extract source code. Default:Extract

    -[no]index          - Index new LXR versions. Default:Index

    -[no]purge          - Purge unused packages. Default:Purge

    -[no]logfile        - Capture out to a log file. Default:Log

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>