view release on metacpan or  search on metacpan

lib/AC/Daemon.pm  view on Meta::CPAN

# Function: daemonization + logging
#
# $Id$

package AC::Daemon;
use AC::Import;
use Sys::Syslog;
use Time::HiRes;
use POSIX;
use strict;

BEGIN {
    # use it if we've got it
    eval {
        require AC::Error; AC::Error->import();
    };
    if($@){
        *daemon_error = sub {};
        *stack_trace  = sub {};
    }
}

our @EXPORT = qw(daemonize run_and_watch initlog debugmsg verbose problem fatal);

my $childpid;
my $verbose = 1;
my $nomail  = 0;
my $syslog;
my @maybe_argv = @ARGV;	# save for restart (might not be available)

sub daemonize {
    my $tout = shift;
    my $name = shift;
    my $argv = shift;

    fork && exit;	# background ourself
    $verbose = 0;

    my @argv = $argv ? @$argv : @maybe_argv;

    close STDIN;        open( STDIN,  "/dev/null" );
    close STDOUT;       open( STDOUT, "> /dev/null" );
    close STDERR;       open( STDERR, "> /dev/null" );
    setsid();

    $SIG{QUIT} = $SIG{INT} = $SIG{TERM} = sub { _signal($name, @_) };

    if( $name ){
        # save pid file
        open(PID, "> /var/run/$name.pid");
        print PID "$$\n";
        print PID "# @argv\n";
        close PID;
    }

    # run as 2 processes
    while(1){
	$childpid = fork;
	die "cannot fork: $!\n" unless defined $childpid;
        if( $childpid ){
            # parent
            wait;
            $childpid = undef;
            sleep $tout;
        }else{
            # child
            return;
        }
    }
}

sub _signal {
    my $name = shift;

    verbose( "caught signal SIG$_[0] - exiting" );

    if( $childpid > 1 ){
	# kill child process + wait for it to exit
        unlink "/var/run/$name.pid" if $name;
        kill "TERM", $childpid;
        wait;
    }

    exit;
}

sub initlog {
    my $name  = shift;
    my $facil = shift;
    my $quiet = shift;
    my $verb  = shift;

    unless( $syslog ){
        openlog( $name, 'ndelay, pid', $facil );
        $syslog = 1;
    }

    $nomail  = $quiet;
    $verbose = $verb if defined $verb;
}

sub run_and_watch {
    my $optf = shift;
    my $func = shift;

    $SIG{USR2} = \&_send_trace;

    eval {
	$func->();
    };
    if( my $e = $@ ){
	if( $optf ){
	    $e .= "\n\n" . stack_trace();
	    verbose( "UNCAUGHT ERROR: $e" );
	}else{
	    fatal( "UNCAUGHT ERROR: $e" );
	}
    }
}

sub debugmsg {