Coro/Coro/SemaphoreSet.pm

=head1 NAME

Coro::SemaphoreSet - efficient set of counting semaphores

=head1 SYNOPSIS

 use Coro::SemaphoreSet;

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

 $sig->down ("semaphoreid"); # wait for signal

 # ... some other "thread"

 $sig->up ("semaphoreid");

=head1 DESCRIPTION

This module implements sets of counting semaphores (see
L<Coro::Semaphore>). It is nothing more than a hash with normal semaphores
as members, but is more efficiently managed.

This is useful if you want to allow parallel tasks to run in parallel but
not on the same problem. Just use a SemaphoreSet and lock on the problem
identifier.

=over 4

=cut

package Coro::SemaphoreSet;

use strict qw(vars subs);
no warnings;

our $VERSION = 5.131;

use Coro::Semaphore ();

=item new [inital count]

Creates a new semaphore set with the given initial lock count for each
individual semaphore. See L<Coro::Semaphore>.

=cut

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

=item $semset->down ($id)

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

=cut

sub down {
   # Coro::Semaphore::down increases the refcount, which we check in _may_delete
   Coro::Semaphore::down ($_[0][1]{$_[1]} ||= Coro::Semaphore::_alloc $_[0][0]);
}

#ub timed_down {
#  require Coro::Timer;
#  my $timeout = Coro::Timer::timeout ($_[2]);
#
#  while () {
#     my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]);
#
#     if ($sem->[0] > 0) {
#        --$sem->[0];
#        return 1;
#     }
#
#     if ($timeout) {
#        # ugly as hell.
#        for (0..$#{$sem->[1]}) {
#           if ($sem->[1][$_] == $Coro::current) {
#              splice @{$sem->[1]}, $_, 1;
#              return 0;
#           }
#        }
#        die;
#     }
#
#     push @{$sem->[1]}, $Coro::current;
#     &Coro::schedule;
#  }
#

=item $semset->up ($id)

Unlock the semaphore again. If the semaphore reaches the default count for
this set and has no waiters, the space allocated for it will be freed.

=cut

sub up {
   my ($self, $id) = @_;

   my $sem = $self->[1]{$id} ||= Coro::Semaphore::_alloc $self->[0];

   Coro::Semaphore::up $sem;

   delete $self->[1]{$id}
      if _may_delete $sem, $self->[0], 1;
}

=item $semset->try ($id)

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

=cut

sub try {
   Coro::Semaphore::try ($_[0][1]{$_[1]} || return $_[0][0] > 0)
}

=item $semset->count ($id)

Return the current semaphore count for the specified semaphore.

=cut

sub count {
   Coro::Semaphore::count ($_[0][1]{$_[1]} || return $_[0][0]);
}

=item $semset->waiters ($id)

Returns the number (in scalar context) or list (in list context) of
waiters waiting on the specified semaphore.

=cut

sub waiters {
   Coro::Semaphore::waiters ($_[0][1]{$_[1]} || return);
}

=item $semset->wait ($id)

Same as Coro::Semaphore::wait on the specified semaphore.

=cut

sub wait {
   Coro::Semaphore::wait ($_[0][1]{$_[1]} || return $_[0][0] > 0);
}

=item $guard = $semset->guard ($id)

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 [@_], Coro::SemaphoreSet::guard::;
}

#ub timed_guard {
#  &timed_down
#     ? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard::
#     : ();
#

sub Coro::SemaphoreSet::guard::DESTROY {
   up @{$_[0]};
}

=item $semaphore = $semset->sem ($id)

This SemaphoreSet version is based on Coro::Semaphore's. This function
creates (if necessary) the underlying Coro::Semaphore object and returns
it. You may legally call any Coro::Semaphore method on it, but note that
calling C<< $semset->up >> can invalidate the returned semaphore.

=cut

sub sem {
   bless +($_[0][1]{$_[1]} ||= Coro::Semaphore::_alloc $_[0][0]),
         Coro::Semaphore::;
}

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.78
Committed:	Mon Mar 16 22:22:12 2009 UTC (15 years, 2 months ago) by root
Branch:	MAIN
CVS Tags:	rel-5_131
Changes since 1.77:	+1 -1 lines
Log Message:	5.131
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.70	Coro::SemaphoreSet - efficient set of counting semaphores
4	root	1.1
5			=head1 SYNOPSIS
6
7			use Coro::SemaphoreSet;
8
9			$sig = new Coro::SemaphoreSet [initial value];
10
11	root	1.73	$sig->down ("semaphoreid"); # wait for signal
12	root	1.1
13			# ... some other "thread"
14
15	root	1.73	$sig->up ("semaphoreid");
16	root	1.1
17			=head1 DESCRIPTION
18
19			This module implements sets of counting semaphores (see
20			L<Coro::Semaphore>). It is nothing more than a hash with normal semaphores
21			as members, but is more efficiently managed.
22
23			This is useful if you want to allow parallel tasks to run in parallel but
24			not on the same problem. Just use a SemaphoreSet and lock on the problem
25			identifier.
26
27			=over 4
28
29			=cut
30
31			package Coro::SemaphoreSet;
32
33	root	1.68	use strict qw(vars subs);
34	root	1.48	no warnings;
35	root	1.4
36	root	1.78	our $VERSION = 5.131;
37	root	1.1
38	root	1.68	use Coro::Semaphore ();
39	root	1.1
40			=item new [inital count]
41
42	root	1.36	Creates a new semaphore set with the given initial lock count for each
43	root	1.1	individual semaphore. See L<Coro::Semaphore>.
44
45			=cut
46
47			sub new {
48	root	1.74	bless [defined $_[1] ? $_[1] : 1], $_[0]
49	root	1.1	}
50
51	root	1.68	=item $semset->down ($id)
52	root	1.1
53			Decrement the counter, therefore "locking" the named semaphore. This
54			method waits until the semaphore is available if the counter is zero.
55
56			=cut
57
58			sub down {
59	root	1.77	# Coro::Semaphore::down increases the refcount, which we check in _may_delete
60	root	1.76	Coro::Semaphore::down ($_[0][1]{$_[1]} \|\|= Coro::Semaphore::_alloc $_[0][0]);
61	root	1.1	}
62
63	root	1.68	#ub timed_down {
64			# require Coro::Timer;
65			# my $timeout = Coro::Timer::timeout ($_[2]);
66			#
67			# while () {
68			# my $sem = ($_[0][1]{$_[1]} \|\|= [$_[0][0]]);
69			#
70			# if ($sem->[0] > 0) {
71			# --$sem->[0];
72			# return 1;
73			# }
74			#
75			# if ($timeout) {
76			# # ugly as hell.
77			# for (0..$#{$sem->[1]}) {
78			# if ($sem->[1][$_] == $Coro::current) {
79			# splice @{$sem->[1]}, $_, 1;
80			# return 0;
81			# }
82			# }
83			# die;
84			# }
85			#
86			# push @{$sem->[1]}, $Coro::current;
87			# &Coro::schedule;
88			# }
89			#
90
91			=item $semset->up ($id)
92
93	root	1.77	Unlock the semaphore again. If the semaphore reaches the default count for
94			this set and has no waiters, the space allocated for it will be freed.
95	root	1.1
96			=cut
97
98			sub up {
99	root	1.68	my ($self, $id) = @_;
100
101	root	1.75	my $sem = $self->[1]{$id} \|\|= Coro::Semaphore::_alloc $self->[0];
102	root	1.68
103	root	1.75	Coro::Semaphore::up $sem;
104	root	1.68
105	root	1.75	delete $self->[1]{$id}
106	root	1.77	if _may_delete $sem, $self->[0], 1;
107	root	1.1	}
108
109	root	1.73	=item $semset->try ($id)
110	root	1.1
111			Try to C<down> the semaphore. Returns true when this was possible,
112			otherwise return false and leave the semaphore unchanged.
113
114			=cut
115
116			sub try {
117	root	1.75	Coro::Semaphore::try ($_[0][1]{$_[1]} \|\| return $_[0][0] > 0)
118	root	1.73	}
119
120			=item $semset->count ($id)
121
122			Return the current semaphore count for the specified semaphore.
123
124			=cut
125
126			sub count {
127	root	1.75	Coro::Semaphore::count ($_[0][1]{$_[1]} \|\| return $_[0][0]);
128			}
129
130			=item $semset->waiters ($id)
131
132			Returns the number (in scalar context) or list (in list context) of
133			waiters waiting on the specified semaphore.
134
135			=cut
136
137			sub waiters {
138			Coro::Semaphore::waiters ($_[0][1]{$_[1]} \|\| return);
139	root	1.73	}
140
141			=item $semset->wait ($id)
142
143			Same as Coro::Semaphore::wait on the specified semaphore.
144
145			=cut
146
147			sub wait {
148			Coro::Semaphore::wait ($_[0][1]{$_[1]} \|\| return $_[0][0] > 0);
149	root	1.1	}
150
151	root	1.68	=item $guard = $semset->guard ($id)
152	root	1.1
153			This method calls C<down> and then creates a guard object. When the guard
154			object is destroyed it automatically calls C<up>.
155
156			=cut
157
158			sub guard {
159			&down;
160	root	1.10	bless [@_], Coro::SemaphoreSet::guard::;
161	root	1.9	}
162
163	root	1.68	#ub timed_guard {
164			# &timed_down
165			# ? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard::
166			# : ();
167			#
168
169			sub Coro::SemaphoreSet::guard::DESTROY {
170			up @{$_[0]};
171	root	1.1	}
172
173	root	1.68	=item $semaphore = $semset->sem ($id)
174
175			This SemaphoreSet version is based on Coro::Semaphore's. This function
176			creates (if necessary) the underlying Coro::Semaphore object and returns
177			it. You may legally call any Coro::Semaphore method on it, but note that
178			calling C<< $semset->up >> can invalidate the returned semaphore.
179
180			=cut
181
182			sub sem {
183	root	1.75	bless +($_[0][1]{$_[1]} \|\|= Coro::Semaphore::_alloc $_[0][0]),
184			Coro::Semaphore::;
185	root	1.1	}
186
187			1;
188
189			=back
190
191			=head1 AUTHOR
192
193	root	1.28	Marc Lehmann <schmorp@schmorp.de>
194	root	1.26	http://home.schmorp.de/
195	root	1.1
196			=cut
197