view release on metacpan or  search on metacpan

Control.pm  view on Meta::CPAN

    my $self = bless \%args, $class;

    die "No EXEC specified\n" unless $self->{EXEC};
    die "$self->{EXEC} doesn't exist\n" unless -e $self->{EXEC};
    die "$self->{EXEC} is not executable\n" unless -x $self->{EXEC};
    die "No PIDFILE specified\n" unless $self->{PIDFILE};
    my $piddir = dirname( $self->{PIDFILE} );
    die "Can't work out directory from path $self->{PIDFILE}\n" 
        unless $piddir
    ;
    unless ( -d $piddir )
    {
        warn "Creating $piddir ...\n" if $self->{VERBOSE};
        mkpath( $piddir ) or die "Can't create path $piddir\n";
    }
    unless ( -w $piddir )
    {
        die "can't create $self->{PIDFILE}\n";
    }
    if ( -e $self->{PIDFILE} )
    {
        die "$self->{PIDFILE} is not readable\n"
            unless -r $self->{PIDFILE}
        ;
        die "$self->{PIDFILE} is not writeable\n"
            unless -w $self->{PIDFILE}
        ;
    }
    if ( defined $self->{ARGS} )
    {
        die "ARGS should be an ARRAY ref\n" 
            unless ref( $self->{ARGS} ) eq 'ARRAY'
        ;
    }
    $self->{SLEEP} = 1 unless defined $self->{SLEEP};
    $self->{ARGS} ||= [];
    return $self;
}

sub running()
{
    my $self = shift;
    my $pid = $self->pid;
    return defined( $pid ) ? kill( 0, $self->{PID} ) : 0;
}

sub pid()
{
    my $self = shift;
    return unless -e $self->{PIDFILE};
    die "Can't read $self->{PIDFILE}\n" unless -r $self->{PIDFILE};
    open( PID, $self->{PIDFILE} ) 
        or die "Can't open pid file $self->{PIDFILE}\n"
    ;
    my $pid = <PID>;
    close( PID );
    return undef unless defined $pid;
    chomp( $pid );
    return undef unless $pid;
    die "$pid looks like a funny pid!\n"
        unless $pid =~ /^(\d+)$/
    ;
    return $self->{PID} = $1;
}

sub cmd()
{
    my $self = shift;
    my $cmd = shift;

    return if
        defined $self->{IGNOREFILE} and
        -e $self->{IGNOREFILE}
    ;
    unless ( defined $cmd )
    {
        die "CMD should be <start|stop|restart|status|hup>\n";
    }
    if ( $cmd eq 'status' )
    {
        return
            "$self->{EXEC} (",
            ( $self->pid ? $self->pid : "no pidfile $self->{PIDFILE}" ),
            ") is ", 
            ( $self->running ? '' : 'not ' ), 
            "running\n"
        ;
    }
    elsif ( $cmd eq 'start' )
    {
        die $self->status if $self->running;
        my $child = fork;
        if ( $child )
        {
            $SIG{CHLD} = 'IGNORE';
            warn "$self->{EXEC} @{$self->{ARGS}} ($child) started\n"
                if $self->{VERBOSE}
            ;
            if ( $self->{CREATE_PIDFILE} )
            {
                warn "Creating $self->{PIDFILE} ...\n" if $self->{VERBOSE};
                open( FH, ">$self->{PIDFILE}" ) 
                    or die "Can't write to $self->{PIDFILE}"
                ;
                print FH "$child\n";
                close( FH );
            }
            my $loop = 0;
            while( not $self->running )
            {
                warn $self->status if $self->{VERBOSE};
                sleep( $self->{SLEEP} );
                warn "is $self->{EXEC} ruinning (${loop}'th time)?\n"
                    if $self->{VERBOSE} and $loop
                ;
                if ( defined $self->{LOOP} and $loop++ == $self->{LOOP} )
                {
                    warn "Failed to start $self->{EXEC}\n"
                        if $self->{VERBOSE}
                    ;