lib/Stem/Event/Signal.pm

   1 package Stem::Event::Signal ;
   2
   3 use Stem::Event::Queue ;
   4
   5 use strict ;
   6 use warnings ;
   7
   8 use base 'Exporter' ;
   9 our @EXPORT = qw( process_signal_queue ) ;
  10
  11 # this generic signal event code needs the safe signals of perl 5.8+
  12
  13 use 5.008 ;
  14
  15 my %signal2event ;
  16
  17 my @signal_queue ;
  18 my %cached_handlers ;
  19
  20 # this sub will cache the handler closures so we can reuse them.
  21
  22 sub _build {
  23
  24         my( $self ) = @_ ;
  25
  26         my $signal = $self->{'signal'} ;
  27
  28         $self->{'method'} ||= "sig_\L${signal}_handler" ;
  29
  30 # create the signal event handler and cache it.
  31 # we cache them so we can reuse these closures and never leak
  32
  33         $SIG{ $signal } = $cached_handlers{$signal} ||=
  34                 sub {
  35                         Stem::Event::Queue::queue_has_event() ;
  36                         push @signal_queue, $signal
  37                 } ;
  38
  39 # track the event object for this signal
  40
  41         $signal2event{$signal} = $self ;
  42
  43 #print "$signal = $SIG{ $signal }\n" ;
  44
  45 # make sure the event queue is set up so we can handle signals in the
  46 # event loop
  47
  48         Stem::Event::Queue::_init_event_queue() ;
  49
  50         return ;
  51 }
  52
  53 sub _cancel {
  54
  55         my( $self ) = @_ ;
  56
  57         $SIG{ $self->{'signal'} } = 'DEFAULT' ;
  58
  59         return ;
  60 }
  61
  62 sub process_signal_queue {
  63
  64         my $sig_count = @signal_queue ;
  65
  66 #print "PROCESS SIGNAL Q $sig_count\n" ;
  67
  68 # return if we have no pending signals
  69
  70         return $sig_count unless $sig_count ;
  71
  72         while( my $signal = shift @signal_queue ) {
  73
  74                 my $event = $signal2event{ $signal } ;
  75
  76                 next unless $event ;
  77                 next unless $event->{'active'} ;
  78
  79                 $event->trigger() ;
  80         }
  81
  82         return $sig_count ;
  83 }
  84
  85 1 ;