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 print "HIT $signal\n";
  36                         Stem::Event::Queue::mark_not_empty() ;
  37                         push @signal_queue, $signal
  38                 } ;
  39
  40 # track the event object for this signal
  41
  42         $signal2event{$signal} = $self ;
  43
  44 #print "$signal = $SIG{ $signal }\n" ;
  45         return ;
  46 }
  47
  48 sub _cancel {
  49
  50         my( $self ) = @_ ;
  51
  52         $SIG{ $self->{'signal'} } = 'DEFAULT' ;
  53
  54         return ;
  55 }
  56
  57 sub process_signal_queue {
  58
  59         my $sig_count = @signal_queue ;
  60
  61 #print "PROCESS SIGNAL Q $sig_count\n" ;
  62
  63 # return if we have no pending signals
  64
  65         return $sig_count unless $sig_count ;
  66
  67         while( my $signal = shift @signal_queue ) {
  68
  69                 my $event = $signal2event{ $signal } ;
  70
  71                 next unless $event ;
  72                 next unless $event->{'active'} ;
  73
  74                 $event->trigger() ;
  75         }
  76
  77         return $sig_count ;
  78 }
  79
  80 1 ;