#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

use strict;

BEGIN {
    $ENV{BRICOLAGE_ROOT} ||= '/usr/local/bricolage';
    eval { require Bric };
    if ($@) {
	# We need to set PERL5LIB.
	require File::Spec::Functions;
	my $lib =  File::Spec::Functions::catdir($ENV{BRICOLAGE_ROOT}, 'lib');
	unshift @INC, $lib;
	$ENV{PERL5LIB} = $lib;

	# Try again.
	eval { require Bric };
	die "Cannot locate Bricolage libraries.\n" if $@;
    }
};

use Bric::Dist::Client;
use Bric::Util::Trans::FS;
use Bric::App::Auth;
use Getopt::Std;
use Unix::Syslog qw(:subs :macros);
use POSIX qw(:sys_wait_h);
use Apache::FakeRequest;

use constant INTERVAL => 30;
use constant DEBUG => 0;
use constant URL => 'http://localhost/dist/';

# Get the options.
our ($opt_i, $opt_U, $opt_h, $opt_d, $opt_c, $opt_f, $opt_v, $opt_u, $opt_p,
     $opt_a);

getopts('i:u:p:hdcvf:U:P:a:');

# Get the version number.
our $VERSION = (qw$Revision: 1.4 $ )[-1];

# Get the program name.
my $prog = Bric::Util::Trans::FS->base_name($0);

# Print a usage statement, if necessary.
usage() if $opt_h;
version() if $opt_v;
usage("User name and password are required.") unless $opt_u && $opt_p;

# Make sure we have an interval and a debugging value.
$opt_i ||= INTERVAL;
$opt_d ||= DEBUG;
$opt_U ||= URL;

################################################################################
{
    # This Section is for the creation of a fake Apache object that can be
    # used by Bric::App::Auth.
    package FakeConn;
    unless ($opt_a) {
	require Sys::Hostname;
	$opt_a = sprintf "%vd", scalar gethostbyname(Sys::Hostname::hostname())
	  || die "Unable to determine IP address.";
    }
    sub new { bless {} }
    sub remote_ip { $opt_a }
}


################################################################################
# We're gonna need to reap the dead children.
our $zombies = 0;
#$SIG{CHLD} = sub { $zombies++ };
$SIG{CHLD} = 'IGNORE';
sub reaper {
    log_err("Reaping zombie processes.") if $opt_d;
    my $zombie;
    $zombies = 0;
    while (($zombie = waitpid(-1,WNOHANG)) != -1) {
	# Log it in debug mode.
	log_err("Reaped process $zombie.") if $opt_d;
    }
}

################################################################################
# Here's where the work gets done.
if ($opt_c) {
    # We're in CRON mode. Just do it and exit.
    send_jobs();
    exit;
} else {
    # We're in forking mode. Run forever.
    my $i = 0;
    while ($opt_f ? $i < $opt_f : 1) {
	# Increment if we're only doing this a few times.
	$i++ if $opt_f;
	log_err("Forking new process.") if $opt_d;
	my $pid;
	if ($pid = fork) {
	    # Parent process - take a nap.
	    sleep $opt_i;
	} else {
	    # It's the child process.
	    send_jobs();
	    exit;
	}
	# Reap any dead children.
	reaper() if $zombies;
    }
}

################################################################################

sub send_jobs {
    log_err("Checking for new jobs.") if $opt_d;
    eval {
	# Create the authentication cookie.
	my $r = Apache::FakeRequest->new(connection => FakeConn->new);
	my $cookie = Bric::App::Auth::login($r, $opt_u, $opt_p);

	# Create a client and load the Job IDs.
	my $client = Bric::Dist::Client->new({ url => $opt_U,
					     cookie => $cookie->as_string });
	$client->load_ids;

	# Send debugging info, if necessary.
	if ($opt_d) {
	    my $exec = $client->get_exec_ids;
	    $exec = !@$exec ? 'no Job IDs' : $#$exec > 0 ? "Job ID @$exec" :
	      "Job IDs @$exec";
	    local $" = ', ';
	    log_err("Sending $exec for execution.");
	}
	# Send the Job IDs.
	$client->send;
    };
    # Log any errors.
    log_err($@) if $@;
}

################################################################################

sub log_err {
    my ($err) = @_;
    # Log the error to the system log.
    if ($opt_d) {
	# Log more stuff and to STDERR for debugging.
	openlog($prog, LOG_PID | LOG_PERROR, LOG_USER);
	if (ref $err) {
	    syslog(LOG_ERR, "Debug: %s (%s line %d). Payload: %s",
		   $err->get_msg, $err->get_pkg, $err->get_line,
		   $err->get_payload || '');
	} else {
	    syslog(LOG_ERR, "Debug: %s", $err);
	}
    } else {
	# Just to regular logging.
	openlog($prog, LOG_PID, LOG_USER);
	if (ref $err) {
	    syslog(LOG_ERR, "Error: %s (%s line %d)", $err->get_msg,
		   $err->get_pkg, $err->get_line);
	} else {
	    syslog(LOG_ERR, "Error: %s", $err);
	}
    }
    closelog();
    # Identifier: LOG_PID   0x01    /* log the pid with each message */
    # Priority:   LOG_ERR   3       /* error conditions */
    # Facility:   LOG_USER  (1<<3)  /* random user-level messages */
}

################################################################################

sub usage {
    my $err = shift;
    print "\nERROR: $err\n" if $err;
    print qq{
Usage: $prog -f <secs>

Supported Options:
  -i Interval (in seconds) between checks for jobs to execute and expire.
     Default is 30 seconds.
  -U The distribution server URL including the protocol. Defaults is
     'http://localhost/dist/'.
  -u User login. All distribution jobs will be executed by this user. Required.
  -p User password. Required.
  -a IP Address from which the distribution requests will be sent to the
     distribution server. If not provided, $prog will do its best to figure
     out what the IP address is.
  -c Cron mode. Will run only once and then exit.
  -f An integer representing the number of times the script should fork.
     Useful for testing. Does not apply with -c.
  -d Print and log debugging data. This can be very verbose and fill up your
     logs, so use with care.
  -h Print this usage statement.
  -v Print the version number.

};
    exit;
}

################################################################################

sub version {
    print "\nBricolage Distribution Monitor version $VERSION\n";
    usage();
}

__END__

