#!/usr/bin/perl -w

use strict;
use Data::Dumper;
my @props;
BEGIN {
    @props = qw(remote_site remote_user remote_password remote_directory use_passive local_directory local_ignores local_symlinks);
}
use vars map({ "\$$_" } @props);
use vars qw($opt_d $opt_r $opt_h $opt_l $opt_D $opt_f);
my $info_file;
my %old_transfers;
my %files_to_upload;
my %files_to_leave;
my %files_to_delete;
my $filename;
my $ftp;
use Net::FTP;
use File::Find;
use Pod::Usage;
use Getopt::Std;
use POSIX qw(strftime mktime);

getopts('drhl:D');

$opt_h and usage();
$opt_l ||= '.upload.log';

$info_file = shift or usage();

set_properties($info_file) and exit 2;

chdir($local_directory) or die "Cannot cd to local directory $local_directory: $!\n";
read_last_log();
move_last_log();
open LOG, ">$opt_l" or die "Can't open log file $opt_l for writing: $!\n";

find(
    {no_chdir => 1, # already done
     follow => $local_symlinks,   # follow symlinks (no by default)
     wanted => sub {
         $filename = $File::Find::name;
         my ($last_upload_time, $last_modification_time);
         return if $filename eq '.';
         $filename =~ s,^\./,,;
         if ($local_ignores and $filename =~ m/$local_ignores/) {
             print "Ignoring $filename\n" if $opt_D;
             return;
         }

         $last_upload_time = $old_transfers{$filename};
         $last_modification_time = (stat($filename))[9];

         if (not $last_upload_time) {
             print "Need to upload new file $filename\n" if $opt_D;
             $files_to_upload{$filename} = 1;
         } elsif ($last_upload_time < $last_modification_time) {
             print "Need to upload updated file $filename\n" if $opt_D;
             $files_to_upload{$filename} = 1;
         } else {
             print "Leaving unchanged file $filename\n" if $opt_D;
             $files_to_leave{$filename} = $last_upload_time;
         }
     }, },
 '.');


$ftp = login() unless $opt_r;

# First upload the necessary files.

for $filename (sort keys %files_to_upload) {
    my $upload_time = upload_file($filename);
    if ($upload_time) {
        $files_to_upload{$filename} = $upload_time;
    } else {
        print STDERR "Failed to upload $filename: $!\n";
        exit 2;
    }
}

# Delete files that have disappeared.
for $filename (reverse sort keys %old_transfers) {
    if (not -e $filename) {
        delete_remote($filename);
    }
}

$ftp->close() unless $opt_r;

# Write the log:
#   1. times of newly-uploaded files.
#   2. times of previously-uploaded files, not including newly-deleted files.
for $filename (keys %files_to_upload) {
    my $time_str = encode_time($files_to_upload{$filename});
    print LOG "$filename\t$time_str\n";
}
for $filename (keys %files_to_leave) {
    my $time_str = encode_time($files_to_leave{$filename});
    print LOG "$filename\t$time_str\n";
}


close LOG;


sub login {
    my $ftp = new Net::FTP($remote_site,
        Passive => $use_passive) or die "Failed to connect to server $remote_site: $!\n";
    $ftp->login($remote_user, $remote_password) or die "Failed to login as $remote_user\n";
    $ftp->cwd($remote_directory) or die "Failed to cd to remote directory $remote_directory\n";
    $ftp->binary() or die "Failed to set binary mode.\n";
    print "Connected\n" if $opt_D;
    return $ftp;
}

sub delete_remote {
    my $filename = shift;
    unless ($opt_r) {
        print "Deleting file: $filename\n" if $opt_D;
        $ftp->delete($filename) or $ftp->rmdir($filename, 1) or print STDERR "Failed to delete file $filename\n";
    }
}

sub upload_file {
    my $filename = shift;
    unless ($opt_r) {
        if (-f $filename) {
            print "Uploading file: $filename\n" if $opt_D;
            $ftp->put($filename, $filename) or print STDERR "Failed to upload $filename\n";
        } elsif (-d $filename) {
            print "Making directory: $filename\n" if $opt_D;
            $ftp->mkdir($filename) or print STDERR "Failed to mkdir $filename\n";
        } else {
            print "Not a plain file or a directory; skipping: $filename\n";
        }
    }
    return time();
}

sub encode_time {
    # Takes seconds since the epoch and converts it to a string.
    my $in = shift;
    my @lt = localtime($in);
    #  0    1    2     3     4    5     6     7     8
    #  $sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    return strftime('%Y-%m-%d %H:%M:%S', @lt);  # strftime ignores $lt[8].
}

sub decode_time {
    # Takes a string and converts it to seconds since the epoch.
    my $in = shift;
    if ($in =~ m/(\d\d\d\d)-(\d\d)-(\d\d) (\d+):(\d+):(\d+)/) {
        # print "$1-$2-$3 $4:$5:$6\n";
        # The -1 for Daylight Savings Time means that mtime with apply it
        # appropriately based on the given month and day.
        return mktime($6, $5, $4, $3, $2 - 1, $1 - 1900, 0, 0, -1);
    } else {
        return 0
    }
}

sub move_last_log {
    if (-e $opt_l) {
        rename $opt_l, "$opt_l.bak";
    }
}

sub read_last_log {
    if (-e $opt_l) {
        open LASTLOG, "<$opt_l" or die "Can't open prior log file $opt_l for reading: $!\n";
        while (<LASTLOG>) {
            chomp;
            if (m/^(.*)\t(.*)$/) {
                $old_transfers{$1} = decode_time($2);
            }
        }
        close LASTLOG;
    } else {
        # Just a warning:
        print STDERR "No log file found named $opt_l.\n";
    }
    # print Dumper \%old_transfers;
    # die;
}

sub set_properties {
    my $info_file = shift;
    my ($prop_name, $trouble);
    $trouble = 0;

    open CONFIG, "<$info_file"   or die "Can't open config file $info_file for reading: $!\n";
    while (<CONFIG>) {
        chomp;
        for $prop_name (@props) {
            no strict 'refs';
            if (m/^${prop_name}[:=]\s*(.*)$/) {
                $$prop_name = $1;
            }
        }
        use strict 'refs';
    }
    close CONFIG;

    for $prop_name (@props) {
        next if ($prop_name eq 'local_ignores' or $prop_name eq 'use_passive');
        no strict 'refs';
        if (not $$prop_name) {
            print STDERR "No property $prop_name defined in config file $info_file.\n";
            $trouble = 1;
        }
    }
    use strict 'refs';

    return $trouble;
}

sub usage {
    pod2usage({-exitval => 2, -verbose => 2});
}

=head1 NAME

upload

=head1 SYNOPSIS

upload [-h] [-d] [-r] [-l log-file] info-file

=head1 DESCRIPTION

I wrote upload to maintain my personal web site. I only have FTP access, so rsync isn't available. I was inspired by two other Perl programs, ftpsync (http://mipagina.cantv.net/lem/perl/ftpsync) and mirror (http://www.sunsite.org.uk/packages/mirror/), which almost-but-not-quite suited my needs. I wanted a fast program that could keep the remote site in sync with my local copy. Mirror did what I wanted, but it was very slow. So in good Perl fashion, I decided to write my own.

Upload uploads a directory tree to a given FTP location and records the date each file/directory was uploaded. On subsequent runs, upload only transfers files/directories that are newer than the time recorded in the prior upload. Upload may optionally delete files/directories, but only if you specify the -d option.

Upload only supports a few options:

=over 4

=item -h

Show this message.

=item -d

Delete remote files that are in the list of the last upload but not on the local machine.

=item -r

Do not transfer files; only read the files on the local machine and produce a log as though all files had been uploaded. This is useful if you already have a site that is up-to-date, and you want to start using upload. First run upload with the -r option, and then run it normally as you modify your local directory.

=item -l

The name of the log file to use. Defaults to ".upload.log" in the local base directory. Relative paths are interpreted from the base directory; absolute paths are also allowed.

=item -D

Print debugging info.

=back

The info-file argument names a text file with key/value pairs delimited by colons or equal signs. Here are the keys:

=over 4

=item remote_site

The hostname of the remote FTP site.

=item remote_user

The login name of the remote FTP site.

=item remote_password

The login password of the remote FTP site.

=item remote_directory

The root directory on the remote FTP site in which upload should place files.

=item local_directory

The local directory from which upload should read files.

=item local_ignores

A Perl regex. If it matches a local filename, upload will not transfer the file.

=item local_symlinks

Follow local symlinks if set to any non-empty value.

=item use_passive

Use passive FTP if set to any non-empty value.

=back

An example configuration file might look like this:

  remote_site: ftp.yoursite.com
  remote_user: youruser
  remote_password: whatpass
  remote_directory: public_html
  local_directory: /home/pjungwir/src/akathist/site
  local_ignores: upload\.conf|\.svn|\.upload\.log|\.swp$
  local_symlinks: true

=head1 BUGS

Please let me know if you find any.

=head1 AUTHOR

Paul Jungwirth <upload@9stmaryrd.com>

Much code was inspired by the ftpsync program.

=cut