modules/fallback/Daemon/Generic/While1.pm

   1 # Copyright (C) 2006, David Muir Sharnoff <muir@idiom.com>
   2
   3 package Daemon::Generic::While1;
   4
   5 use strict;
   6 use warnings;
   7 use Carp;
   8 require Daemon::Generic;
   9 require POSIX;
  10 require Exporter;
  11
  12 our @ISA = qw(Daemon::Generic Exporter);
  13 our @EXPORT = @Daemon::Generic::EXPORT;
  14 our $VERSION = 0.3;
  15
  16 sub newdaemon
  17 {
  18         local($Daemon::Generic::caller) = caller() || 'main';
  19         local($Daemon::Generic::package) = __PACKAGE__;
  20         Daemon::Generic::newdaemon(@_);
  21 }
  22
  23 sub gd_setup_signals
  24 {
  25         my ($self) = @_;
  26         $SIG{HUP} = sub {
  27                 $self->{gd_sighup} = time;
  28         };
  29         my $child;
  30         $SIG{INT} = sub {
  31                 $self->{gd_sigint} = time;
  32                 #
  33                 # We'll be getting a SIGTERM in a bit if we're not dead, so let's use it.
  34                 #
  35                 $SIG{TERM} = sub {
  36                         $self->gd_quit_event();
  37                         kill(15, $child) if $child;  # if we're still alive, let's stay that way
  38                 };
  39         };
  40 }
  41
  42 sub gd_sleep
  43 {
  44         my ($self, $period) = @_;
  45         croak "Sleep period must be defined" unless defined $period;
  46         my $hires;
  47         if ($period*1000 != int($period*1000)) {
  48                 $hires = 1;
  49                 require Time::HiRes;
  50                 import Time::HiRes qw(time sleep);
  51         }
  52         my $t = time;
  53         while (time - $t < $period) {
  54                 return if $self->{gd_sigint};
  55                 return if $self->{gd_sighup};
  56                 if ($hires) {
  57                         my $p = (time - $t < 1)
  58                                 ? time - $t
  59                                 : 1;
  60                         sleep($p);
  61                 } else {
  62                         sleep(1);
  63                 }
  64         }
  65 }
  66
  67 sub gd_run
  68 {
  69         my ($self) = @_;
  70         while(1) {
  71                 if ($self->{gd_sigint}) {
  72                         $self->{gd_sigint} = 0;
  73                         $self->gd_quit_event();
  74                 }
  75
  76                 if ($self->{gd_sighup}) {
  77                         $self->{gd_sighup} = 0;
  78                         $self->gd_reconfig_event();
  79                 }
  80
  81                 $self->gd_run_body();
  82         }
  83 }
  84
  85 sub gd_reconfig_event
  86 {
  87         my $self = shift;
  88         print STDERR "Reconfiguration requested\n";
  89         $self->gd_postconfig($self->gd_preconfig());
  90 }
  91
  92 sub gd_quit_event
  93 {
  94         print STDERR "Quitting...\n";
  95         exit(0);
  96 }
  97
  98
  99 sub gd_run_body { die "must override gd_run_body()" }
 100
 101 1;
 102
 103 =head1 NAME
 104
 105  Daemon::Generic::While1 - Daemon framework with default while(1) loop
 106
 107 =head1 SYNOPSIS
 108
 109  @ISA = qw(Daemon::Generic::While1);
 110
 111  sub gd_run_body {
 112         # stuff
 113  }
 114
 115 =head1 DESCRIPTION
 116
 117 This is a slight variation on L<Daemon::Generic>: a default
 118 C<gd_run()> provided.  It has a while(1) loop that calls
 119 C<gd_run_body()> over and over.  It checks for reconifg and
 120 and terminate events and only actions them between calls
 121 to C<gd_run_body()>.
 122
 123 Terminate events will be forced through after
 124 C<$Daemon::Generic::force_quit_delay> seconds if
 125 C<gd_run_body()> doesn't return quickly enough.
 126
 127 =head1 SUBCLASS METHODS REQUIRD
 128
 129 The following method is required to be overridden to subclass
 130 Daemon::Generic::While1:
 131
 132 =over 15
 133
 134 =item gd_run_body()
 135
 136 This method will be called over and over.  This method should
 137 include a call to C<sleep(1)> (or a bit more).  Reconfig events
 138 will not interrupt it.  Quit events will only interrupt it
 139 after 15 seconds.
 140
 141 =back
 142
 143 =head1 ADDITIONAL METHODS
 144
 145 The following additional methods are available for your use
 146 (as compared to L<Daemon::Generic>):
 147
 148 =over 15
 149
 150 =item gd_sleep($period)
 151
 152 This will sleep for C<$period> seconds but in one-second
 153 intervals so that if a SIGINT or SIGHUP arrives the sleep
 154 period can end more quickly.
 155
 156 Using this makes it safe for C<gd_run_body()> to sleep for
 157 longer than C<$Daemon::Generic::force_quit_delay> seconds
 158 at a time.
 159
 160 =back
 161
 162 =head1 ADDITIONAL MEMBER DATA
 163
 164 The following additional bits of member data are defined:
 165
 166 =over 15
 167
 168 =item gd_sigint
 169
 170 The time at which an (unprocessed) SIGINT was recevied.
 171
 172 =item gd_sighup
 173
 174 The time at which an (unprocessed) SIGHUP was recevied.
 175
 176 =back
 177
 178 =head1 THANK THE AUTHOR
 179
 180 If you need high-speed internet services (T1, T3, OC3 etc), please
 181 send me your request-for-quote.  I have access to very good pricing:
 182 you'll save money and get a great service.
 183
 184 =head1 LICENSE
 185
 186 Copyright(C) 2006 David Muir Sharnoff <muir@idiom.com>.
 187 This module may be used and distributed on the same terms
 188 as Perl itself.
 189