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 counted 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;

use Coro ();

$VERSION = 0.12;

=item new [inital count, default one]

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.

=cut

sub new {
   bless [defined $_[1] ? $_[1] : 1], $_[0];
}

=item $sem->down

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

=cut

sub down {
   my $self = shift;
   while ($self->[0] <= 0) {
      push @{$self->[1]}, $Coro::current;
      Coro::schedule;
   }
   --$self->[0];
}

=item $sem->up

Unlock the semaphore again.

=cut

sub up {
   my $self = shift;
   if (++$self->[0] > 0) {
      (shift @{$self->[1]})->ready if @{$self->[1]};
   }
}

=item $sem->try

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

=cut

sub try {
   my $self = shift;
   if ($self->[0] > 0) {
      --$self->[0];
      return 1;
   } else {
      return 0;
   }
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.11
Committed:	Wed Jul 25 19:28:00 2001 UTC (22 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.10:	+15 -2 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.11	This module implements counted semaphores. You can initialize a mutex
20			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.5	use Coro ();
37	root	1.1
38	root	1.10	$VERSION = 0.12;
39	root	1.1
40	root	1.11	=item new [inital count, default one]
41	root	1.3
42			Creates a new sempahore object with the given initial lock count. The
43	root	1.11	default lock count is 1, which means it is unlocked by default. Zero (or
44			negative values) are also allowed, in which case the semaphore is locked
45			by default.
46	root	1.3
47			=cut
48
49	root	1.1	sub new {
50	root	1.2	bless [defined $_[1] ? $_[1] : 1], $_[0];
51	root	1.1	}
52
53	root	1.3	=item $sem->down
54
55			Decrement the counter, therefore "locking" the semaphore. This method
56			waits until the semaphore is available if the counter is zero.
57
58			=cut
59
60	root	1.1	sub down {
61			my $self = shift;
62			while ($self->[0] <= 0) {
63	root	1.5	push @{$self->[1]}, $Coro::current;
64			Coro::schedule;
65	root	1.1	}
66			--$self->[0];
67			}
68
69	root	1.3	=item $sem->up
70
71			Unlock the semaphore again.
72
73			=cut
74
75	root	1.1	sub up {
76			my $self = shift;
77	root	1.2	if (++$self->[0] > 0) {
78	root	1.1	(shift @{$self->[1]})->ready if @{$self->[1]};
79			}
80			}
81	root	1.3
82			=item $sem->try
83
84			Try to C<down> the semaphore. Returns true when this was possible,
85			otherwise return false and leave the semaphore unchanged.
86
87			=cut
88	root	1.1
89			sub try {
90			my $self = shift;
91			if ($self->[0] > 0) {
92			--$self->[0];
93			return 1;
94			} else {
95			return 0;
96			}
97			}
98
99			1;
100
101			=back
102
103			=head1 AUTHOR
104
105			Marc Lehmann <pcg@goof.com>
106			http://www.goof.com/pcg/marc/
107
108			=cut
109