Coro/Coro/SemaphoreSet.pm

=head1 NAME

Coro::SemaphoreSet - efficient set of counting semaphores

=head1 SYNOPSIS

 use Coro;

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

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

=over 4

=cut

package Coro::SemaphoreSet;

use common::sense;

our $VERSION = 6.512;

use Coro::Semaphore ();

=item new [initial 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]} ||= $_[0][0] > 0
         ? Coro::Semaphore::_alloc $_[0][0]
         : return 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);
}

=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/SUPPORT/CONTACT

   Marc A. Lehmann <schmorp@schmorp.de>
   http://software.schmorp.de/pkg/Coro.html

=cut

Revision:	1.138
Committed:	Fri Jul 14 03:03:56 2017 UTC (6 years, 10 months ago) by root
Branch:	MAIN
CVS Tags:	rel-6_512
Changes since 1.137:	+1 -1 lines
Log Message:	* empty log message *
#	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	root	1.97	use Coro;
8	root	1.1
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	root	1.96	You don't have to load C<Coro::SemaphoreSet> manually, it will be loaded
28			automatically when you C<use Coro> and call the C<new> constructor.
29
30	root	1.1	=over 4
31
32			=cut
33
34			package Coro::SemaphoreSet;
35
36	root	1.89	use common::sense;
37	root	1.4
38	root	1.138	our $VERSION = 6.512;
39	root	1.1
40	root	1.68	use Coro::Semaphore ();
41	root	1.1
42	root	1.137	=item new [initial count]
43	root	1.1
44	root	1.36	Creates a new semaphore set with the given initial lock count for each
45	root	1.1	individual semaphore. See L<Coro::Semaphore>.
46
47			=cut
48
49			sub new {
50	root	1.74	bless [defined $_[1] ? $_[1] : 1], $_[0]
51	root	1.1	}
52
53	root	1.68	=item $semset->down ($id)
54	root	1.1
55			Decrement the counter, therefore "locking" the named semaphore. This
56			method waits until the semaphore is available if the counter is zero.
57
58			=cut
59
60			sub down {
61	root	1.77	# Coro::Semaphore::down increases the refcount, which we check in _may_delete
62	root	1.76	Coro::Semaphore::down ($_[0][1]{$_[1]} \|\|= Coro::Semaphore::_alloc $_[0][0]);
63	root	1.1	}
64
65	root	1.68	#ub timed_down {
66			# require Coro::Timer;
67			# my $timeout = Coro::Timer::timeout ($_[2]);
68			#
69			# while () {
70			# my $sem = ($_[0][1]{$_[1]} \|\|= [$_[0][0]]);
71			#
72			# if ($sem->[0] > 0) {
73			# --$sem->[0];
74			# return 1;
75			# }
76			#
77			# if ($timeout) {
78			# # ugly as hell.
79			# for (0..$#{$sem->[1]}) {
80			# if ($sem->[1][$_] == $Coro::current) {
81			# splice @{$sem->[1]}, $_, 1;
82			# return 0;
83			# }
84			# }
85			# die;
86			# }
87			#
88			# push @{$sem->[1]}, $Coro::current;
89			# &Coro::schedule;
90			# }
91			#
92
93			=item $semset->up ($id)
94
95	root	1.77	Unlock the semaphore again. If the semaphore reaches the default count for
96			this set and has no waiters, the space allocated for it will be freed.
97	root	1.1
98			=cut
99
100			sub up {
101	root	1.68	my ($self, $id) = @_;
102
103	root	1.75	my $sem = $self->[1]{$id} \|\|= Coro::Semaphore::_alloc $self->[0];
104	root	1.68
105	root	1.75	Coro::Semaphore::up $sem;
106	root	1.68
107	root	1.75	delete $self->[1]{$id}
108	root	1.77	if _may_delete $sem, $self->[0], 1;
109	root	1.1	}
110
111	root	1.73	=item $semset->try ($id)
112	root	1.1
113			Try to C<down> the semaphore. Returns true when this was possible,
114			otherwise return false and leave the semaphore unchanged.
115
116			=cut
117
118			sub try {
119	root	1.123	Coro::Semaphore::try (
120			$_[0][1]{$_[1]} \|\|= $_[0][0] > 0
121			? Coro::Semaphore::_alloc $_[0][0]
122			: return 0
123			)
124	root	1.73	}
125
126			=item $semset->count ($id)
127
128			Return the current semaphore count for the specified semaphore.
129
130			=cut
131
132			sub count {
133	root	1.75	Coro::Semaphore::count ($_[0][1]{$_[1]} \|\| return $_[0][0]);
134			}
135
136			=item $semset->waiters ($id)
137
138			Returns the number (in scalar context) or list (in list context) of
139			waiters waiting on the specified semaphore.
140
141			=cut
142
143			sub waiters {
144			Coro::Semaphore::waiters ($_[0][1]{$_[1]} \|\| return);
145	root	1.73	}
146
147			=item $semset->wait ($id)
148
149			Same as Coro::Semaphore::wait on the specified semaphore.
150
151			=cut
152
153			sub wait {
154	root	1.86	Coro::Semaphore::wait ($_[0][1]{$_[1]} \|\| return);
155	root	1.1	}
156
157	root	1.68	=item $guard = $semset->guard ($id)
158	root	1.1
159			This method calls C<down> and then creates a guard object. When the guard
160			object is destroyed it automatically calls C<up>.
161
162			=cut
163
164			sub guard {
165			&down;
166	root	1.79	bless [@_], Coro::SemaphoreSet::guard::
167	root	1.9	}
168
169	root	1.68	#ub timed_guard {
170			# &timed_down
171			# ? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard::
172			# : ();
173			#
174
175			sub Coro::SemaphoreSet::guard::DESTROY {
176			up @{$_[0]};
177	root	1.1	}
178
179	root	1.68	=item $semaphore = $semset->sem ($id)
180
181			This SemaphoreSet version is based on Coro::Semaphore's. This function
182			creates (if necessary) the underlying Coro::Semaphore object and returns
183			it. You may legally call any Coro::Semaphore method on it, but note that
184			calling C<< $semset->up >> can invalidate the returned semaphore.
185
186			=cut
187
188			sub sem {
189	root	1.75	bless +($_[0][1]{$_[1]} \|\|= Coro::Semaphore::_alloc $_[0][0]),
190			Coro::Semaphore::;
191	root	1.1	}
192
193			1;
194
195			=back
196
197	root	1.126	=head1 AUTHOR/SUPPORT/CONTACT
198	root	1.1
199	root	1.126	Marc A. Lehmann <schmorp@schmorp.de>
200			http://software.schmorp.de/pkg/Coro.html
201	root	1.1
202			=cut
203