;#
;# ftpmirror.PL
;# This script generates ftpmirror.
;#
use Config;
use strict;
use vars qw($this);

;#
($this) = $0 =~ /([^\/]+)$/;
$this =~ s/\.PL$// || die("$0: no PL extension.\n");

;#
$this eq 'ftpmirror'
	or die("$0: only ftpmirror can be generated.\n");

;#
if (-f $this) {
	my $old = $this.'.old';
	if (-f $old) {
		print("unlink($old)...\n");
		unlink($old);
	}
	print("rename($this, $old)...\n");
	rename($this, $old);
}
print("writing $this...\n");
open(OUT, ">$this") || die("open($this): $!");
print OUT $Config{startperl}."\n";
print OUT while <DATA>;
close(OUT);

;#
print("chmod(0555, $this)...\n");
chmod(0555, $this);

;#
# $startperl = $Config{startperl};
# $sitearch = $Config{sitearch};
# $sitelib = $Config{sitelib};

;# End of script.
;#
__END__
;#
;# Copyright (c) 1995-1997
;#	Ikuo Nakagawa. All rights reserved.
;#
;# Redistribution and use in source and binary forms, with or without
;# modification, are permitted provided that the following conditions
;# are met:
;#
;# 1. Redistributions of source code must retain the above copyright
;#    notice unmodified, this list of conditions, and the following
;#    disclaimer.
;# 2. Redistributions in binary form must reproduce the above copyright
;#    notice, this list of conditions and the following disclaimer in the
;#    documentation and/or other materials provided with the distribution.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR 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.
;#
;# $Id: generator,v 1.1 1997/08/28 15:58:15 ikuo Exp $
;#
;#
use strict;
use vars qw($VERSION $LOG $todo $sysconfdir $loader %initval);

;# modules
use Ring::Cool;
use Ring::Loader;
use Ring::Archive;

;#
$VERSION = '0.12';
($todo) = $0 =~ m|([^/]+)$|;

;#
BEGIN {
	;# For non-blocking stdout.
	$| = 1;

	$LOG = 5;

	# Data and time string.
	my $t = time;
	my $s = str4date($t).' '.str4time($t);

	# Show start up message.
	warn("$s FTPMIRROR starting...\n") if $LOG > 5;
}

;#
END {
	# Data and time string.
	my $t = time;
	my $s = str4date($t).' '.str4time($t);

	;# Show terminate message.
	warn("$s FTPMIRROR terminated\n") if $LOG > 5;
}

;# initialization...
{
	use Config;

	# system configuration files
	$sysconfdir = $Config{prefix}.'/etc';
}

;#
%initval = (
	'sysconfdir'			=> $sysconfdir,
	'load-config'			=> "ftpmirror.cf",
	'create-directories'		=> 1,
	'override-file-uid'		=> 0,
	'override-file-gid'		=> 0,
	'override-file-mode'		=> '0644',
	'override-directory-mode'	=> '0755',
	'default-file-uid'		=> 0,
	'default-file-gid'		=> 0,
	'default-file-mode'		=> '0644',
	'default-directory-mode'	=> '0755',
	'unlink'			=> 'yes',
	'backup-suffix'			=> '~',
);

;#
$loader = Ring::Loader->new(\%Ring::Archive::pkeys);
ref($loader) && $loader->isa('Ring::Loader')
	or die("Can't create loader");

;# Initial default parameters.
$loader->merge_hash(\%initval, 'INIT')
	or die("Loader: Can't initialize values");

;# Parsing options.
while (@ARGV && $ARGV[$[] =~ s/^--//) {
	local $_ = shift;
	$loader->parse_line($_, 'OPTION') == 1
		or die("Loader: Can't parse option: $_\n");
}

;# Set logging level first.
if (defined($_ = $loader->get_value('log-mask', 'INIT', 'OPTION'))) {
	plog_mask($_);
}

;# Get 'load-config' parameter
if (defined($_ = $loader->get_value('load-config', 'INIT', 'OPTION'))) {

	# get 'load-config' parameter
	my $dir = $loader->get_value('sysconfdir', 'INIT', 'OPTION');

# debug...
warn("load files = $_\n") if $LOG > 6;

	# load configuration files
	for my $file (split(/\s+/)) {
		next if $file eq '';
		$file = "$dir/$file" if ! -f $file && $dir ne '';
		warn("loading $file...\n") if $LOG > 5;
		$loader->parse_file($file, 'DEFAULT')
			or die ("Loader Can't parse $file.\n");
	}
}

;#
if ($LOG > 5) {
	print("starting resource usage:\n");
	&show_usage();
}

;#
while (@ARGV) {
	my $name = shift;
	my $pack = 'PACKAGE::'.$name;

	# Search this package...
	unless ($loader->search($pack)) {
		warn("Loader: package $pack not defined, skip...\n");
		next;
	}

	# Try to generate Archive object.
	my $srv = $loader->get_value('ftp-server',
		'INIT', 'DEFAULT', $pack, 'OPTION');
	if ($srv eq '') {
		warn("Loader: package $pack has no FTP server, skip...\n");
		next;
	}

	# Get servers parameter object.
	my @list;
	if ($loader->search("SERVER::$srv")) {
		@list = ('INIT', 'DEFAULT', "SERVER::$srv", $pack, 'OPTION');
	} else {
		@list = ('INIT', 'DEFAULT', $pack, 'OPTION');
	}

	# Generate a new Archive object.
	my $p = Ring::Archive->new(param_name => 'RUN::'.$name);
	ref($p) && $p->isa('Ring::Param')
		or die("Can't create Param object.\n");

	# Merge parameters.
	for my $n (@list) {
		$p->merge($loader->search($n));
	}

	$p->check
		or warn("check error.\n"), next;

	if ($todo eq 'ftpmirror') {
		$p->mirror; # start...
	} elsif ($todo eq 'dirscan') {
		&dirscan($p);
	} elsif ($todo eq 'mkdirinfo') {
		use Ring::DIR;
		my $dir = $p->local_directory;
        	my $info = Ring::DIR->new(dir_path => $dir);
		ref($info) or warn("DIR($dir) not initialized.\n"), next;
		if ($info->update) { # this is a recursive call.
			warn("$dir: modified.\n") if $LOG > 5;
		} else {
			warn("$dir: not modified.\n") if $LOG > 5;
		}
	} elsif ($todo eq 'indexutil') {
		use Ring::Pias;
		my $dir = $p->index_directory;
		if ($dir eq '') {
			warn("index directory not found for $todo\n");
			next;
		}
		if (! -d $dir) {
			warn("$dir: directory not found for $todo\n");
			next;
		}
		my $pias = Ring::Pias->new($dir);
		unless (ref($pias)) {
			warn("$dir: Can't initialize Pias.\n");
			next;
		}
		unless ($pias->update) {
			warn("$dir: Can't update index directory.\n");
			next;
		}
		warn("updating $dir... good\n") if $LOG > 5;
	} else {
		die("$todo: What shall i do?\n");
	}

	;#
	if ($LOG > 5) {
		print("resource usage after $name done:\n");
		&show_usage();
	}
}

;# before termination, we'd like to see reports.
{
	$Ring::FTP::LOG = 6;
	$Ring::TCP::LOG = 6;
	$Ring::Attrib::LOG = 6;
}

;#
exit;

;#
sub pias_run {
	my $p = shift; # Ring::Archive object.
	my $pias = $p->ref_pias;
	my $cmd = shift;

	unless (ref($pias) && $pias->isa('Ring::Pias')) {
		return undef;
	}

	if ($cmd eq 'STEP') {
		my $scan = Ring::Scan->new(
			scan_type => 'LOCAL',
			scan_dir => $p->local_directory
		);
		$pias->d_start || die("d_start failed");
		my $x;
		while (defined($x = $scan->get)) {
			$pias->d_check($x) || die("d_check failed");
		}
		# $pias->d_end;
	} elsif ($cmd eq 'UPDATE') {
		$pias->update || die("update failed");
	} elsif ($cmd eq 'CLEANUP') {
		$pias->cleanup || die("cleanup failed");
	} elsif ($cmd eq 'NORMALIZE') {
		$pias->normalize || die("normalize failed");
	} else {
		$pias->force($p->local_directory, 1)
			or die("force failed");
	}
}

;#
sub dirscan {
	my $p = shift;

	local $SIG{'USR1'} = \&show_usage;

	use Ring::Scan;
	my $scan;

	if ($p->scan_remote) {
		use Ring::FTP;
		my $ftp = Ring::FTP->new(
			ftp_server => $p->ftp_server,
			ftp_gateway => $p->ftp_gateway,
			ftp_user => $p->ftp_user,
			ftp_pass => $p->ftp_pass
		);
		ref($ftp) && $ftp->isa('Ring::FTP')
			or die("Can't create FTP object");
		$ftp->login or die("Can't login to server");
		$ftp->chdir($p->remote_directory)
			or die("ftp->chdir failed");

		$scan = Ring::Scan->new(
			scan_type => 'FTP',
			scan_ftp => $ftp,
			scan_dir => $p->remote_directory
		);
		ref($scan)
			or die("Can't create Scan object");
	} else {
		$scan = Ring::Scan->new(
			scan_type => 'LOCAL',
			scan_dir => $p->local_directory
		);
		ref($scan)
			or die("Can't create Scan object");
	}

	my $x;
	while (defined($x = $scan->get)) {
		my $t = $x->type;
		print $x->path."\n" if $t ne 'U' && $t ne '.';
	}

	1;
}

;#
sub show_usage {
	use Ring::Usage;

	if (@_) {
		my $sig = shift;
		warn("* signal $sig detected.\n");
	}
	my $u = getrusage;
	$u->dump;
	undef $u;
	1;
}

=head1 NAME

ftpmirror - Mirror directory hiearachy via FTP.

=head1 SYNOPSIS

C<ftpmirror archive>

=head1 DESCRIPTION

Ftpmirror mirrors directory hiearachy via FTP.

=head1 AUTHER

Ikuo Nakagawa, Aug, 1997

=item

=cut