package Boilerplate;

# Copyright (c) 2003-2005, Geoff Broadwell; this module is released
# as open source and may be distributed and modified under the terms
# of either the Artistic License or the GNU General Public License,
# in the same manner as Perl itself.  These licenses should have been
# distributed to you as part of your Perl distribution, and can be
# read using `perldoc perlartistic` and `perldoc perlgpl` respectively.


use strict;
use warnings;

use Cwd;
use File::Basename;
use IO::File;
use POSIX qw( :signal_h setsid WNOHANG );
use Sys::Hostname;
use Sys::Syslog;
use Time::HiRes 'time';

our $VERSION = v0.1.1;

sub import
{
    my $class = caller();
    my $prog = bless {} => $class;

    no strict 'refs';
    push @{"$class\::ISA"}, __PACKAGE__;
    ${"$class\::PROGRAM"} = $prog;
    *{"$class\::config"} = sub { $prog->conf(@_) };

    $prog->log_buffer(debug => "Boilerplate imported.\n");
    $prog->conf_set_defaults_bp;
}

sub main
{
    my $self = shift;

    $self->prog_init;
    $self->main_function;
    $self->prog_cleanup;
}

sub main_function
{
    die "No main_function defined!\n";
}

sub main_stop
{
    my $self = shift;

    $self->log(debug => "Stopping main processing.\n");
    $self->{done} = 1;
}

sub prog_init
{
    my $self = shift;

    $self->log_buffer(info => "Initializing.\n");
    $self->sig_install_handlers;
    $self->configure;
    $self->log_init;
    $self->io_init;

    $self->log(debug => "Marking main processing ready.\n");
    $self->{done} = 0;
}

sub prog_cleanup
{
    my $self = shift;

    $self->log(info => "Cleaning up.\n");
    $self->prog_stop_all;
    # ???
}

sub prog_stop_all
{
    my $self = shift;

    $self->main_stop;
    $self->proc_stop_children;
    $self->io_stop;
    $self->log_stop;
    # ???
}

sub proc_stop_children
{
    my $self = shift;

    # XXXX: only if children exist?
    $self->log(debug => "Stopping children.\n");
    # ???
}

sub proc_reap_children
{
    my $self = shift;

    # ???
}

sub prog_restart
{
    my $self = shift;

    $self->log(info => "Restarting program.\n");
    $self->prog_cleanup;
    $self->prog_main;
}

sub sig_install_handlers
{
    my $self = shift;

    # XXXX: May be just log() if moved to end of init 
    $self->log_buffer(debug => "Installing signal handlers.\n");

    $SIG{CHLD} = sub { $self->log(debug  => "Caught SIGCHLD, reaping.\n");
		       $self->proc_reap_children };
    $SIG{HUP}  = sub { $self->log(notice => "Caught SIGHUP, restarting.\n");
		       $self->prog_restart };

    $SIG{PIPE} = $SIG{INT} = $SIG{QUIT} = sub { $self->sig_catch };
    # XXXX: Should PIPE reap the handle gracefully?

    $SIG{__DIE__} = sub { $self->prog_cleanup };
    # XXXX: Log __DIE__ ?
    # XXXX: Capture __WARN__ and log it?

    # XXXX: USR1 and USR2?

    # XXXX: Do we capture WINCH, or does the terminal library?
}

sub sig_catch
{
    my $self = shift;
    my $sig = shift;

    $self->log(notice => "Caught SIG$sig, initiating cleanup and exit.\n");
    $self->prog_cleanup;
    exit 0;
}

sub debug_dump
{
    my $self = shift;

    use Data::Dumper;
    die Dumper(@_);
}

sub configure
{
    my $self = shift;

    $self->log_buffer(debug => "Configuring.\n");
    $self->conf_init;
    $self->conf_set_defaults;
    $self->conf_revert_to_defaults;
    $self->conf_read;
}

sub conf_init
{
    my $self = shift;

    $self->log_buffer(debug => "Clearing configuration and merged defaults.\n");
    delete $self->{defaults};
    delete $self->{conf};
}

sub conf_set_defaults_bp
{
    my $self = shift;
    my $defaults = $self->conf_parse_text(<<DEFAULTS_BP);

    conf.files     = [prog.name].conf
    log.facility   = local0
    log.file       = 1
    log.log_dir    = .
    log.log_file   = [prog.name].log
    log.log_path   = [log.log_dir]/[log.log_file]
    log.syslog     = 0
    proc.pid_dir   = /var/run
    proc.pid_file  = [prog.name].pid
    proc.pid_path  = [proc.pid_dir]/[proc.pid_file]
    proc.run_user  = nobody
    proc.run_group = nogroup
    prog.server    = 0

DEFAULTS_BP

    $self->log_buffer(debug => "Setting boilerplate defaults.\n");
    $defaults->{'prog.name'} = basename $0;
    $self->{defaults_bp} = $defaults;
}

sub conf_set_defaults
{
    my $self = shift;

    $self->log_buffer(debug => "Merging boilerplate and program defaults.\n");
    $self->{defaults} = $self->conf_merge($self->{defaults_bp},
					  $self->{defaults_prog});
}

sub conf_revert_to_defaults
{
    my $self = shift;

    $self->log_buffer(debug => "Configuring with defaults.\n");
    $self->{conf} = {%{$self->{defaults}}};
}

sub conf_parse_text
{
    my $self = shift;
    my %conf;

    foreach my $chunk (@_) {
	next unless $chunk;
	foreach (split /\n/ => $chunk) {
	    s/^\s+//;
	    s/^#.*//;
	    s/\s+$//;
	    next unless /\S/;
	    my ($k, $v) = split /\s*=\s*/, $_, 2;
	    $conf{$k} = $v;
	}
    }

    return \%conf;
}

sub conf_merge
{
    my $self = shift;

    return { map { %{ ref $_ ? $_
			     : $self->conf_parse_text($_)
                    } } @_ };
}

sub conf_read
{
    my $self = shift;
    my @files = $self->conf_split_list($self->conf('conf.files'));
    my @chunks;

    $self->log_buffer(debug => "Attempting to read config files.\n");
    foreach my $file (@files) {
	if (-r $file) {
	    local $/;
	    open my $config, '<', $file
		or die "Mysteriously unreadable config file '$file': $!\n";
	    $self->log_buffer(debug => "Reading config file '$file'.\n");
	    push @chunks, <$config>;
	}
    }

    $self->{conf} = $self->conf_merge($self->{conf}, @chunks) if @chunks;
}

sub conf
{
    my $self = shift;
    my $key = shift;

    return $self->conf_interpolate($self->{conf}{$key});
}

sub conf_interpolate
{
    my $self = shift;
    my $value = shift;
    my %seen;

    return unless $value;
    while ($value =~ /\[([^\[]+)\]/) {
	my $key = $1;
	die "Recursive interpolation caught in config entry '$value'.\n"
	    if $seen{$key}++;
	$value =~ s/\[($key)\]/$self->{conf}{$key}/eg;
    }

    return $value;
}

sub conf_split_list
{
    my $self = shift;
    my $value = shift;

    return unless defined $value;
    return split /\s*,\s*/ => $value;
}

sub log_init
{
    my $self = shift;

    $self->log_buffer(debug => "Initializing logging.\n");
    if ($self->conf('log.file')) {
	my $path = $self->conf('log.log_path');
	$self->log_buffer(debug => "Opening log file '$path'.\n");
	open my $fh, '>>', $path
	    or die "Could not open log file '$path': $!\n";
	$self->{log_fh} = $fh;
    }

    if ($self->conf('log.syslog')) {
	my $name = $self->conf('prog.name');
	my $facility = $self->conf('log.facility');
	$self->log_buffer(debug =>
	    "Opening syslog with name '$name' and facility '$facility'.\n");
	openlog($name, 'pid', $facility)
	    or die "Could not connect to syslog: $!\n";
    }

    $self->log(debug => "Initiated logging.\n");
    $self->log_flush;
}

sub log
{
    my $self = shift;
    my ($priority, @msg) = @_;
    my $msg = join '' => @msg;

    if ($msg !~ /\n$/) {
	my ($package, $filename, $line) = caller;
	$msg .= " at $filename line $line\n";
    }

    # XXXX: fallback between methods if both available?
    if ($self->conf('log.file')) {
	# Log information normally provided by syslog
	my $time_stamp = $self->time_stamp;
	my $name = $self->conf('prog.name');
	my $facility = $self->conf('log.facility');
	my $hostname = hostname;
	print {$self->{log_fh}}
	    "$time_stamp $hostname $name\[$$] $facility/$priority: $msg"
	    or die "Could not log to log file: $!\n";
    }

    if ($self->conf('log.syslog')) {
	syslog($priority, $msg)
	    or die "Could not log to syslog: $!\n";
    }
}

sub log_buffer
{
    my $self = shift;

    push @{$self->{log_buffer}}, [@_];
}

sub log_flush
{
    my $self = shift;

    $self->log(debug => "Flushing queued log messages.\n");
    if ($self->{log_buffer}) {
	foreach my $entry (@{$self->{log_buffer}}) {
	    $self->log(@$entry);
	}
	delete $self->{log_buffer};
    }

    if ($self->conf('log.file')) {
	$self->{log_fh}->flush if $self->{log_fh};
    }

    $self->log(debug => "Queued log messages flushed.\n");
}

sub log_stop
{
    my $self = shift;

    $self->log_flush;
    $self->log(debug => "Stopping logging.\n");

    if ($self->conf('log.file')) {
	close $self->{log_fh}
	    or die "Unable to close log file: $!\n";
	delete $self->{log_fh};
    }

    if ($self->conf('log.syslog')) {
	closelog()
	    or die "Unable to close syslog: $!\n";
    }
}

sub io_init
{
    my $self = shift;

    $self->log(debug => "Initializing I/O.\n");
    $| = 1;
    # ???
}

sub io_flush
{
    my $self = shift;

    # ???
}

sub io_stop
{
    my $self = shift;

    $self->log(debug => "Stopping I/O.\n");
    $self->io_flush;
    # ???
}

sub time_stamp
{
    my $self = shift;
    my $time = shift || time;
    my $frac_sec = $time - int($time);
    my $fraction;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($time);

    $year += 1900;
    $mon++;
    $fraction = $frac_sec ? sprintf('%.6f' => $frac_sec) : '';
    $fraction =~ s/^0//;

    return sprintf "%4d-%02d-%02d %02d:%02d:%02d%s",
	$year, $mon, $mday, $hour, $min, int($sec), $fraction;
}


1;

__END__

Minimal program using this module:

^<<
#!/usr/bin/perl

use strict;
use warnings;
use Boilerplate;

our $PROGRAM;
$PROGRAM->main;

sub main_function
{
    print "Got to main function!\n";

    $PROGRAM->debug_dump($PROGRAM);

    # Do whatever is real task
}
^>>


Matching .conf file for test purposes:

^<<
# This is a test

test = foo
^>>
 

Defined keys of $PROGRAM:
# Non-string types in []

conf           Current program configuration
defaults       All program defaults
defaults_bp    Defaults provided by boilerplate
defaults_prog  Defaults provided my main program
done           [Boolean] True to stop processing, false to run
log_buffer     [AOA], each inner array is a list of args to log()
log_fh         Filehandle of log file, if one is open.


Defined conf keys:
# Non-string types in []

conf.files     List of configuration files to be read in order
log.facility   Syslog facility to log as
log.file       [Boolean] True to log to a file
log.log_dir    Location of logfile directory
log.log_file   Name of logfile
log.log_path   Full path to logfile
log.syslog     [Boolean] True to log to syslog
proc.pid_dir   Location of pidfile directory
proc.pid_file  Name of pidfile
proc.pid_path  Full path to pidfile
proc.run_user  User for server to drop priveleges to
proc.run_group Group for server to drop priveleges to
prog.name      Program's short name
prog.server    True if this program is a server


Defaults for defined conf keys:
# [foo]   indicates runtime interpolation of conf value for key 'foo'
# {code}  indicates interpolation of return value of 'code' 

conf.files     [prog.name].conf
log.facility   local0
log.file       1
log.log_dir    .
log.log_file   [prog.name].log
log.log_path   [log.log_dir]/[log.log_file]
log.syslog     0
proc.pid_dir   /var/run
proc.pid_file  [prog.name].pid
proc.pid_path  [proc.pid_dir]/[proc.pid_file]
proc.run_user  nobody
proc.run_group nogroup
prog.name      {basename $0}
prog.server    0