xref: /openbsd-src/gnu/usr.bin/perl/dist/Thread-Queue/examples/callback.pl (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
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