view release on metacpan or  search on metacpan

lib/Daemon/Generic/While1.pm  view on Meta::CPAN

package Daemon::Generic::While1;

use strict;
use warnings;
use Carp;
require Daemon::Generic;
require POSIX;
require Exporter;

our @ISA = qw(Daemon::Generic Exporter);
our @EXPORT = @Daemon::Generic::EXPORT;
our $VERSION = 0.84;

sub newdaemon
{
	local($Daemon::Generic::caller) = caller() || 'main';
	local($Daemon::Generic::package) = __PACKAGE__;
	Daemon::Generic::newdaemon(@_);
}

sub gd_setup_signals
{
	my ($self) = @_;
	$SIG{HUP} = sub {
		$self->{gd_sighup} = time;
	};
	my $child;
	$SIG{INT} = sub {
		$self->{gd_sigint} = time;
		#
		# We'll be getting a SIGTERM in a bit if we're not dead, so let's use it.
		#
		$SIG{TERM} = sub {
			$self->gd_quit_event(); 
			kill(15, $child) if $child;  # if we're still alive, let's stay that way
		};
	};
}

sub gd_sleep
{
	my ($self, $period) = @_;
	croak "Sleep period must be defined" unless defined $period;
	my $hires;
	if ($period*1000 != int($period*1000)) {
		$hires = 1;
		require Time::HiRes;
		import Time::HiRes qw(time sleep);
	}
	my $t = time;
	while (time - $t < $period) {
		return if $self->{gd_sigint};
		return if $self->{gd_sighup};
		if ($hires) {
			my $p = (time - $t < 1)
				? time - $t
				: 1;
			sleep($p);
		} else {
			sleep(1);
		}
	}
}

sub gd_run
{
	my ($self) = @_;
	while(1) {
		if ($self->{gd_sigint}) {
			$self->{gd_sigint} = 0;
			$self->gd_quit_event();
		}

		if ($self->{gd_sighup}) {
			$self->{gd_sighup} = 0;
			$self->gd_reconfig_event();
		}

		$self->gd_run_body();
	}
}

sub gd_reconfig_event
{
	my $self = shift;
	print STDERR "Reconfiguration requested\n";
	$self->gd_postconfig($self->gd_preconfig());
}

sub gd_quit_event
{
	print STDERR "Quitting...\n";
	exit(0);
}