#!/usr/local/bin/perl
;#
;# 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: pmirror,v 1.1 1997/09/26 14:44:42 ikuo Exp $
;#
use strict;
use vars qw($opt_C $opt_d $opt_f $opt_l $opt_p $opt_v);

use Getopt::Std;

getopts("C:df:l:p:v")
	or die("Usage: $0 [-C dir] [-v] [-p #] [archive...]\n");

;# Change working directory if -C option was specified.
if ($opt_C ne '' && -d $opt_C) {
	chdir($opt_C) or die("chdir($opt_C): $!\n");
}

;# Redirect log messages if -l option was given.
if ($opt_l ne '') {
	open(STDERR, '>>'.$opt_l) or die("open($opt_l): $!\n");
	open(STDOUT, '>&STDERR') or die("open(STDOUT): $!\n");
}

;# No parallel session allowed in debug mode.
if ($opt_d || $opt_p < 1) {
	$opt_p = 1;
}

;# Reading archive names from a file.
if ($opt_f) {
	local *FILE;

	-f $opt_f or die("$opt_f: file not found\n");
	open(FILE, $opt_f) or die("open($opt_f): $!\n");
	while (<FILE>) {
		s/^\s+//; s/\s+$//; next if /^$/ || /^#/;
		push(@ARGV, $_);
	}
	close(FILE);
}

;# Check target archives.
@ARGV or die("nothing to do, terminated.\n");

;# Do real work in `loop'.
&loop(@ARGV);

;# And success return.
exit;

;# Do real work.
sub loop {
	my %kids = ();
	my $n = 0;

	while (@_ || %kids) {
		while (@_ && $n < $opt_p) {
			my $x = shift;
			my $p = &run($x);
			warn("target \"$x\" [$p] started.\n");
			$kids{$p} = $x;
			$n++;
		}
		if ((my $kids = join(',', values %kids)) ne '') {
			warn("running: $kids\n");
		}
		if ((my $p = wait) >= 0) {
			warn("kid[$p] returns $?\n");
			if (exists($kids{$p})) {
				warn("target \"$kids{$p}\" [$p] done.\n");
				delete($kids{$p});
				$n--;
			}
		}
	}

	1;
}

;# Run mirror process in child.
sub run {
	my $pac = shift;
	my $log = "log/$pac.log";

	if (!defined(my $pid = fork)) {
		die("fork: $!\n");
	} elsif ($pid) {
		return $pid; # in parent...
	}

	# in KID's process
	if (!$opt_d) {
		if (-e $log) {
			system 'rotate', $log, '3', '2', '1', '0';
			$? == 0 or die("rotate($log): returns $?\n");
		}
		open(STDERR, '>'.$log) or die("open($log): $!\n");
		open(STDOUT, '>&STDERR') or die("open(STDOUT): $!\n");
	}

	# Run mirror procces.
	exec '/usr/bin/time', '-l', 'ftpmirror',
		'--ftp-list-method=LIST',
		'--load-config+=run.cf',
		'--verbose',
		'--ftp-stats', $pac
		or die("exec: $!\n");
	# NOT REACHED
}