#! /usr/pkg/bin/perl
$COPYRIGHT = "WWW update tool ver 0.8\n".
    "         Copyright(C) 2001-2003,2009  amura/MURAMATSU Atsushi";
#
#  Copyright (c) 2001-2003,2009   MURAMATSU Atsushi
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following condition
# is met:
#
#   Redistributions of any form (source code and/or binary) must
#   reproduce the above copyright notice, this condition and the
#   following disclaimer in source code and/or the documentation
#   provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
use strict;
use Net::FTP;
use vars qw($COPYRIGHT $PUBLIC_HTML $SERVER_ROOT $SERVER_NAME $USERNAME $PASSWD
	    $UPDATE_FILE $IGNORE_FILES $IGNORE_DIRS %FTPOPTIONS);

#
# Basic configurations
#
$PUBLIC_HTML = '/home/amura/text/public_html';	# default local directory
$SERVER_ROOT = '/home/amura/www';		# default FTP server directory
$SERVER_NAME = 'tomato.sakura.ne.jp';		# FTP server name
$USERNAME    = 'amura';				# FTP account
$PASSWD      = '????????';			# FTP password
%FTPOPTIONS  = ( Passive => 1 );		# FTP options

#
# Other (extra) configurations
#
$UPDATE_FILE = '.update';
$IGNORE_FILES = '(^.cvsignore$|^.keep_me$|^.nfs|[~#]$)';
$IGNORE_DIRS  = 'CVS';

# default override
$PUBLIC_HTML = $ARGV[0] if ($ARGV[0]);
$SERVER_ROOT = $ARGV[1] if ($ARGV[1]);

use vars qw($update %put_files %remove_files %update_dirs);

my($ftp, $dir);
print("$COPYRIGHT\n\n");
update_dir($PUBLIC_HTML);
unless ($update) {
    print "no update file\n";
    exit 0;
}
print "Now connect to $USERNAME\@$SERVER_NAME\n";
$ftp = Net::FTP->new($SERVER_NAME, %FTPOPTIONS);
die $@ unless (defined $ftp);
$ftp->login($USERNAME, $PASSWD) or die "Authrization Error!";
$ftp->binary;
for $dir (keys %put_files) {
    my @list = @{$put_files{$dir}};
    my $server_dir = $dir;
    chdir $dir;
    $server_dir =~ s/^$PUBLIC_HTML/$SERVER_ROOT/o;
    $server_dir = '/' if ($server_dir eq '');
    print "updating directory $dir\n";
    unless ($ftp->cwd($server_dir)) {
	unless ($ftp->mkdir($server_dir, 1)) {
	    print qq(Cannot create directory "$server_dir", skip it.\n);
	    delete $update_dirs{$dir};
	    next;
	}
	unless ($ftp->cwd($server_dir)) {
	    print qq(Cannot change directory "$server_dir", skip it.\n);
	    delete $update_dirs{$dir};
	    next;
	}
    }
    for (@list) {
	print "    upload $_";
	unless ($ftp->put($_)) {
    	    delete $update_dirs{$dir}->{$_};
	    print " ... ERROR!";
	}
	$ftp->quot("site", "chmod", "705", $_,) if (-x $_);
	print "\n";
    }
    chdir $ENV{'PWD'};
}
for $dir (keys %remove_files) {
    my @list = @{$remove_files{$dir}};
    my $server_dir = $dir;
    $server_dir =~ s/^$PUBLIC_HTML/$SERVER_ROOT/o;
    $server_dir = '/' if ($server_dir eq '');
    print "updating directory $dir\n";
    unless ($ftp->cwd($server_dir)) {
	print qq(Cannot found directory "$server_dir" , skip this\n);
	next;
    }
    for (@list) {
	print "    remove $_";
	unless ($ftp->delete($_)) {
    	    $update_dirs{$dir}->{$_} = 0;
	    print " ... ERROR!";
	}
	print "\n";
    }
}
$ftp->quit;

#Updateing UPDATE_FILE
for $dir (keys %update_dirs) {
    my %date_table;
    if (!defined($update_dirs{$dir})) {
	next;
    }
    %date_table = %{$update_dirs{$dir}};
    unlink "$dir/$UPDATE_FILE";
    open FILE, ">$dir/$UPDATE_FILE";
    for (keys %date_table) {
	print FILE "$date_table{$_}/$_\n";
    }
    close FILE;
}

# put file into update queue
sub put_file {
    my($dirname, $filename) = @_;
    my(@filelist);
    if (defined($put_files{$dirname})) {
	@filelist = @{$put_files{$dirname}};
    }
    push @filelist, $filename;
    $put_files{$dirname} = \@filelist;
#   printf "update $dirname/$filename\n";
    $update = 1;
}

# remove file into remove_que
sub remove_file {
    my($dirname, $filename) = @_;
    my(@filelist);
    if (defined($remove_files{$dirname})) {
	@filelist = @{$remove_files{$dirname}};
    }
    push @filelist, $filename;
    $remove_files{$dirname} = \@filelist;
#   printf "remove $dirname/$filename\n";
    $update = 1;
}

# Directory check routine
sub update_dir {
    my($dirname) = shift;
    my(@list, %date_table, %exist_table, $date, $name);
    
    opendir DIR, $dirname;
    @list = readdir DIR;
    closedir DIR;
    if (-f "$dirname/$UPDATE_FILE") {
	print "update check in $dirname\n";
	open FILE, "$dirname/$UPDATE_FILE";
	while (<FILE>) {
	    chop;
	    ($date, $name) = split /\//;
	    $date_table{$name} = $date;
	    $exist_table{$name} = 0;
	}
	close FILE;

	for (@list) {
	    next if ($_ eq '.' || $_ eq '..');
	    next if ($_ =~ /$IGNORE_FILES/o);
	    next if ($_ eq "$UPDATE_FILE");
	    if (-f "$dirname/$_" ) {
		$exist_table{$_} = 1;
		$date = (stat "$dirname/$_")[9];
		if ($date_table{$_} < $date) {
		    put_file($dirname, $_);
		    $date_table{$_} = $date;
		}
	    }
	}
	for (keys %date_table) {
	    unless ($exist_table{$_}) {
		remove_file($dirname, $_);
		delete $date_table{$_};
	    }
	}
    
	$update_dirs{$dirname} = \%date_table;
    }

    for (@list) {
	next if ($_ eq '.' || $_ eq '..');
	next if ($_ =~ /$IGNORE_DIRS/o);
	if (-d "$dirname/$_" ) {
	    update_dir("$dirname/$_");
	}
    }
}