/usr/share/perl5/Daemon/Generic/While1.pm

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.3;

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);
}


sub gd_run_body { die "must override gd_run_body()" }

1;

=head1 NAME

 Daemon::Generic::While1 - Daemon framework with default while(1) loop

=head1 SYNOPSIS

 @ISA = qw(Daemon::Generic::While1);

 sub gd_run_body {
	# stuff
 }

=head1 DESCRIPTION

This is a slight variation on L<Daemon::Generic>: a default
C<gd_run()> provided.  It has a while(1) loop that calls 
C<gd_run_body()> over and over.  It checks for reconifg and
and terminate events and only actions them between calls
to C<gd_run_body()>. 

Terminate events will be forced through after 
C<$Daemon::Generic::force_quit_delay> seconds if
C<gd_run_body()> doesn't return quickly enough.

=head1 SUBCLASS METHODS REQUIRD

The following method is required to be overridden to subclass
Daemon::Generic::While1:

=over 15

=item gd_run_body()

This method will be called over and over.  This method should
include a call to C<sleep(1)> (or a bit more).  Reconfig events
will not interrupt it.  Quit events will only interrupt it 
after 15 seconds.  

=back

=head1 ADDITIONAL METHODS

The following additional methods are available for your use
(as compared to L<Daemon::Generic>):

=over 15

=item gd_sleep($period)

This will sleep for C<$period> seconds but in one-second
intervals so that if a SIGINT or SIGHUP arrives the sleep
period can end more quickly.

Using this makes it safe for C<gd_run_body()> to sleep for
longer than C<$Daemon::Generic::force_quit_delay> seconds 
at a time.

=back

=head1 ADDITIONAL MEMBER DATA

The following additional bits of member data are defined:

=over 15

=item gd_sigint

The time at which an (unprocessed) SIGINT was recevied.

=item gd_sighup

The time at which an (unprocessed) SIGHUP was recevied.

=back

=head1 LICENSE

Copyright (C) 2006-2010 David Muir Sharnoff <muir@idiom.com>. 
Copyright (C) 2011 Google, Inc.
This module may be used and distributed on the same terms
as Perl itself.
libdaemon-generic-perl 0.81-0ubuntu1 / usr / share / perl5 / Daemon / Generic / While1.pm
