1*f2a19305Safresh1#!/usr/bin/perl 2*f2a19305Safresh1 3*f2a19305Safresh1# Simplified example illustrating event handling and callback threads 4*f2a19305Safresh1 5*f2a19305Safresh1# Callback threads register their queues with the event handler thread. 6*f2a19305Safresh1# Events are passed to the event handler via a queue. 7*f2a19305Safresh1# The event handler then disseminates the event to the appropriately 8*f2a19305Safresh1# registered thread. 9*f2a19305Safresh1 10*f2a19305Safresh1use strict; 11*f2a19305Safresh1use warnings; 12*f2a19305Safresh1 13*f2a19305Safresh1use threads; 14*f2a19305Safresh1use Thread::Queue; 15*f2a19305Safresh1 16*f2a19305Safresh1MAIN: 17*f2a19305Safresh1{ 18*f2a19305Safresh1 # Queue for registering callbacks 19*f2a19305Safresh1 my $regis_q = Thread::Queue->new(); 20*f2a19305Safresh1 21*f2a19305Safresh1 # Queue for disseminating events 22*f2a19305Safresh1 my $event_q = Thread::Queue->new(); 23*f2a19305Safresh1 24*f2a19305Safresh1 # Create callback threads 25*f2a19305Safresh1 threads->create('CallBack', 'USR1', $regis_q)->detach(); 26*f2a19305Safresh1 threads->create('CallBack', 'USR2', $regis_q)->detach(); 27*f2a19305Safresh1 threads->create('CallBack', 'HUP', $regis_q)->detach(); 28*f2a19305Safresh1 threads->create('CallBack', 'ALRM', $regis_q)->detach(); 29*f2a19305Safresh1 30*f2a19305Safresh1 # Create event handler thread 31*f2a19305Safresh1 threads->create('EventHandler', $regis_q, $event_q)->detach(); 32*f2a19305Safresh1 33*f2a19305Safresh1 # Capture SIGUSR1 events 34*f2a19305Safresh1 $SIG{'USR1'} = sub { 35*f2a19305Safresh1 $event_q->enqueue('USR1'); # Send to event handler 36*f2a19305Safresh1 }; 37*f2a19305Safresh1 38*f2a19305Safresh1 # Capture SIGUSR1 events 39*f2a19305Safresh1 $SIG{'USR2'} = sub { 40*f2a19305Safresh1 $event_q->enqueue('USR2'); # Send to event handler 41*f2a19305Safresh1 }; 42*f2a19305Safresh1 43*f2a19305Safresh1 # Capture SIGHUP events 44*f2a19305Safresh1 $SIG{'HUP'} = sub { 45*f2a19305Safresh1 $event_q->enqueue('HUP'); # Send to event handler 46*f2a19305Safresh1 }; 47*f2a19305Safresh1 48*f2a19305Safresh1 # Capture SIGHUP events 49*f2a19305Safresh1 $SIG{'ALRM'} = sub { 50*f2a19305Safresh1 $event_q->enqueue('ALRM'); # Send to event handler 51*f2a19305Safresh1 alarm(5); # Reset alarm 52*f2a19305Safresh1 }; 53*f2a19305Safresh1 54*f2a19305Safresh1 # Ready 55*f2a19305Safresh1 print(<<_MSG_); 56*f2a19305Safresh1Send signals to PID = $$ 57*f2a19305Safresh1 (e.g., 'kill -USR1 $$') 58*f2a19305Safresh1Use ^C (or 'kill -INT $$') to terminate 59*f2a19305Safresh1_MSG_ 60*f2a19305Safresh1 61*f2a19305Safresh1 # Set initial alarm 62*f2a19305Safresh1 alarm(5); 63*f2a19305Safresh1 64*f2a19305Safresh1 # Just hang around 65*f2a19305Safresh1 while (1) { 66*f2a19305Safresh1 sleep(10); 67*f2a19305Safresh1 } 68*f2a19305Safresh1} 69*f2a19305Safresh1 70*f2a19305Safresh1### Subroutines ### 71*f2a19305Safresh1 72*f2a19305Safresh1sub EventHandler 73*f2a19305Safresh1{ 74*f2a19305Safresh1 my ($regis_q, $event_q) = @_; 75*f2a19305Safresh1 76*f2a19305Safresh1 my %callbacks; # Registered callback queues 77*f2a19305Safresh1 78*f2a19305Safresh1 while (1) { 79*f2a19305Safresh1 # Check for any registrations 80*f2a19305Safresh1 while (my ($event_type, $q) = $regis_q->dequeue_nb(2)) { 81*f2a19305Safresh1 if ($q) { 82*f2a19305Safresh1 $callbacks{$event_type} = $q; 83*f2a19305Safresh1 } else { 84*f2a19305Safresh1 warn("BUG: Bad callback registration for event type $event_type\n"); 85*f2a19305Safresh1 } 86*f2a19305Safresh1 } 87*f2a19305Safresh1 88*f2a19305Safresh1 # Wait for event 89*f2a19305Safresh1 if (my $event = $event_q->dequeue()) { 90*f2a19305Safresh1 # Send event to appropriate queue 91*f2a19305Safresh1 if (exists($callbacks{$event})) { 92*f2a19305Safresh1 $callbacks{$event}->enqueue($event); 93*f2a19305Safresh1 } else { 94*f2a19305Safresh1 warn("WARNING: No callback for event type $event\n"); 95*f2a19305Safresh1 } 96*f2a19305Safresh1 } 97*f2a19305Safresh1 } 98*f2a19305Safresh1} 99*f2a19305Safresh1 100*f2a19305Safresh1 101*f2a19305Safresh1sub CallBack 102*f2a19305Safresh1{ 103*f2a19305Safresh1 my $event_type = shift; # The type of event I'm handling 104*f2a19305Safresh1 my $regis_q = shift; 105*f2a19305Safresh1 106*f2a19305Safresh1 # Announce registration 107*f2a19305Safresh1 my $tid = threads->tid(); 108*f2a19305Safresh1 print("Callback thread $tid registering for $event_type events\n"); 109*f2a19305Safresh1 110*f2a19305Safresh1 # Register my queue for my type of event 111*f2a19305Safresh1 my $q = Thread::Queue->new(); 112*f2a19305Safresh1 $regis_q->enqueue($event_type, $q); 113*f2a19305Safresh1 114*f2a19305Safresh1 # Process loop 115*f2a19305Safresh1 while (1) { 116*f2a19305Safresh1 # Wait for event callback 117*f2a19305Safresh1 my $item = $q->dequeue(); 118*f2a19305Safresh1 # Process event 119*f2a19305Safresh1 print("Callback thread $tid notified of $item event\n") if $item; 120*f2a19305Safresh1 } 121*f2a19305Safresh1} 122*f2a19305Safresh1 123*f2a19305Safresh1# EOF 124