Coro/Coro/Semaphore.pm

=head1 NAME

Coro::Semaphore - counting semaphores

=head1 SYNOPSIS

 use Coro;

 $sig = new Coro::Semaphore [initial value];

 $sig->down; # wait for signal

 # ... some other "thread"

 $sig->up;

=head1 DESCRIPTION

This module implements counting semaphores. You can initialize a mutex
with any level of parallel users, that is, you can intialize a sempahore
that can be C<down>ed more than once until it blocks. There is no owner
associated with semaphores, so one thread can C<down> it while another
can C<up> it.

Counting semaphores are typically used to coordinate access to
resources, with the semaphore count initialized to the number of free
resources. Threads then increment the count when resources are added
and decrement the count when resources are removed.

You don't have to load C<Coro::Semaphore> manually, it will be loaded 
automatically when you C<use Coro> and call the C<new> constructor. 

=over 4

=cut

package Coro::Semaphore;

use common::sense;

use Coro ();

our $VERSION = 6.23;

=item new [inital count]

Creates a new sempahore object with the given initial lock count. The
default lock count is 1, which means it is unlocked by default. Zero (or
negative values) are also allowed, in which case the semaphore is locked
by default.

=item $sem->count

Returns the current semaphore count.

=item $sem->adjust ($diff)

Atomically adds the amount given to the current semaphore count. If the
count becomes positive, wakes up any waiters. Does not block if the count
becomes negative, however.

=item $sem->down

Decrement the counter, therefore "locking" the semaphore. This method
waits until the semaphore is available if the counter is zero.

=item $sem->wait

Similar to C<down>, but does not actually decrement the counter. Instead,
when this function returns, a following call to C<down> or C<try> is
guaranteed to succeed without blocking, until the next thread switch
(C<cede> etc.).

Note that using C<wait> is much less efficient than using C<down>, so try
to prefer C<down> whenever possible.

=item $sem->wait ($callback)

If you pass a callback argument to C<wait>, it will not wait, but
immediately return. The callback will be called as soon as the semaphore
becomes available (which might be instantly), and gets passed the
semaphore as first argument.

The callback might C<down> the semaphore exactly once, might wake up other
threads, but is I<NOT> allowed to block (switch to other threads).

=cut

#=item $status = $sem->timed_down ($timeout)
#
#Like C<down>, but returns false if semaphore couldn't be acquired within
#$timeout seconds, otherwise true.

#sub timed_down {
#   require Coro::Timer;
#   my $timeout = Coro::Timer::timeout ($_[1]);
# 
#   while ($_[0][0] <= 0) {
#      push @{$_[0][1]}, $Coro::current;
#      &Coro::schedule;
#      if ($timeout) {
#         # ugly as hell. slow, too, btw!
#         for (0..$#{$_[0][1]}) {
#            if ($_[0][1][$_] == $Coro::current) {
#               splice @{$_[0][1]}, $_, 1;
#               return;
#            }
#         }
#         die;
#      }
#   }
# 
#   --$_[0][0];
#   return 1;
#}

=item $sem->up

Unlock the semaphore again.

=item $sem->try

Try to C<down> the semaphore. Returns true when this was possible,
otherwise return false and leave the semaphore unchanged.

=item $sem->waiters

In scalar context, returns the number of threads waiting for this
semaphore.

=item $guard = $sem->guard

This method calls C<down> and then creates a guard object. When the guard
object is destroyed it automatically calls C<up>.

=cut

sub guard {
   &down;
   bless [$_[0]], Coro::Semaphore::guard::
}

#=item $guard = $sem->timed_guard ($timeout)
#
#Like C<guard>, but returns undef if semaphore couldn't be acquired within
#$timeout seconds, otherwise the guard object.

#sub timed_guard {
#   &timed_down
#      ? bless \\$_[0], Coro::Semaphore::guard::
#      : ();
#}

sub Coro::Semaphore::guard::DESTROY {
   &up($_[0][0]);
}

=back

=head1 AUTHOR

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

=cut

1

Revision:	1.126
Committed:	Fri Dec 7 22:37:24 2012 UTC (11 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-6_23
Changes since 1.125:	+1 -1 lines
Log Message:	6.23
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.84	Coro::Semaphore - counting semaphores
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.110	use Coro;
8	root	1.1
9	root	1.3	$sig = new Coro::Semaphore [initial value];
10	root	1.1
11			$sig->down; # wait for signal
12
13			# ... some other "thread"
14
15			$sig->up;
16
17			=head1 DESCRIPTION
18
19	root	1.16	This module implements counting semaphores. You can initialize a mutex
20	root	1.11	with any level of parallel users, that is, you can intialize a sempahore
21			that can be C<down>ed more than once until it blocks. There is no owner
22	root	1.95	associated with semaphores, so one thread can C<down> it while another
23	root	1.11	can C<up> it.
24
25			Counting semaphores are typically used to coordinate access to
26			resources, with the semaphore count initialized to the number of free
27	root	1.95	resources. Threads then increment the count when resources are added
28	root	1.11	and decrement the count when resources are removed.
29
30	root	1.109	You don't have to load C<Coro::Semaphore> manually, it will be loaded
31			automatically when you C<use Coro> and call the C<new> constructor.
32
33	root	1.1	=over 4
34
35			=cut
36
37			package Coro::Semaphore;
38
39	root	1.102	use common::sense;
40	root	1.20
41	root	1.5	use Coro ();
42	root	1.1
43	root	1.126	our $VERSION = 6.23;
44	root	1.1
45	root	1.16	=item new [inital count]
46	root	1.3
47			Creates a new sempahore object with the given initial lock count. The
48	root	1.11	default lock count is 1, which means it is unlocked by default. Zero (or
49			negative values) are also allowed, in which case the semaphore is locked
50			by default.
51	root	1.3
52	root	1.55	=item $sem->count
53
54			Returns the current semaphore count.
55
56	root	1.56	=item $sem->adjust ($diff)
57
58			Atomically adds the amount given to the current semaphore count. If the
59			count becomes positive, wakes up any waiters. Does not block if the count
60			becomes negative, however.
61
62	root	1.3	=item $sem->down
63
64			Decrement the counter, therefore "locking" the semaphore. This method
65			waits until the semaphore is available if the counter is zero.
66
67	root	1.81	=item $sem->wait
68
69			Similar to C<down>, but does not actually decrement the counter. Instead,
70			when this function returns, a following call to C<down> or C<try> is
71	root	1.95	guaranteed to succeed without blocking, until the next thread switch
72	root	1.81	(C<cede> etc.).
73
74			Note that using C<wait> is much less efficient than using C<down>, so try
75			to prefer C<down> whenever possible.
76
77	root	1.82	=item $sem->wait ($callback)
78
79			If you pass a callback argument to C<wait>, it will not wait, but
80			immediately return. The callback will be called as soon as the semaphore
81			becomes available (which might be instantly), and gets passed the
82			semaphore as first argument.
83
84			The callback might C<down> the semaphore exactly once, might wake up other
85	root	1.95	threads, but is I<NOT> allowed to block (switch to other threads).
86	root	1.82
87	root	1.3	=cut
88
89	root	1.80	#=item $status = $sem->timed_down ($timeout)
90			#
91			#Like C<down>, but returns false if semaphore couldn't be acquired within
92			#$timeout seconds, otherwise true.
93
94			#sub timed_down {
95			# require Coro::Timer;
96			# my $timeout = Coro::Timer::timeout ($_[1]);
97			#
98			# while ($_[0][0] <= 0) {
99			# push @{$_[0][1]}, $Coro::current;
100			# &Coro::schedule;
101			# if ($timeout) {
102			# # ugly as hell. slow, too, btw!
103			# for (0..$#{$_[0][1]}) {
104			# if ($_[0][1][$_] == $Coro::current) {
105			# splice @{$_[0][1]}, $_, 1;
106			# return;
107			# }
108			# }
109			# die;
110			# }
111			# }
112			#
113			# --$_[0][0];
114			# return 1;
115			#}
116	root	1.1
117	root	1.3	=item $sem->up
118
119			Unlock the semaphore again.
120
121			=item $sem->try
122
123			Try to C<down> the semaphore. Returns true when this was possible,
124			otherwise return false and leave the semaphore unchanged.
125
126	root	1.15	=item $sem->waiters
127
128	root	1.95	In scalar context, returns the number of threads waiting for this
129	root	1.15	semaphore.
130
131	root	1.12	=item $guard = $sem->guard
132
133			This method calls C<down> and then creates a guard object. When the guard
134			object is destroyed it automatically calls C<up>.
135
136			=cut
137
138			sub guard {
139	root	1.16	&down;
140	root	1.90	bless [$_[0]], Coro::Semaphore::guard::
141	root	1.25	}
142
143	root	1.80	#=item $guard = $sem->timed_guard ($timeout)
144			#
145			#Like C<guard>, but returns undef if semaphore couldn't be acquired within
146			#$timeout seconds, otherwise the guard object.
147
148			#sub timed_guard {
149			# &timed_down
150			# ? bless \\$_[0], Coro::Semaphore::guard::
151			# : ();
152			#}
153	root	1.12
154	root	1.25	sub Coro::Semaphore::guard::DESTROY {
155	root	1.90	&up($_[0][0]);
156	root	1.1	}
157
158			=back
159
160			=head1 AUTHOR
161
162	root	1.44	Marc Lehmann <schmorp@schmorp.de>
163	root	1.42	http://home.schmorp.de/
164	root	1.1
165			=cut
166
167	root	1.51	1
168