# This is a general-purpose daemon module.
# Extend this class and override the run method with your own.
# 
# Configuration is handled by YAML. 
# When instantiating a subclass of Demonize, pass configfile param with the name of the YAML config.
#
# For example: 
#
# package Foo;
# use Moose;
# extends 'My::Demonize';
# sub run() { my $self = shift; $self->logger->log(level=>'info', message=>'Foo this.'); }
#
# Instantiate Foo like this:
# my $foo = Foo->new(configfile=>'config.yml');
# 
#
# Created By: Keith Vance <next@take88.com>
# Created On: 11/28/2008
#

package My::Demonize;

use strict;
use warnings FATAL => 'all', NONFATAL => 'redefine';

use Moose;
extends 'My::Base';

use Proc::PID::File();
use POSIX;
use MIME::Lite();

our $_Demon;

has 'email_on_die' => (isa => 'Bool', is => 'rw');
has 'error_recipient' => (isa => 'Str', is => 'rw');
has 'sleep_for' => (isa => 'Int', is => 'rw');

sub BUILD {
    my $self = shift;

    if ($self->configfile) {
	$self->config(Config::YAML->new(config=>$self->configfile)); 
	$self->email_on_die($self->config->{email_on_die});
	$self->error_recipient($self->config->{error_recipient});
	$self->sleep_for($self->config->{sleep_for});
    } else {
	$self->logger->log(level=>'info', message=>'Demonize running with no configfile.');
    }
    
    if (!$self->sleep_for) {
	$self->sleep_for(10);
    }
}

sub start {
    my $self = shift;
    if (my $pid = fork()) {
	exit 0;
    }
    
    if (Proc::PID::File->running({name=>$self->name})) {
	die "Couldn't start: " . $self->name . " already running.";
    }
    
    $self->init_daemon;
}

sub init_daemon {
    my $self = shift;
    
    $_Demon = $self; ### I don't like this, it's here for die_to_log, How do I set SIG{__DIE__} to call an object method?
    $self->logger(Log::Dispatch::Syslog->new(
		      name => $self->name,
		      min_level => 'debug',
		      ident => 'Demonize',
		      facility => 'user'
		  ));

    printf "Starting: %s\n", $self->name;
    
    *CORE::GLOBAL::warn = \&warn_to_log;
    $SIG{__DIE__} = \&die_to_log;
    $SIG{__WARN__} = \&warn_to_log;
    
    eval {
	chdir '/' or die $!;
	open STDIN, '/dev/null' or die $!;
	$self->logger->log(level=>'info', message=>sprintf('Starting %s', $self->name));
	POSIX::setsid or die $!;
	$self->logger->log(level=>'info', message=>'Successful');
    };
    
    if ($@) {
	die "Couldn't start child '" . $self->name . "': $@";
    }
    
    local $SIG{CHLD} = 'IGNORE';
    $self->run;
}

sub stop {
    my $self = shift;
    my $pid;
    unless ($pid = Proc::PID::File->running({name=>$self->name})) {
	printf "%s not running\n", $self->name;
	return;
    }
    
    $| = 1;
    
    printf "Shutting down %s", $self->name;
    kill -3 => $pid;
    
    my $i = 0;
    while (kill (-0 => $pid) && $i++ < 30) {
	print '.';
	sleep 1;
    }
    
    unless (kill -0 => $pid) {
	print "\nShut down complete\n";
	return 0;
    }
    print "\nNot responding - sending kill signal\n";
    kill -9 => $pid;
    return;
}

sub status {
    my $self = shift;
    if (Proc::PID::File->running({name=>$self->name})) {
	printf "%s is running\n", $self->name;
    } else {
	printf "%s is not running\n", $self->name;
    }
    exit 0;
}

sub run {
    my $self = shift;
    
    while (1) {
	$self->logger->log(level=>'info', message=>"I'm not doing anything, I'm just sleeping for " . $self->sleep_for . " seconds. Please override the run method in your subclass to do something interesting instead of writing this log message.");
	sleep($self->sleep_for);
    }
}

sub warn_to_log {
    print format_msg('**** ' . $_[0]);
}

sub die_to_log {
    return if $^S;
    my $error = $_[0];
    my $self = $_Demon;
    if ($self->email_on_die) {
	eval {
	    my @to = ($self->error_recipient);
	    my $msg = MIME::Lite->new(
		From => $to[0],
		To => @to,
		Subject => 'Error running ' . $self->name,
		Data => $self->name . ".pm DIED\n" . $error,
		Encoding => 'quoted-printable'
		);
	    $msg->attr('content-type', => 'text/plain; charset=utf-8; format=flowed');
	    $msg->send();
	};
    }
    if ($@) {
	$error .= ' Additionally, an error occurred sending the alert email: ' . $@;
    }
    die format_msg('**** DIE!!! **** ' . $error);
}

sub name {
    return __PACKAGE__;
}

1


##</code><code>##

package My::Base;
use strict;
use Moose;
use Config::YAML;
use YAML::Node;

use Log::Dispatch::Syslog;

has 'configfile' => (isa => 'Str', is => 'rw');
has 'config' => (isa => 'Config::YAML', is => 'rw');
has 'logger' => (isa => 'Log::Dispatch::Syslog', is => 'rw');

sub BUILD {
    my $self = shift;
    $self->logger(Log::Dispatch::Syslog->new(
		      name => 'My::Base',
		      min_level => 'debug',
		      ident => 'My::Base',
		      facility => 'user'
		  ));
    return $self;
}
1

##</code><code>##

#!/usr/bin/perl -w

use strict;

use My::Demonize;

use Data::Dumper;

my $command = shift @ARGV || '';
my $demon = My::Demonize->new(configfile=>'config.yml');
if ($command eq 'start') {
    exit $demon->start;
} elsif ($command eq 'restart') {
    $demon->stop;
    exit $demon->start;
} elsif ($command eq 'stop') {
    $demon->stop;
} elsif ($command eq 'status') {
    $demon->status;
} else {
    die <<USAGE;
Usage : $0 stop|start|restart|status
USAGE
}

##</code><code>##

error_recipient: youremail@yourdomain.com
email_on_die: 1
sleep_for: 4

##</code><code>##

package My::Foo;
use Moose;
use 'My::Demonize';
sub run {
   my $self = shift;
   print "Hello World (how un-original)\n";
}

##</code><code>##

#!/usr/bin/perl -w
use strict;
use 'My::Foo';
my $foo = My::Foo->new;
my $demon = My::Demonize->new;
$demon->run(\$foo);