# 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 wit
+h 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', mess
+age=>'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 over
+ride the run method in your subclass to do something interesting inst
+ead 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; form
+at=flowed');
        $msg->send();
    };
    }
    if ($@) {
    $error .= ' Additionally, an error occurred sending the alert emai
+l: ' . $@;
    }
    die format_msg('**** DIE!!! **** ' . $error);
}

sub name {
    return __PACKAGE__;
}

1
[download]

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
[download]

#!/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
}
[download]

error_recipient: youremail@yourdomain.com
email_on_die: 1
sleep_for: 4
[download]

I have a couple of questions:
I'm interested in the suggestion by Kyle to not require a subclass of Demonize but rather just pass $demon->run() a code reference, but I'm not sure how to do that.

Would it look like this?

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

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

Would the Demonize class be setup to just call Foo's run method()? That can't be correct, because it doesn't make sense to me. Any suggestions?

I was also curious how I can fix die_to_log function. The way I'm currently doing this is to keep a copy of the current object in $_Demon so that die_to_log can access the object, but that seems wrong to me. I may be approaching this incorrectly, but it seems like I should be able to set SIG{__DIE__} to call an object method. Is that OK to do, or I am just leading myself down the wrong path to find a simple solution to handling death?

As always, thanks a lot, you've all helped me bone up on my Perl, something I've been slacking on for too long.