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 = 1.9;

=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.

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

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

=cut

sub wait {
   if ($_[0][0]) {
      $_[0][0] = 0;
   } else {
      push @{$_[0][1]}, $Coro::current;
      Coro::schedule;
   }
}

sub timed_wait {
   if ($_[0][0]) {
      $_[0][0] = 0;
      return 1;
   } else {
      require Coro::Timer;
      my $timeout = Coro::Timer::timeout($_[1]);
      push @{$_[0][1]}, $Coro::current;
      Coro::schedule;
      return !$timeout;
   }
}

=item $s->send

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

=cut

sub send {
   if (@{$_[0][1]}) {
      (shift @{$_[0][1]})->ready;
   } else {
      $_[0][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 {
   (shift @{$_[0][1]})->ready while @{$_[0][1]};
}

=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.47
Committed:	Wed Feb 1 23:59:41 2006 UTC (18 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	rel-2_5, rel-2_0, rel-2_1, rel-1_9, stack_sharing
Changes since 1.46:	+1 -1 lines
Log Message:	* empty log message *
#	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.47	$VERSION = 1.9;
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.20	=item $status = $s->timed_wait($timeout)
53
54			Like C<wait>, but returns false if no signal happens within $timeout
55			seconds, otherwise true.
56
57	root	1.3	=cut
58
59	root	1.1	sub wait {
60	root	1.3	if ($_[0][0]) {
61			$_[0][0] = 0;
62	root	1.1	} else {
63	root	1.5	push @{$_[0][1]}, $Coro::current;
64			Coro::schedule;
65	root	1.1	}
66			}
67
68	root	1.20	sub timed_wait {
69			if ($_[0][0]) {
70			$_[0][0] = 0;
71			return 1;
72			} else {
73			require Coro::Timer;
74			my $timeout = Coro::Timer::timeout($_[1]);
75			push @{$_[0][1]}, $Coro::current;
76			Coro::schedule;
77			return !$timeout;
78			}
79			}
80
81	root	1.3	=item $s->send
82
83	root	1.8	Send the signal, waking up I<one> waiting process or remember the signal
84			if no process is waiting.
85	root	1.3
86			=cut
87
88	root	1.1	sub send {
89	root	1.3	if (@{$_[0][1]}) {
90			(shift @{$_[0][1]})->ready;
91	root	1.1	} else {
92	root	1.3	$_[0][0] = 1;
93	root	1.1	}
94			}
95
96	root	1.3	=item $s->broadcast
97
98	root	1.8	Send the signal, waking up I<all> waiting process. If no process is
99			waiting the signal is lost.
100	root	1.3
101			=cut
102
103			sub broadcast {
104			(shift @{$_[0][1]})->ready while @{$_[0][1]};
105			}
106
107			=item $s->awaited
108
109	root	1.20	Return true when the signal is being awaited by some process.
110	root	1.3
111			=cut
112
113	root	1.1	sub awaited {
114	root	1.3	!!@{$_[0][1]};
115	root	1.1	}
116
117			1;
118
119			=back
120
121	root	1.41	=head1 BUGS
122
123			This implementation is not currently very robust when the process is woken
124			up by other sources, i.e. C<wait> might return early.
125
126	root	1.1	=head1 AUTHOR
127
128	root	1.38	Marc Lehmann <schmorp@schmorp.de>
129	root	1.36	http://home.schmorp.de/
130	root	1.1
131			=cut
132