File Coverage

blib/lib/Daemon/Easy.pm

Criterion	Covered	Total	%
statement	25	78	32.0
branch	3	38	7.8
condition	4	14	28.5
subroutine	6	12	50.0
pod	0	4	0.0
total	38	146	26.0

package Daemon::Easy;

use 5.008008;
use strict;
use warnings;
use POSIX;

our $VERSION = '0.02';


sub import{
    my $class       = shift;
    my %args        = ( (@_ and ref($_[0])) ? %{$_[0]} : @_ ) or ();

    $args{sleep} = 5 unless defined $args{sleep};
    $args{pidfile} ||= "$0.pid";
    $args{stopfile} ||= "$0.stop";
    $args{callback} ||= 'worker';

    no strict 'refs';
    $args{worker} = \&{caller()."::$args{callback}"};
    *{caller()."::run"} = sub{
        unshift @_, \%args;
        goto &_run;
    };
}

sub _run{
    my ($args,$cmd) = @_;
    $cmd ||= $ARGV[0];

    $cmd = lc $cmd;
    if( $cmd eq 'start' ){
        if(my $status = status($args)){
            print "the daemon is running with pid: $status\n";
            exit;
        }
        start($args);
    }elsif( $cmd eq 'stop' ){
        stop($args);
    }elsif( $cmd eq 'status' ){
        if ( status($args) ){
            print "the daemon is running with pid: ".status($args)."\n";
        }else{
            print "the daemon stopped\n";
        }
    }elsif( $cmd eq 'restart' ){
        stop($args);
        sleep(3) while(status($args));
        start($args);
    }else{
        usage();
    }
}

sub usage{
    print "usage:\n\t $0 [start stop restart status]\n" ;
    exit;
}

sub start{
    my $args = shift;
    my $pid = fork();
    die "cant fork, $!\n" unless defined $pid;

    if($pid){ # parent, remember the child pid, and exit
        open PID,">$args->{pidfile}" or die "cant open $args->{pidfile}, $!\n";
        print PID $pid;
        close PID;
        exit(0);
    }

    POSIX::setsid();

    unlink ($args->{stopfile}) if( -e $args->{stopfile} );

    while(1){
        eval { $args->{worker}->(); };
        if($@){
            print $@;
            last;
        }
        sleep($args->{sleep}) if $args->{sleep};
        if(-e $args->{stopfile} ){
            unlink($args->{stopfile});
            last;
        }
    }

    unlink ($args->{pidfile});
}

sub stop{
    my $args = shift;
    open FH, ">$args->{stopfile}" or die "cant create $args->{stopfile}, $!\n";
    close FH;
}

# check status, 0 if stoped, pid if running
sub status{
    my $args = shift;
    if(-e $args->{pidfile} ){
        open PID,$args->{pidfile} or die "cant open $args->{pidfile}, $!\n";
        my $pid=; chomp $pid;
        close PID;
        return $pid;
    }else{
        return 0;
    }
}

1;
__END__