#!/usr/bin/perl
# -*-Fundamental-*-
 
use Carp;
use strict;
$| = 1;
 
my $Myname;
($Myname = $0) =~ s%^.*/%%;
 
#   $Myname <archive-dir> <ftp-user> <ftp-password> <ftp-host>
#                    <ftp-dir> <ftp-prefix> <retain> [<ftp-debug>]
 
use Net::FTP;
 
my $Archive_dir = shift;
my $Ftp_user = shift;
my $Ftp_password = shift;
my $Ftp_host = shift;
my $Ftp_dir = shift;
my $Ftp_prefix = shift;
my $Retain = shift;
my $Ftp_debug = shift;
 
chdir $Archive_dir || die "chdir ($Archive_dir): $!";
open(C, "$Ftp_prefix.counter") || die "open <$Ftp_prefix.counter: $!";
my $c = <C>; chomp $c;
 
print "$Myname: last counter was <$c>.\n";
 
my $ftp;
 
$ftp = Net::FTP->new($Ftp_host, Debug => $Ftp_debug)
   || die "FTP->new($Ftp_host): $@";
 
$ftp->login($Ftp_user, $Ftp_password)
   || die "FTP->login($Ftp_user): $@";
 
$ftp->cwd($Ftp_dir)
   || die "FTP->cwd($Ftp_dir): $@";
 
my $nc = 0;
foreach my $f ($ftp->ls())
  {
    if ($f =~ /^$Ftp_prefix.(\d+)$/)
      {
        if ($1 > $nc) { $nc = $1; }
      }
  }
 
# -rw-r--r--    1 rmg      users           0 Mar 25 16:06 prefix.10
# -rw-r--r--    1 rmg      users     2638130 Mar 25 16:06 prefix.10.tar.gz
# -r--r--r--    1 root     users         147 Mar 25 16:06 prefix.ckp.10.gz
# -r--r--r--    1 root     users          76 Mar 25 16:06 prefix.jnl.9.gz
 
if ($nc > $c)
  {
    # We have a new one to grab!
 
    # Take the checkpoint file:
    #
    $ftp->get("$Ftp_prefix.ckp.$nc.gz")
      || die "FTP->get($Ftp_prefix.ckp.$nc.gz): $@";
    print "$Myname: copied $Ftp_prefix.ckp.$nc.gz.\n";
 
    # And the journal file:
    #
    my $ncp = $nc - 1;
    $ftp->get("$Ftp_prefix.jnl.$ncp.gz")
      || die "FTP->get($Ftp_prefix.jnl.$ncp.gz): $@";
    print "$Myname: copied $Ftp_prefix.jnl.$ncp.gz.\n";
 
    # And the file-revision archive:
    #
    $ftp->get("$Ftp_prefix.$nc.tar.gz")
      || die "FTP->get($Ftp_prefix.$nc.tar.gz): $@";
    print "$Myname: copied $Ftp_prefix.$nc.tar.gz.\n";
 
    open(C, ">$Ftp_prefix.counter") || die "open >$Ftp_prefix.counter: $!";
    print C "$nc\n"; close C;
 
    # anon users may not be able to do this; for now, rely on the "checkpoint"
    # side to clean up.
 
    #foreach my $f ($ftp->ls())
    #  {
    #    $ftp->delete($f)
    #      || die "FTP->delete($f): $@";
    #  }
  }
 
#  Now delete old ones. We retain the $Retain most recent.
#
#  Base it on the prefix.ckp.*.gz files, since these are the oldest of
#  each batch.
#
my @Ckp = <$Ftp_prefix.ckp.*.gz>;
 
my @Ckpn;
 
foreach my $Ckp (@Ckp)
  {
    $Ckp =~ s/$Ftp_prefix.ckp.//;
    $Ckp =~ s/.gz//;
    unshift (@Ckpn, $Ckp);
  }
 
splice(@Ckpn, 0, $Retain); 
 
foreach my $N (@Ckpn)
  { &s("/bin/rm -f $Ftp_prefix.ckp.$N.gz $Ftp_prefix.jnl.$N.gz $Ftp_prefix.$N.tar.gz"); }
 
# Notification email TBD (or rely on cron mail at first?)
 
exit 0;
 
#  Run a command, returning status and output; terminate
#  on any error.
#  
sub s
{
  my ($cmd) = @_;
  my ($sts, $output);
 
  print("> $cmd\n");
 
  if (! open(CMD, "$cmd 2>&1 |"))
    { die "can't open \"$cmd 2>&1 |\": $!"; }
  
  while (<CMD>) { print(": $_"); $output .= $_; }
  close CMD;
 
  if ($sts = $?)
    {
      my $sig = $sts & 0x0f;
      $sts = $sts >> 8;
      die "\"$cmd\" exited with signal $sig status $sts";
    }
  return ($sts, $output);
}