Coro/Coro/Semaphore.pm

=head1 NAME

Coro::Semaphore - non-binary semaphores

=head1 SYNOPSIS

 use Coro::Semaphore;

 $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 coroutine 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. Coroutines then increment the count when resources are added
and decrement the count when resources are removed.

=over 4

=cut

package Coro::Semaphore;

no warnings;

use Coro ();

$VERSION = 5.0;

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

=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 coroutines 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;
   # double indirection because bless works on the referenced
   # object, not (only) on the reference itself.
   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]}});
}

=back

=head1 AUTHOR

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

=cut

1

Revision:	1.80
Committed:	Sat Nov 15 06:26:52 2008 UTC (15 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.79:	+37 -91 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Semaphore - non-binary semaphores
4
5			=head1 SYNOPSIS
6
7			use Coro::Semaphore;
8
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			associated with semaphores, so one coroutine can C<down> it while another
23			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			resources. Coroutines then increment the count when resources are added
28			and decrement the count when resources are removed.
29
30	root	1.1	=over 4
31
32			=cut
33
34			package Coro::Semaphore;
35
36	root	1.61	no warnings;
37	root	1.20
38	root	1.5	use Coro ();
39	root	1.1
40	root	1.79	$VERSION = 5.0;
41	root	1.1
42	root	1.16	=item new [inital count]
43	root	1.3
44			Creates a new sempahore object with the given initial lock count. The
45	root	1.11	default lock count is 1, which means it is unlocked by default. Zero (or
46			negative values) are also allowed, in which case the semaphore is locked
47			by default.
48	root	1.3
49	root	1.55	=item $sem->count
50
51			Returns the current semaphore count.
52
53	root	1.56	=item $sem->adjust ($diff)
54
55			Atomically adds the amount given to the current semaphore count. If the
56			count becomes positive, wakes up any waiters. Does not block if the count
57			becomes negative, however.
58
59	root	1.3	=item $sem->down
60
61			Decrement the counter, therefore "locking" the semaphore. This method
62			waits until the semaphore is available if the counter is zero.
63
64			=cut
65
66	root	1.80	#=item $status = $sem->timed_down ($timeout)
67			#
68			#Like C<down>, but returns false if semaphore couldn't be acquired within
69			#$timeout seconds, otherwise true.
70
71			#sub timed_down {
72			# require Coro::Timer;
73			# my $timeout = Coro::Timer::timeout ($_[1]);
74			#
75			# while ($_[0][0] <= 0) {
76			# push @{$_[0][1]}, $Coro::current;
77			# &Coro::schedule;
78			# if ($timeout) {
79			# # ugly as hell. slow, too, btw!
80			# for (0..$#{$_[0][1]}) {
81			# if ($_[0][1][$_] == $Coro::current) {
82			# splice @{$_[0][1]}, $_, 1;
83			# return;
84			# }
85			# }
86			# die;
87			# }
88			# }
89			#
90			# --$_[0][0];
91			# return 1;
92			#}
93	root	1.1
94	root	1.3	=item $sem->up
95
96			Unlock the semaphore again.
97
98			=item $sem->try
99
100			Try to C<down> the semaphore. Returns true when this was possible,
101			otherwise return false and leave the semaphore unchanged.
102
103	root	1.15	=item $sem->waiters
104
105			In scalar context, returns the number of coroutines waiting for this
106			semaphore.
107
108	root	1.12	=item $guard = $sem->guard
109
110			This method calls C<down> and then creates a guard object. When the guard
111			object is destroyed it automatically calls C<up>.
112
113			=cut
114
115			sub guard {
116	root	1.16	&down;
117	root	1.13	# double indirection because bless works on the referenced
118			# object, not (only) on the reference itself.
119	root	1.26	bless \\$_[0], Coro::Semaphore::guard::;
120	root	1.25	}
121
122	root	1.80	#=item $guard = $sem->timed_guard ($timeout)
123			#
124			#Like C<guard>, but returns undef if semaphore couldn't be acquired within
125			#$timeout seconds, otherwise the guard object.
126
127			#sub timed_guard {
128			# &timed_down
129			# ? bless \\$_[0], Coro::Semaphore::guard::
130			# : ();
131			#}
132	root	1.12
133	root	1.25	sub Coro::Semaphore::guard::DESTROY {
134	root	1.16	&up(${${$_[0]}});
135	root	1.1	}
136
137			=back
138
139			=head1 AUTHOR
140
141	root	1.44	Marc Lehmann <schmorp@schmorp.de>
142	root	1.42	http://home.schmorp.de/
143	root	1.1
144			=cut
145
146	root	1.51	1
147