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

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

=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 {
   while ($_[0][0] <= 0) {
      push @{$_[0][1]}, $Coro::current;
      Coro::schedule;
   }
   --$_[0][0];
}

=item $sem->up

Unlock the semaphore again.

=cut

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

=item $sem->waiters

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

=cut

sub waiters {
   @{$_[0][1]};
}

=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::;
}

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

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.20
Committed:	Mon Sep 24 00:51:19 2001 UTC (22 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.19:	+2 -0 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	Coro::Semaphore - non-binary semaphores
4
5	=head1 SYNOPSIS
6
7	use Coro::Semaphore;
8
9	$sig = new Coro::Semaphore [initial value];
10
11	$sig->down; # wait for signal
12
13	# ... some other "thread"
14
15	$sig->up;
16
17	=head1 DESCRIPTION
18
19	This module implements counting 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	=over 4
31
32	=cut
33
34	package Coro::Semaphore;
35
36	no warnings;
37
38	use Coro ();
39
40	$VERSION = 0.5;
41
42	=item new [inital count]
43
44	Creates a new sempahore object with the given initial lock count. The
45	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
49	=cut
50
51	sub new {
52	bless [defined $_[1] ? $_[1] : 1], $_[0];
53	}
54
55	=item $sem->down
56
57	Decrement the counter, therefore "locking" the semaphore. This method
58	waits until the semaphore is available if the counter is zero.
59
60	=cut
61
62	sub down {
63	while ($_[0][0] <= 0) {
64	push @{$_[0][1]}, $Coro::current;
65	Coro::schedule;
66	}
67	--$_[0][0];
68	}
69
70	=item $sem->up
71
72	Unlock the semaphore again.
73
74	=cut
75
76	sub up {
77	if (++$_[0][0] > 0) {
78	(shift @{$_[0][1]})->ready if @{$_[0][1]};
79	}
80	}
81
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
89	sub try {
90	if ($_[0][0] > 0) {
91	--$_[0][0];
92	return 1;
93	} else {
94	return 0;
95	}
96	}
97
98	=item $sem->waiters
99
100	In scalar context, returns the number of coroutines waiting for this
101	semaphore.
102
103	=cut
104
105	sub waiters {
106	@{$_[0][1]};
107	}
108
109	=item $guard = $sem->guard
110
111	This method calls C<down> and then creates a guard object. When the guard
112	object is destroyed it automatically calls C<up>.
113
114	=cut
115
116	sub guard {
117	&down;
118	# double indirection because bless works on the referenced
119	# object, not (only) on the reference itself.
120	bless \\$_[0], Coro::Semaphore::Guard::;
121	}
122
123	sub Coro::Semaphore::Guard::DESTROY {
124	&up(${${$_[0]}});
125	}
126
127	1;
128
129	=back
130
131	=head1 AUTHOR
132
133	Marc Lehmann <pcg@goof.com>
134	http://www.goof.com/pcg/marc/
135
136	=cut
137