view release on metacpan or  search on metacpan

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

        }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 {
    my $msg = shift;

    syslog( 'debug', '%s', $msg ) if $syslog;
    _to_stderr( $msg ) if $verbose;
}

sub verbose {
    my $msg = shift;

    syslog( 'info', '%s', $msg ) if $syslog;
    _to_stderr( $msg ) if $verbose;
}

sub problem {
    my $msg = shift;

    daemon_error( $msg ) unless $nomail;
    syslog( 'err', '%s', $msg ) if $syslog;
    _to_stderr( $msg );
}

sub fatal {
    my $msg = shift;

    daemon_error( $msg ) unless $nomail;
    syslog( 'err', '%s', $msg ) if $syslog;
    _to_stderr( $msg );
    exit -1;
}

sub _to_stderr {
    my $msg = shift;

    my $tx = Time::HiRes::time();
    my $f  = $tx - int($tx);
    $f = sprintf('%.6f', $f);
    $f =~ s/^0\.//;
    my $t = strftime '%H:%M:%S', localtime($tx);
    print STDERR "[$$ $t.$f] $msg\n";

}

sub _send_trace {

    # email a stack trace to developer
    problem("sigusr2");
}


=head1 NAME

AC::Daemon - daemon program utility functions.

=head1 SYNOPSIS

    use AC::Daemon;
    use strict;

    initlog( 'program', 'local5' );
    daemonize( 5, 'program', \@ARGV ) unless $opt{foreground};
    verbose( 'starting.' );

    run_and_watch( $opt{foreground}, \&myfunction );
    exit;

=cut


1;