RSS Git Download  Clone
Raw Blame History
#!/usr/bin/env perl

# runs every 15 mins, 5 mins offset from genomics_xml.pl; sends any genomics xml
# files *from same date* (to avoid sending outdated data) in /tmp dir

use lib (
    '/home/raj/perl5/lib/perl5',
    '/home/raj/perl-lib',
);
use Data::Printer alias => ddp;
use Modern::Perl;
use Local::Utils;
use Net::FTP;
use IO::All;

use constant LOGFILE => '/home/raj/crons/genomics_transfer.log';

my $timestamp = Local::Utils::time_now(); # ddp $timestamp->strftime('%Y_%m%d');

my @files = io->dir('/tmp')->all; # ddp $_->filename for @files;

for my $f (@files) { # warn $f->name;
  # fix for zero-byte files (eg .lxterminal-socket:0.0-techserv):
    next unless $f->size;
  # skip unless object type is 'file':
    next unless $f->type eq 'file';
  # only want files with genomics xml filename format:
    next unless $f->filename =~ /^\d+_(\d{4}_\d{4})_\d{6}\.xml/; # warn ddp $f->filename;
  # capture date string (eg 2017_0707):
    my $date = $1; # ddp $date;
  # only want files from today (may have changed if older):
    next unless $date eq $timestamp->strftime('%Y_%m%d'); # ddp $date;
  # check it's for Genomics
    my $contents = $f->slurp; # ddp $contents;
    next unless $contents =~ /HILIS4Genomics/;

    my $local_filename  = $f->name;     # ddp $local_filename;
    my $remote_filename = $f->filename; # ddp $remote_filename;

    my %params = (
        local_filename  => $local_filename,
        remote_filename => $remote_filename,
        server_addr     => '163.160.107.109',
        username        => 'HMDS',
        password        => 'dmw@kY4jzu$Hx5p',
        cwd             => 'HILIS_GEL', # destination_dir for genomics data
        passive_mode    => 1,
        ascii_mode      => 1,
    ); # ddp %params;

    # ftp file (returns str on failure, undef on success):
    my $rtn = ftp_file(\%params); # ddp $rtn;
    if ($rtn) { # ddp $rtn;
        my $script = File::Basename::basename($0);
        my $time   = $timestamp->strftime('%Y-%m-%d %T');
        warn "$script [$time] $rtn\n";
    }
    else {
        my $msg = $timestamp->strftime('%Y-%m-%d %T') . ': '
			. $local_filename . "\n"; # say $msg;
        io(LOGFILE)->append($msg);
        io($local_filename)->unlink;
	}
}

sub ftp_file {
    my $args = shift; # ddp $args; return;
    # can pass timeout as arg, default is 60 seconds if no value specified;
    # Timeout => $args->{timeout}
	my $ftp = Net::FTP->new( $args->{server_addr}, Debug => 0 )
    || return "Cannot connect to $args->{server_addr}: $@";

    if ($args->{username} && $args->{password}) {
        $ftp->login(@{$args}{qw/username password/})
        || return $ftp->message; # msg states "cannot login ..."
    }
	$ftp->binary() unless $args->{ascii_mode};
    $ftp->passive(1) if $args->{passive_mode};
    $ftp->cwd($args->{cwd}) if $args->{cwd};

	$ftp->put($args->{local_filename}, $args->{remote_filename})
    # need to return NOW, or err message() will be replaced by outcome of quit():
    || return 'FTP error - ' . $ftp->message;

    $ftp->quit;

    return 0; # don't return message() here - will be result of quit() eg 'goodbye'
}