#! /bin/sh
#!perl -w # --*- Perl -*--
eval 'exec perl -x $0 ${1+"$@"}'
    if 0;
#------------------------------------------------------------------------------
#$Author: antanas $
#$Date: 2019-12-06 12:49:48 +0200 (Fri, 06 Dec 2019) $
#$Revision: 7550 $
#$URL: svn://www.crystallography.net/cod-tools/tags/v2.10/scripts/fetch_cif_dict $
#$Id: fetch_cif_dict 7550 2019-12-06 10:49:48Z antanas $
#------------------------------------------------------------------------------
#*
#* Fetch cif_core.dic from the IUCr FTP site if non-expired local copy
#* does not exist.
#*
#* USAGE:
#*    $0 --options
#**

use strict;
use warnings;
use Net::FTP;
use File::Compare qw( compare );
use File::Copy qw( move );
use COD::SOptions qw( getOptions );
use COD::SUsage qw( usage options );
use COD::UserMessage qw( note warning error sprint_message );
use COD::ToolsVersion;

my $version = '1.0';
my $cache_duration = 432000; # 60 * 60 * 24 * 5 = 432000 -> for 5 days
my $from_mail = undef;       # e-mail of user using script
my $force_overwrite = 0;     # force overwrite of local file or cache clearance
my $verbose = 0;
my $dict_file_uri = 'ftp://ftp.iucr.org/pub/cif_core.dic';

#* OPTIONS:
#*   --cache-duration 432000
#*                     Time in seconds, for which the file will remain
#*                     untouched unless forced to do otherwise 
#*                     (see --force-overwrite) (default 432000).
#*   --mail-address fetcher@mail.com
#*                     The e-mail address that will be used passed to the FTP
#*                     server as an identifier of the client using the service.
#*                     It is not mandatory and there is no default, but we
#*                     insist you to declare it.
#*   --force-overwrite
#*                     Disregard local file modification time and cache duration
#*                     values while fetching the requested file.
#*   --no-force-overwrite
#*                     Respect local file modification time and cache duration
#*                     values while fetching the requested file (default).
#*   --silent, --quiet
#*                     Suppress additional messages about the progress of the
#*                     script. Only fatal errors will be printed.
#*   --verbose, --no-quiet
#*                     Print additional messages about the progress of the
#*                     script.
#*   --help, --usage
#*                     Output a short usage message (this message) and exit.
#*   --version
#*                     Output version information and exit.
#**
@ARGV = getOptions(
    '--cache-duration'   => \$cache_duration,
    '--mail-address'     => \$from_mail,

    '--force-overwrite'    => sub { $force_overwrite = 1 },
    '--no-force-overwrite' => sub { $force_overwrite = 0 },

    '--silent'       => sub { $verbose = 0 },
    '--quiet'        => sub { $verbose = 0 },
    '--verbose'      => sub { $verbose = 1 },
    '--no-quiet'     => sub { $verbose = 1 },
    '--options'      => sub { options; exit },
    '--help,--usage' => sub { usage; exit },
    '--version'      => sub { print 'cod-tools version ',
                              $COD::ToolsVersion::Version, "\n";
                              exit }
);

fetch_dictionary($dict_file_uri, $cache_duration, $from_mail, $force_overwrite);

# This subroutine is used before fetching new dictionary from FTP.
# It creates local directory and returns path to it.
# Parameters:
#     NONE
# Example:
#     prepare_local();
sub prepare_local
{
    my $my_cod_dir = '';
    if( defined $ENV{HOME} ) {
        $my_cod_dir = $ENV{HOME} . '/';
    }
    $my_cod_dir .= '.cod/';

    if( ! -d $my_cod_dir ) {
        if( ! mkdir $my_cod_dir, 0775 ) {
            error( $0, $my_cod_dir, undef, 'unable to create COD directory ',
                   lcfirst($!) );
            return 0;
        }
        note( $0, $my_cod_dir, undef, 'created directory to store '
            . 'Crystallography Open Database (COD) persistent files', undef );
    }

    return $my_cod_dir;
}

# Subroutine used to create a copy of local dictionary file appending
# date to file name.
# Parameters:
#     1) string -- path to local dictionary file
# Example:
#     create_copy_of_local_file( '/home/user/.cod/cif_core.dic' );
sub create_copy_of_local_file
{
    my ($local_dict_file) = @_;

    my @local_time = localtime(time);
    my $moved_dist_file = $local_dict_file . '_';
    $moved_dist_file .= ($local_time[5]+1900) . '-';
    $moved_dist_file .= ($local_time[4] < 10) ? '0' . $local_time[4] : $local_time[4];
    $moved_dist_file .= '-' . $local_time[3];

    if( -e $moved_dist_file ) {
        warning( $0, undef, undef, 'back-up of your current dictionary file '
               . "already exists as '$moved_dist_file'", 'operation stopped' );
        return 0;
    }

    if( ! move $local_dict_file, $moved_dist_file ) {
        error( $0, undef, undef, "unable to create copy '$moved_dist_file' "
             . "of your dictionary file '$local_dict_file'", lcfirst($!) );
        return 0;
    }

    note( $0, undef, undef, 'created a copy of your dictionary file '
        . "'$local_dict_file' as '$moved_dist_file'", undef);
    return 1;
}

# Subroutine to replace fetched dictionary file by new one.
# This subroutine uses 'File::Compare' to check, if files are equal.
# There is no need, to replace old file by new if they are equal.
# If files are not equal and old file exists - create_copy_of_local_file is
# called.
# Parameters:
#     1) string -- path to local dictionary file;
#     2) string -- path to temporary folder where downloaded file resides.
# Example:
#     move_fetched_file_if_diff( '/home/user/.cod/cif_core.dic',
#                                '/tmp/fetch_cif_dict_17531_cif_core.dic' )
sub move_fetched_file_if_diff
{
    my ($dict_file_path, $new_file_path) = @_;

    if( -e $dict_file_path ) {
        if( compare($dict_file_path, $new_file_path) == 0 ) {
            note( $0, undef, undef, 'new file does not differ from its '
                . 'previous version', 'only its mtime will be changed '
                . 'for further processes' );
            utime undef, undef, $dict_file_path;
            unlink $new_file_path;
            return 0;
        }

        return unless create_copy_of_local_file( $dict_file_path );
    }

    if( ! move $new_file_path, $dict_file_path ) {
        error( $0, undef, undef, 'unable to create new dictionary file '
             . "'$dict_file_path' moving '$new_file_path'", lcfirst($!) );
        unlink $new_file_path;
        return 0;
    }

    note( $0, $dict_file_path, undef, 'new dictionary file was successfuly ' .
          'downloaded', undef );
    return 1;
}

# Subroutine to fetch dictionary.
# Parameters:
#     1) string -- full FTP address of dictionary to be fecthed;
#     2) int -- time in seconds to cache file (will be checked against 
#         mtime of local file);
#     3) string -- e-mail of user using script (will be used to 
#         authenticate against FTP server);
#     4) int -- this flag forces download if set to higher than 0 (zero) 
#         value;
# Example:
#     fetch_dictionary( 'ftp://ftp.iucr.org/pub/cif_core.dic', 432000,
#                       'name@example.com', 0 );
sub fetch_dictionary
{
    my ($dict_file_uri, $cache_duration, $user_mail, $force_download) = @_;

    $dict_file_uri =~ m/^([a-z]+):\/\/([^\/]+)(\/.*\/)([^\/]+)$/s;
    my %ftp = ( 'protocol' => $1,
                'host' => $2,
                'path' => $3,
                'file' => $4
        );

    my $local_path  = prepare_local();
    my $local_dict_path = $local_path  . $ftp{file};

    return unless $local_path ;

    my $temporary_store = '/tmp';
    if( defined $ENV{TMP}
        && -d $ENV{TMP} ) {
        $ENV{TMP} =~ m/^(.*)\/?$/;
        $temporary_store = $1;
    }
    $0 =~ m/\/?([^\/]+)$/;
    $temporary_store .= '/' . $1 . '_' . $$ . '_' . $ftp{file};

    # if dictionary does not exist in local cache, or has expired
    if( $force_download == 0
        && -e $local_dict_path
        && (stat($local_dict_path))[9] < (time() + $cache_duration) ) {
        warning( $0, $ftp{file}, undef, 'dictionary file already exists in '
               . "local folder as '$local_dict_path'", 'operation canceled' );
        return 0;
    }

    # download file
    my $ftp_agent = Net::FTP->new($ftp{host}, Debug => 0, Passive => 1) or die
                  sprint_message($0, undef, undef, 'ERROR', 'unable to connect'
                               . "to ftp '$ftp{host}'", lcfirst($@));
    $ftp_agent->login('anonymous', $user_mail) or die
                  sprint_message($0, undef, undef, 'ERROR', 'unable to '
                               . 'authenticate', lcfirst($ftp_agent->message) );
    $ftp_agent->cwd($ftp{path}) or die
                  sprint_message($0, undef, undef, 'ERROR', 'unable to '
                               . "change working directory to '$ftp{path}'",
                                 lcfirst($ftp_agent->message) );
    $ftp_agent->get($ftp{file}, $temporary_store) or die
                  sprint_message($0, undef, undef, 'ERROR', 'unable to fetch'
                               . "file '$ftp{file}'",
                                  lcfirst($ftp_agent->message));
    note( $0, $dict_file_uri, undef, 'successfully downloaded the dictionary and '
        . "stored it as '$temporary_store' for further processing", undef );
    $ftp_agent->quit;

    # attempt to replace file
    return move_fetched_file_if_diff( $local_dict_path, $temporary_store );
}
