modules/fallback/Daemon/Generic/Event.pm

   1
   2 # Copyright (C) 2006, David Muir Sharnoff <muir@idiom.com>
   3
   4 package Daemon::Generic::Event;
   5
   6 use strict;
   7 use warnings;
   8 require Daemon::Generic;
   9 require Event;
  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 = shift;
  26         my $reload_event = Event->signal(
  27                 signal  => 'HUP',
  28                 desc    => 'reload on SIGHUP',
  29                 prio    => 6,
  30                 cb      => sub {
  31                         $self->gd_reconfig_event;
  32                         $self->{gd_timer}->cancel()
  33                                 if $self->{gd_timer};
  34                         $self->gd_setup_timer();
  35                 },
  36         );
  37         my $quit_event = Event->signal(
  38                 signal  => 'INT',
  39                 cb      => sub { $self->gd_quit_event; },
  40         );
  41 }
  42
  43 sub gd_setup_timer
  44 {
  45         my $self = shift;
  46         if ($self->can('gd_run_body')) {
  47                 my $interval = ($self->can('gd_interval') && $self->gd_interval()) || 1;
  48                 $self->{gd_timer} = Event->timer(
  49                         cb              => [ $self, 'gd_run_body' ],
  50                         interval        => $interval,
  51                         hard            => 0,
  52                 );
  53         }
  54 }
  55
  56 sub gd_run
  57 {
  58         my $self = shift;
  59         $self->gd_setup_timer();
  60         Event::loop();
  61 }
  62
  63 sub gd_quit_event
  64 {
  65         my $self = shift;
  66         print STDERR "Quitting...\n";
  67         Event::unloop_all();
  68 }
  69
  70 1;
  71
  72 =head1 NAME
  73
  74  Daemon::Generic::Event - Generic daemon framework with Event.pm
  75
  76 =head1 SYNOPSIS
  77
  78  use Daemon::Generic::Event;
  79
  80  @ISA = qw(Daemon::Generic::Event);
  81
  82  sub gd_preconfig {
  83         # stuff
  84  }
  85
  86 =head1 DESCRIPTION
  87
  88 Daemon::Generic::Event is a subclass of L<Daemon::Generic> that
  89 predefines some methods:
  90
  91 =over 15
  92
  93 =item gd_run()
  94
  95 Setup a periodic callback to C<gd_run_body()> if there is a C<gd_run_body()>.
  96 Call C<Event::loop()>.
  97
  98 =item gd_setup_signals()
  99
 100 Bind SIGHUP to call C<gd_reconfig_event()>.
 101 Bind SIGINT to call C<gd_quit_event()>.
 102
 103 =back
 104
 105 To use Daemon::Generic::Event, you have to provide a C<gd_preconfig()>
 106 method.   It can be empty if you have a C<gd_run_body()>.
 107
 108 Set up your own events in C<gd_preconfig()> and C<gd_postconfig()>.
 109
 110 If you have a C<gd_run_body()> method, it will be called once per
 111 second or every C<gd_interval()> seconds if you have a C<gd_interval()>
 112 method.  Unlike in L<Daemon::Generic::While1>, C<gd_run_body()> should
 113 not include a call to C<sleep()>.
 114
 115 =head1 THANK THE AUTHOR
 116
 117 If you need high-speed internet services (T1, T3, OC3 etc), please
 118 send me your request-for-quote.  I have access to very good pricing:
 119 you'll save money and get a great service.
 120
 121 =head1 LICENSE
 122
 123 Copyright(C) 2006 David Muir Sharnoff <muir@idiom.com>.
 124 This module may be used and distributed on the same terms
 125 as Perl itself.
 126