########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : cache_dpkg
# Module type   : JATS Utility
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description:
#       Maintain a local cache of dpkg_archive
#
# Notes:
#       Stopped using the JATS "cp.exe" utility as there was a weird problem under
#       windows. The package orahops-ssw-install/1.0.1000.ssw could not be installed
#       correctly. It appears that the 'cp' could not process the subdir pair
#       "DBMGR/DBMGR". Change the name it was OK.
#
#       Solution: Avoid system functions
#
#......................................................................#

use strict;
use warnings;
use JatsError;
use FileUtils;
use File::Find;
use File::Path;
use File::Copy;

use Getopt::Long;
use Pod::Usage;                             # required for help support

my $VERSION = "1.5.0";


#
#   Options
#
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
my $opt_help = 0;
my $opt_clear;
my $opt_flush;
my $opt_refresh;
my $opt_refresh_all;
my $opt_list;
my $opt_list_short;
my $opt_export;
my $opt_quiet;
my $opt_update_all;
my $opt_age;
my $opt_test;
my $opt_wait = 0;
my $opt_cache = 1;

#
#   Global Variables
#
my $GBE_DPKG            = $ENV{'GBE_DPKG'};                     # The Master repository
my $GBE_DPKG_CACHE      = $ENV{'GBE_DPKG_CACHE'} || "";         # Caches
my $GBE_DPKG_LOCAL      = $ENV{'GBE_DPKG_LOCAL'} || "";         # Local scratch
my $GBE_DPKG_STORE      = $ENV{'GBE_DPKG_STORE'} || "";         # Global Store
my $GBE_DPKG_REPLICA    = $ENV{'GBE_DPKG_REPLICA'} || "";       # Site Local Replica
my $GBE_DPKG_ESCROW     = $ENV{'GBE_DPKG_ESCROW'} || "";        # Escrow Store
my $GBE_BIN             = $ENV{'GBE_BIN'};

my $istore;
my $estore;
my $gstore;
my $archive;
my $cache;
my $parchive;
my $local = '';
my $local_pkg;
my @package_list;
my @refresh_list;

#
#   Globals for recursive copy
#
my $copyFind_dst;
my $copyFind_src;
my $copyFind_src_len;
my $copyFind_touch;
my $copyFind_time;
my @copyFindDups;

#
#   Globals for error recovery
#
my  $remove_on_error;
my  $cacheMarker;

#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
my $result = GetOptions (
                "help|h:+"                  => \$opt_help,
                "manual:3"                  => \$opt_help,
                "verbose:+"                 => \$opt_verbose,           # flag, multiple use allowed
                "debug:+"                   => \$opt_debug,             # flag, multiple use allowed
                "flush"                     => \$opt_flush,             # flag
                "clear"                     => \$opt_clear,             # flag
                "wait!"                     => \$opt_wait,              # [no]flag
                "cache!"                    => \$opt_cache,             # [no]flag
                "refresh!"                  => \$opt_refresh,           # [no]flag
                "refresh_all|refresh-all"   => \$opt_refresh_all,       # flag
                "update_all|update-all"     => \$opt_update_all,        # flag
                "list"                      => \$opt_list,              # flag
                "dir"                       => \$opt_list_short,        # flag
                "export"                    => \$opt_export,            # flag
                "quiet"                     => \$opt_quiet,             # flag
                "age=i"                     => \$opt_age,               # integer
                "test"                      => \$opt_test,              # flag
                );

                #
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                #

#
#   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);

#
#   Configure the error reporting process now that we have the user options
#
ErrorConfig( 'name'    =>'CACHE',
             'verbose' => $opt_verbose,
             'debug'   => $opt_debug );

#
#   Validate user options
#
Error( "GBE_BIN not defined in the environment" ) unless ( defined($GBE_BIN) );
Error( "GBE_DPKG not defined in the environment" ) unless ( defined($GBE_DPKG) );

$opt_refresh = 1
    if ( $opt_refresh_all );

#
#   Locate the various package stores
#   Search order for package should be:
#       DPKG_SANDBOX (Not cached)
#       DPKG_LOCAL   (To be deprecated)
#       DPKG_CACHE
#       DPKG_ESCROW
#       DPKG_REPLICA
#       DPKG         (Writable to build system)
#       DPKG_STORE
#
$local = $GBE_DPKG_LOCAL;
$cache = $GBE_DPKG_CACHE;
$estore = $GBE_DPKG_ESCROW;
$istore = $GBE_DPKG_REPLICA;
$archive = $GBE_DPKG;
$gstore = $GBE_DPKG_STORE;

Error ("dpkg_archive cache is the main archive")    if ( $cache eq $archive );
Error ("dpkg_archive replica is the main archive")  if ( $istore && $istore eq $archive );
Error ("main archive is local archive" )            if ( $local && $local eq $archive );
Warning  ("dpkg_archive_cache is local_archive" )   if ( $cache && $local && $local eq $cache );

#
#   Perform package/version replication wait
#   
#   Do not need a cache for this to be performed as the operation is used on build servers
#   that do not have a cache (most Unix build machines)
#   
#   Cannot wait if we don't have a REPLICA
#   
if ($opt_wait && $istore)
{
    Verbose("Wait for package replication");
    #
    #   Scan the argument list
    #   Only wait for package/version. Cannot wait on an entire package
    #
    foreach (@ARGV)
    {
        unless (m~.+/.+~)
        {
            Verbose("Wait Skip $_");
            next;
        }

        if (-d "$istore/$_")
        {
            Verbose("Wait not required. Version in replica: $_");
            next;
        }

        unless (-d "$archive/$_")
        {
            Verbose("Wait not required. Version not in store: $_");
            next;
        }

        #
        #   Wait for the package to be replicated
        #       Wait up to 10 minutes
        #       Or the package to appear in the replica
        #       Or the package to disappear from the main store
        #
        Verbose("Waiting for replication of: $_");
        my $waitStart = time();
        while (1)
        {
            sleep(30);
            my $delta = time() - $waitStart;
            if (-d "$istore/$_")
            {
                Message("PkgReplication. Package replicated ($delta): $_");
                last;
            }
            unless (-d "$archive/$_")
            {
                Message("PkgReplication. Package deleted from main archive: $_");
                last;
            }
            #
            #   Done wait forever
            #   If the package has not been replicate we will just have to copy it the slow way
            #   
            if ( $delta >= 600)
            {
                Message("PkgReplication. Package not replicated: $_");
                last;
            }
        }
    }
}

#
#   Allow replication update without also caching the package
#       This is used to prevent ALL replicated packages beinng cached.
#       Packages do not need to be cached if they are not used by a build on the current machine
#       This will prevent the cache from filling up with unused packages.
#
unless ($opt_cache)
{
    Message("Packages not cached");
    exit 0;
}

#
#   No cache - nothing to do
#   Generate a status message and exit
#
unless ( $cache )
{
    Warning ( "GBE_DPKG_CACHE not defined in the environment" );
    exit 0;
}

#
#   Export the list of cache entries
#
if ( $opt_export or $opt_refresh_all or $opt_list_short or $opt_update_all )
{
    opendir (DIR, $cache) || die "Cannot open $cache\n";
    my @dir_list = readdir(DIR);
    closedir DIR;

    for my $fn ( @dir_list)
    {
        my $count = 0;
        next if ( $fn =~ m/^\./ );
        next unless ( -d "$cache/$fn" );

        opendir( DIR, "$cache/$fn" ) || die "Cannot open $cache/$fn\n";
        while ( my $fn1 = readdir(DIR) )
        {
            next if ( $fn1 =~ m/^\./ );
            push @package_list, "$fn/$fn1";
        }
        closedir DIR;
    }

    if ( $opt_refresh_all or $opt_update_all )
    {
        @refresh_list = @package_list
    }

    #
    #   Simply export a list of packages in the cache
    #   Used by other programs
    #
    if ( $opt_export )
    {
        print join ' ', @package_list;
        exit 0;
    }
}

#
#   Display cache information
#   This is done AFTER the export - since the export command does not
#   need this header.
if ( $opt_verbose || $#ARGV < 0 )
{
    print  "dpkg_store          : $gstore\n" if ($gstore);
    print  "dpkg_escrow         : $estore\n" if ($estore);
    print  "dpkg_archive        : $archive\n";
    print  "dpkg_archive replica: $istore\n";
    print  "dpkg_archive cache  : $cache\n";
    print  "dpkg_archive local  : $local\n";
    Verbose ("args:               @ARGV");
}

#
#   List the contents of the cache
#
if ( $opt_list_short )
{
    print join "\n", @package_list;
}

if ( $opt_list )
{
    #
    #   Process user commands
    #   List: A nice pretty display of the cache
    #
    opendir (DIR, $cache) || die "Cannot open $cache\n";
    my @dir_list = readdir(DIR);
    closedir DIR;

    #
    #   Determine max length of a name so that the display is nicely aligned
    #
    my $nl = 10;
    for my $fn ( @dir_list)
    {
        my $ns = length($fn);
        $nl = $ns if ( $ns > $nl )
    }

    #
    #   Display information by package
    #   A nicely formatted list with line wrapping
    #
    for my $fn ( @dir_list)
    {
        my $count = 0;
        next if ( $fn =~ m/^\./ );
        next unless ( -d "$cache/$fn" );

        opendir( DIR, "$cache/$fn" ) || die "Cannot open $cache/$fn\n";
        printf "%-*s :", $nl, $fn;
        while ( my $fn1 = readdir(DIR) )
        {
            next if ( $fn1 =~ m/^\./ );
            if ( $count++ >= 4 )
            {
                $count = 1;
                printf "\n%*s  ", $nl, "";
            }
            printf " %14.14s", $fn1;
        }
        closedir DIR;
        print "\n";
    }
}

#
#   Clear the cache
#
if ( $opt_clear )
{
    Warning   ( "Deleting the ENTIRE cache");
    rmtree( $cache, $opt_debug );
    mkpath( $cache, $opt_debug, 0777);
}

#
#   Perform cache aging
#
if ( $opt_age )
{
    Error ("Age parameter cannot be negative") if ( $opt_age < 0 );
    age_the_cache();
}

#
#   Process the command line arguments
#   These MUST be of the form
#       packagename
#       packagename/version
#
for (@ARGV, @refresh_list)
{
    $remove_on_error = undef;
    $cacheMarker = undef;

    if ( $opt_flush )
    {
        unless ( -d "$cache/$_" )
        {
            Warning ("Package not in cache: $_")
                unless ( $opt_quiet );
        }
        else
        {
            rmtree( "$cache/$_", $opt_debug );
            print "Package removed: $_\n"
                unless ( $opt_quiet );
        }
    }
    else
    {
        #
        #   Speed up - for remote access
        #   If the package is found in the local archive and we aren't doing
        #   anything fancy then don't access the remote archive
        #
        my $local_pkg = ( -d "$local/$_" || -f "$local/$_.lnk" );
        if ( $local_pkg )
        {
            if ( !$opt_refresh )
            {
                print "Cache SkipLocal: $_ Local copy found\n";

                #
                # Delete the cache copy
                # The user is playing with local copy
                #
                if ( -d "$cache/$_" )
                {
                    print  "Cache SkipLocalDelete: $_ -> $cache\n";
                    Verbose ( "Remove: $_" );
                    rmtree( "$cache/$_", $opt_debug );
                    Verbose ( "Remove Complete: $_" );
                }
                next;
            }
        }

        #
        #   Locate package.
        #   It may be in GBE_DPKG_REPLICA, GBE_DPKG or GBE_DPKG_STORE
        #   Or it may only be in GBE_DPKG_ESCROW
        #       Package may (jats2_current) be a symlink
        #
        my $pkg_found;
        my @storeList;
        if ($estore) {
            push @storeList, $estore;
        } else {
            push @storeList,  $istore, $archive, $gstore ;
        }
        foreach my $store (@storeList)
        {
            $parchive = "$store/$_";

            if (-l $parchive)
            {
                my $linkDir = readlink($parchive);
                $parchive =~ s~/[^/]+$~/$linkDir~;
            }

            if ( -d $parchive )
            {
                $pkg_found = 1;
                last;
            }
        }
        
        unless ($pkg_found )
        {
            Warning ("Package not in archive: $_")
                unless ( $opt_quiet );
            next;
        }

        ########################################################################
        #   We have a package to process
        #
        my $dir_found = 0;
        my $force_update = 0;
        my $opr = "Update";

        #
        #   Generate the 'name' of a marker file used to indicate that the version is being updated
        #   This is outside the target directory
        #   
        $cacheMarker = "$_/built.cache";
        $cacheMarker =~ tr~/~_~s;
        $cacheMarker =~ tr~_~_~s;
        $cacheMarker =  $cache . '/' . $cacheMarker;
        Verbose2("cacheMarker: $cacheMarker");

        #
        #   Setup error recovery
        #       1) Tag the directory to be deleted on error
        #
        $remove_on_error = "$cache/$_";
        ErrorConfig( 'on_exit' => \&error_recovery );

        #
        #   Not a forced refresh. Ensure that the cached copy is
        #   up to date. Examine descpkg
        #
        $dir_found = waitForComplete($_,$cache);
        if ( $dir_found && !$opt_refresh )
        {
            if ( FileIsNewer( "$parchive/descpkg", "$cache/$_/descpkg" ) )
            {
                $force_update = 1;
                $opr = "OutOfDate";
                TouchFile ( $cacheMarker, "Marks the cache copy as incomplete");
                Verbose ("Cache out-of-date: $_");
            }
        }

        #
        #   If we need to refresh the cache copy - delete it first
        #
        if ( ($opt_refresh || $force_update) && $dir_found )
        {
            print  "Cache $opr: $_ -> $cache\n";
            Verbose ( "Remove: $_" );
            rmtree( "$cache/$_", $opt_debug );
            Verbose ( "Remove Complete: $_" );

            #
            #   Force transfer, but without the status message
            #
            $dir_found = 0;
            $opr = '';
        }

        #
        #   If the directory exists, then we need to avoid a race condition
        #   where multiple instances are updating the same directory
        #       Need to aviod hanging forever if the primary updator does not
        #       complete the task
        #   If its not in the cache then copy it in
        #
        $dir_found = waitForComplete($_,$cache);
        unless ( $dir_found )
        {
            print "Cache $opr: $_ -> $cache\n" if $opr;
            mkpath( "$cache/$_", $opt_debug, 0777);
            TouchFile ( $cacheMarker, "Marks the cache copy as incomplete");
            Verbose ( "Copy in: $_" );
            $copyFind_dst = "$cache/$_";
            $copyFind_src = $parchive;
            $copyFind_src_len = length( $copyFind_src );
            $copyFind_touch = $cacheMarker;
            $copyFind_time = 0;
            undef @copyFindDups;
            File::Find::find( \&copyFind, $parchive );
            if (@copyFindDups)
            {
                Warning("The following items where not transferred as they already existed",
                        "This may be due to symlinks or (Windows) case insensitive filename", @copyFindDups);
            }
            rmtree( $cacheMarker, $opt_debug );  # Works on files too !!
        }
        else
        {
            $opr = "Skip";
            print "Cache $opr: $_ -> $cache\n";
        }
    }
}

#-------------------------------------------------------------------------------
# Function        : waitForComplete 
#
# Description     : Wait for a package-version to complete
#                   At the end of this operation the directory will be 
#                   completly transferred, or it will be deleted
#                   
#                   If the directory exists, then we need to avoid a race condition
#                   where multiple instances are updating the same directory
#                   Need to avoid hanging forever if the primary updator does not
#                   complete the task
#
# Inputs          : $dir    - Subdir directory to monitor
#                   $cache  - Target cache
#
# Returns         : 0   - $dir does not exist
#                   1   - $dir does exist 
#
sub waitForComplete
{
    my ($dir, $cache) = @_;
    my $opr;
    my $tgtDir = "$cache/$dir";
    #
    #   Directory not preset
    #       All done - dir does not exist 
    #
    if (! -d $tgtDir)
    {
        return 0;
    }

    # If the package is not being updated, then we are done if the 
    # package being updated marker is NOT present
    #     
    if (  -d $tgtDir && ! -f $cacheMarker)
    {
        return 98;
    }

    #
    #   The package-version is being updated by another instance
    #   Hang around waiting for the update to complete or terminate
    #       Wait 10 minutes max
    #
    my  $waitStart = time();
    $opr = "Wait";
    print "Cache $opr: $dir -> $cache\n";
    while (1)
    {
        if ( ! -d $tgtDir )
        {
            # Directory has gone away
            #   Must have been a bad transfer by another instance
            #   Start the processing again
            $opr = "Retry";
            print "Cache $opr: $dir -> $cache\n";
            return 0;
        }

        if ( ! -f $cacheMarker )
        {
            #
            #   Update must have completed - marker file has been removed
            #
            $opr = "Found";
            print "Cache $opr: $_ -> $cache\n";
            return 97;
        }

        #
        #   Determine the 'age' of the marker file
        #       It will be updated after each file in the package has been copied
        #       If it is too old, then we must assume that the other instance died
        #   Complication. Windows does not correctly report the 'modified' time of a file
        #                 It gets messed up by the file system. Can't use the modified info
        #                 from Perls stat function to determine the absolute modified time of the
        #                 file.
        #                 
        #       Solution: Create a temp file and determine the age relative to that file
        #       

        my $cacheMarkerTmp = $cacheMarker . ".tmp";
        TouchFile($cacheMarkerTmp, "Relative time stamp");
        my $now   = (stat ($cacheMarkerTmp))[9];
        my $mtime = (stat ($cacheMarker))[9];
        rmtree( $cacheMarkerTmp, $opt_debug );

        #
        #   If the marker file is older than 5 minutes then we can consider the package as
        #   a dud. The marker file will be updated be every file write into the cache. Its
        #   an indication of activity.
        #   
        #   Assume that no file is going to take more then 5 minutes to copy
        #   Lets see how this goes.
        #   
        my $age = $now - $mtime;
        if ( $age > 5 * 60)
        {
            #
            #   Update taking too long
            #       Delete the package-version
            #       Try again
            #
            $opr = "Remove Bad";
            print "Cache $opr: $_ -> $cache\n";
            rmtree( "$cache/$_", $opt_debug );

            return 0;
        }

        #
        #   Wait a short while
        #
        Verbose("Waiting: " . (time() - $waitStart));
        sleep(5);
    }
}


#-------------------------------------------------------------------------------
# Function        : copyFind
#
# Description     : File:Find:find callback function to transfer files
#
# Inputs          : None
#                   Global: $copyFind_dst       - Target directory
#                   Global: $copyFind_src       - Source directory
#                   Global: $copyFind_src_len   - Length of Source dir
#                   Global: $copyFind_touch     - File to touch after each operation
#                   Global: $copyFind_time      - Time of last touch
#
# Returns         : Global: @copyFindDups       - Array of files not copied due to previous existence
#

sub copyFind
{
    my $item = $File::Find::name;
#Debug0("Remove sleep in copy");
#sleep(1);

    #
    #   Calculate the target directory name
    #
    my $tgt_path = substr($item, $copyFind_src_len );
    my $target = $copyFind_dst . $tgt_path;

    # Do not cache some parts of a package when being used by the build system
    #   /lcov ...
    #
    if ( $ENV{GBE_ABT})
    {
        if ($tgt_path =~ m~^/lcov(/|$)~)
        {
            Verbose("Prune directory: $tgt_path");
            $File::Find::prune = 1;
            return;
        }
    }

    if ( -d $item )
    {
        #
        #   Directories are handled differently
        #       - Directories are created with nice permissions
        #
        if ( ! -d $target )
        {
            mkpath( $target, $opt_debug, 0755);
        }
    }
    else
    {
        #
        #   File copy
        #
        #
        #   Copy file to destination
        #   If the file is a link, then duplicate the link contents
        #   Use: Unix libraries are created as two files:
        #        lib.xxxx.so -> libxxxx.so.vv.vv.vv
        #
        if ( -l $item )
        {
            Debug("Clone Link: $target");
            my $link = readlink $item;
            Debug( "Link: $item, $link");
            symlink ($link, $target );
            unless ( $link && -l $target )
            {
                Error("Failed to copy link [$item] to [$target]: $!");
            }
        }
        elsif (-f $target)
        {
            # File already exists
            #   Most likely Windows filename clash. Windows files are case-insensitive
            push @copyFindDups, $tgt_path
        }
        elsif (File::Copy::copy($item, $target))
        {
            Debug("Copying File: $target");

            #   Make the file ReadOnly
            my $perm = (stat $item)[2] & 07777;
            CORE::chmod $perm & 0555, $target;
        }
        else
        {
            Error("Failed to copy file [$item] to [$target]: $!");
        }
    }

    #
    #   Touch this file to indicate that the copy operation is still in progress
    #   Assists in early detection of partial copies
    #   
    #   Only touch once a minute to prevent hammering the file system
    #
    my $age = time() - $copyFind_time;
    if ($age > 60)
    {
        $copyFind_time = time();
        TouchFile ( $copyFind_touch, "Marks the cache copy as incomplete");
    }
}

#-------------------------------------------------------------------------------
# Function        : error_recovery
#
# Description     : Error recovery routine
#                   Delete the cached entry
#
# Inputs          :  Globals
#
# Returns         : None
#
sub error_recovery
{
    if ( $remove_on_error )
    {
        ReportError ("Error cleanup. Delete cache entry: $remove_on_error");
        rmtree( $remove_on_error, $opt_debug );
        $remove_on_error = undef;
    }

    if ($cacheMarker)
    {
        ReportError ("Error cleanup. Delete cache marker: $cacheMarker");
        rmtree( $cacheMarker, $opt_debug );
        $cacheMarker = undef;
    }
}


#-------------------------------------------------------------------------------
# Function        : age_the_cache
#
# Description     : Age cache entries
#                   Determine the age by:
#                       Use used.cache file if present
#                       Use descpkg file
#                       Not a proper entry - delete
#
# Inputs          : opt_age         - Delete packages older than XX days
#
# Returns         : Nothing
#
sub age_the_cache
{
    my $now = time;

    opendir (DIR, $cache) || die "Cannot open $cache\n";
    my @dir_list = readdir(DIR);
    closedir DIR;

    for my $fn ( @dir_list)
    {
        my $keep_dir = 0;
        next if ( $fn =~ m/^\./ );
        next unless ( -d "$cache/$fn" );
        next if ( $fn eq "core_devl" );

        opendir( DIR, "$cache/$fn" ) || die "Cannot open $cache/$fn\n";
        while ( my $fn1 = readdir(DIR) )
        {
            next if ( $fn1 =~ m/^\./ );
            my $dir = "$cache/$fn/$fn1";
            my $file = "$dir/used.cache" ;
            $file = "$dir/descpkg" unless ( -f $file );

            if ( ! -f $file )
            {
                #
                #   No descpkg file
                #   This is a badly formed entry - so delete it
                #
                if ( $opt_test )
                {
                    Message("Would Purge: $fn/$fn1" );
                    $keep_dir = 1;
                }
                else
                {
                    Message("Purging: $fn/$fn1" );
                    rmtree( $dir, $opt_debug );
                }
            }
            else
            {
                #
                #   used.cache or descpkg file found
                #   How old is it
                #
                my $timestamp = (stat($file))[9] || 0;
                my $age = int( ($now - $timestamp) / (60 * 60 * 24));
            
                if ( $age > $opt_age )
                {
                    if ( $opt_test )
                    {
                        Message("Could Age: $fn/$fn1, $age" );
                        $keep_dir = 1;
                    } else {
                        Message("Aging: $fn/$fn1, $age" );
                        rmtree( $dir, $opt_debug );
                    }
                }
                else
                {
                    Verbose("Age of: $fn/$fn1, $age" );
                    $keep_dir = 1;
                }
            }
        }
        closedir DIR;

        #
        #   Delete the entire directory if is is empty
        #
        unless ( $keep_dir )
        {
            Message("Remove Empty Dir: $cache/$fn"  );
            rmtree( "$cache/$fn", $opt_debug );
        }
    }
}

#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=for htmltoc    SYSUTIL::

=head1 NAME

cache_dpkg - Maintain a local cache of packages

=head1 SYNOPSIS

 jats cache_dpkg.pl [options] package/version ...

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -clear             - Delete the entire cache
    -flush             - Flush all named packages
    -[no]refresh       - Refresh package in cache
    -list              - List cache contents with nice format
    -dir               - List cache contents
    -export            - Generate a list of cached packages
    -refresh_all       - Refresh all packages within the cache
    -update_all        - Update all packages within the cache as required
    -[no]wait          - Wait for package replication
    -[no]cache         - Cache packages [default]
    -quiet             - Suppress warnings
    -age=nn            - Remove all packages older than nn days
    -test              - Use with -age to report ages

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<-clear>

Delete the B<entire> contents of the dpkg_archive cache. This will occur before
any new packages are copied into the cache.

=item B<-flush>

If set then the utility will delete the named packages from the cache. All named
packaged will be deleted. This option affects all named packages. It is not
possible to flush and copy packages with the same command.

=item B<-[no]refresh>

If the B<refresh> option has been specified then packages will be deleted, from
the cache and then a new copy will be copied in. If not specified then no copy
will occur if the package is present in the cache.

=item B<-list>

Display a list of all packages in the cache. A formatted display is generated.

This will be done before any packages are transferred.

=item B<-dir>

Display a list of all packages in the cache. This is a raw directory like
listing of the cache.

This will be done before any packages are transferred.

=item B<-export>

Generate a space separated list of cached packages as a single line. This is
intended to allow a list be exported for later import.

=item B<-refresh_all>

This option will force the program to refresh all the packages in the cache.
This forces a B<-refresh> and may be combined with other packages specified
on the command line.

=item B<-update_all>

This option will force the program to examine all packages within the cache and
refresh packages that are out of date. This option may be combined with other
packages specified on the command line.

A package is deemed to be out-of-date if the modification time of the package's
descpkg file in the cache is older than the one in the archive.

=item B<-[no]wait>

This option will cause the utility to wait for specified package versions to be replicated
into a package replica. The default mode is to not-wait, unless the operation is invoked 
from within the build phase.

The utility will wait upto 10 minutes (600 seconds) for a named version to be replicated
from the main archive to a replica.

A dpkg_cache need not be present for the replication-wait to be performed.

The wait-for replication step is designed to address an issue where the build system
is remotely located from the main archive. If required package versions are not in the
replica then this utility would copy them from the main archive. This can be very very 
slow - much slower than waiting for the replication to complete.

=item B<-[no]cache>

This option can be used to prevent the named packages from being cached. The default mode
is to cache the named packages.

It is intended to be used with the '-wait' option so that replication is complete
but the local caching is not perform. To be used for non-ant builds to prevent local caching
of packages that are not used in a build.

=item B<-quiet>

This option will suppress almost all of the progress messages, except for a single
copy message. It is intended to be used when the program is called from another
script.

=item B<-age=nn>

This option will delete all package versions that are older than the nn days.
The age of a package is calculated from the timestamp of the descpkg file.

=item B<-test>

This option modifies the operation of the B<-age=nn> option such that it will not
delete old package-versions. It will simply report what would be deleted.

=back

=head1 DESCRIPTION

This program simplifies the operation of maintaining a local copy of
used packages from the maintaining dpkg_archive store. The cache should be
stored on your local disk for speed.

=head2 Location of the cache

The local cache is specified with the EnvVar GBE_DPKG_CACHE

=head2 Location of the maintaining archive

The required package version can be found in three archives. These are:

=over 4

=item *

GBE_DPKG_REPLICA. A local image of the main dpkg_archive. This is used when dpkg_archive is synced locally and is expected to be faster than GBE_DPKG

=item *

GBE_DPKG. The main dpkg_archive

=item *

GBE_DPKG_STORE. A global package archive. The search repository of last choice.

=back

=head2 Interaction with local_dpkg_archive

If a package is located in the users local_dpkg_archive and we are doing a
simple cache update then the package will be deleted from the cache. This is
done to speed use on slow remote links and ensure cache consistency.

=head2 Interaction with build system

If the cache operating is done within the context of the Build System (GBE_ABT is not zero), 
then some parts of the package will not be transferred. This is done to speed up the caching.

Directories that will not be cached:

=over 4

=item * 

lcov - A directory that contains code coverage information. This directory normally 
contains a large number of files, none of which are used by the build system. Over long 
links the transfer time of the 'lcov' directory can take hours.

=back

=head1 EXAMPLE

=head2 jats dpkg_cache -list

This will list the current contents of the cache.

=head2 jats dpkg_cache -refresh crc/1.0.4.cr

This will delete any cached copy of the package crc/1.0.4.cr, if one exists,
and then copy in a new version.

=head2 jats dpkg_cache crc

This will copy in all versions of the crc package. This may not be desirable.

=head2 jats dpkg_cache -update_all

This will examine all packages in the cache and refresh those packages that are
out of date.

=cut

