Coro/Coro/Signal.pm

=head1 NAME

Coro::Signal - coroutine signals (binary semaphores)

=head1 SYNOPSIS

 use Coro::Signal;

 $sig = new Coro::Signal;

 $sig->wait; # wait for signal

 # ... some other "thread"

 $sig->send;

=head1 DESCRIPTION

This module implements signal/binary semaphores/condition variables
(basically all the same thing). You can wait for a signal to occur or send
it, in which case it will wake up one waiter, or it can be broadcast,
waking up all waiters.

=over 4

=cut

package Coro::Signal;

BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }

use Coro ();

$VERSION = 4.749;

=item $s = new Coro::Signal;

Create a new signal.

=cut

sub new {
   # [flag, [pid's]]
   bless [], $_[0];
}

=item $s->wait

Wait for the signal to occur. Returns immediately if the signal has been
sent before.

Signals are not reliable: this function might return spuriously without
the signal being sent. This means you must always test for the condition
you are waiting for.

(If this is a real problem for you the situation might be remedied in a
future version).

=item $status = $s->timed_wait ($timeout)

Like C<wait>, but returns false if no signal happens within $timeout
seconds, otherwise true.

See C<wait> for some reliability concerns.

=cut

sub wait {
   unless (delete $_[0][0]) {
      push @{$_[0][1]}, $Coro::current;
      &Coro::schedule;
   }
}

sub timed_wait {
   require Coro::Timer;
   my $timeout = Coro::Timer::timeout($_[1]);

   unless (delete $_[0][0]) {
      push @{$_[0][1]}, $Coro::current;
      &Coro::schedule;

      return 0 if $timeout;
   }

   1
}

=item $s->send

Send the signal, waking up I<one> waiting process or remember the signal
if no process is waiting.

=cut

sub send {
   $_[0][0] = 1;
   (shift @{$_[0][1]})->ready if @{$_[0][1]};
}

=item $s->broadcast

Send the signal, waking up I<all> waiting process. If no process is
waiting the signal is lost.

=cut

sub broadcast {
   if (my $waiters = delete $_[0][1]) {
      $_->ready for @$waiters;
   }
}

=item $s->awaited

Return true when the signal is being awaited by some process.

=cut

sub awaited {
   ! ! @{$_[0][1]}
}

1;

=back

=head1 BUGS

This implementation is not currently very robust when the process is woken
up by other sources, i.e. C<wait> might return early.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.64
Committed:	Mon Sep 29 12:40:50 2008 UTC (15 years, 8 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_479
Changes since 1.63:	+1 -1 lines
Log Message:	4.479
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.2	Coro::Signal - coroutine signals (binary semaphores)
4	root	1.1
5			=head1 SYNOPSIS
6
7			use Coro::Signal;
8
9			$sig = new Coro::Signal;
10
11			$sig->wait; # wait for signal
12
13			# ... some other "thread"
14
15			$sig->send;
16
17			=head1 DESCRIPTION
18
19	root	1.11	This module implements signal/binary semaphores/condition variables
20			(basically all the same thing). You can wait for a signal to occur or send
21			it, in which case it will wake up one waiter, or it can be broadcast,
22			waking up all waiters.
23
24	root	1.1	=over 4
25
26			=cut
27
28			package Coro::Signal;
29
30	pcg	1.30	BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
31	root	1.16
32	root	1.5	use Coro ();
33	root	1.1
34	root	1.64	$VERSION = 4.749;
35	root	1.1
36	root	1.3	=item $s = new Coro::Signal;
37
38			Create a new signal.
39
40			=cut
41
42	root	1.1	sub new {
43	root	1.3	# [flag, [pid's]]
44	root	1.1	bless [], $_[0];
45			}
46
47	root	1.3	=item $s->wait
48
49	root	1.8	Wait for the signal to occur. Returns immediately if the signal has been
50			sent before.
51	root	1.3
52	root	1.52	Signals are not reliable: this function might return spuriously without
53			the signal being sent. This means you must always test for the condition
54			you are waiting for.
55
56			(If this is a real problem for you the situation might be remedied in a
57			future version).
58	root	1.48
59			=item $status = $s->timed_wait ($timeout)
60	root	1.20
61			Like C<wait>, but returns false if no signal happens within $timeout
62			seconds, otherwise true.
63
64	root	1.52	See C<wait> for some reliability concerns.
65	root	1.48
66	root	1.3	=cut
67
68	root	1.1	sub wait {
69	root	1.52	unless (delete $_[0][0]) {
70	root	1.48	push @{$_[0][1]}, $Coro::current;
71			&Coro::schedule;
72	root	1.1	}
73			}
74
75	root	1.20	sub timed_wait {
76	root	1.51	require Coro::Timer;
77			my $timeout = Coro::Timer::timeout($_[1]);
78	root	1.48
79	root	1.52	unless (delete $_[0][0]) {
80	root	1.20	push @{$_[0][1]}, $Coro::current;
81	root	1.48	&Coro::schedule;
82
83			return 0 if $timeout;
84	root	1.20	}
85	root	1.48
86			1
87	root	1.20	}
88
89	root	1.3	=item $s->send
90
91	root	1.8	Send the signal, waking up I<one> waiting process or remember the signal
92			if no process is waiting.
93	root	1.3
94			=cut
95
96	root	1.1	sub send {
97	root	1.50	$_[0][0] = 1;
98	root	1.48	(shift @{$_[0][1]})->ready if @{$_[0][1]};
99	root	1.1	}
100
101	root	1.3	=item $s->broadcast
102
103	root	1.8	Send the signal, waking up I<all> waiting process. If no process is
104			waiting the signal is lost.
105	root	1.3
106			=cut
107
108			sub broadcast {
109	root	1.48	if (my $waiters = delete $_[0][1]) {
110			$_->ready for @$waiters;
111			}
112	root	1.3	}
113
114			=item $s->awaited
115
116	root	1.20	Return true when the signal is being awaited by some process.
117	root	1.3
118			=cut
119
120	root	1.1	sub awaited {
121	root	1.48	! ! @{$_[0][1]}
122	root	1.1	}
123
124			1;
125
126			=back
127
128	root	1.41	=head1 BUGS
129
130			This implementation is not currently very robust when the process is woken
131			up by other sources, i.e. C<wait> might return early.
132
133	root	1.1	=head1 AUTHOR
134
135	root	1.38	Marc Lehmann <schmorp@schmorp.de>
136	root	1.36	http://home.schmorp.de/
137	root	1.1
138			=cut
139