Coro/Coro/SemaphoreSet.pm

=head1 NAME

Coro::SemaphoreSet - hash of 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;

BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }

use Coro ();

$VERSION = 1.11;

=item new [inital count]

Creates a new sempahore 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 $sem->down ($id)

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

=item $status = $sem->timed_down ($id, $timeout)

Like C<down>, but returns false if semaphore couldn't be acquired within
$timeout seconds, otherwise true.

=cut

sub down {
   while () {
      my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]);

      if ($sem->[0] > 0) {
         --$sem->[0];
         return 1;
      }

      push @{$sem->[1]}, $Coro::current;
      Coro::schedule;
   }
}

sub 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 $sem->up ($id)

Unlock the semaphore again.

=cut

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

=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 $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]);
   if ($sem->[0] > 0) {
      --$sem->[0];
      return 1;
   } else {
      return 0;
   }
}

=item $sem->waiters ($id)

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

=cut

sub waiters {
   my $sem = $_[0][1]{$_[1]}
      or return;
   @{ $_[0][1]{$_[1]}[1] || []}
}

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

This method calls C<down> and then creates a guard object. When the guard
object is destroyed it automatically calls C<up>.

=item $guard = $sem->timed_guard ($id, $timeout)

Like C<guard>, but returns undef if semaphore couldn't be acquired within
$timeout seconds, otherwise the guard object.

=cut

sub guard {
   &down;
   bless [@_], Coro::SemaphoreSet::guard::;
}

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

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

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.33
Committed:	Sun May 15 23:21:30 2005 UTC (19 years ago) by root
Branch:	MAIN
Changes since 1.32:	+2 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::SemaphoreSet - hash of semaphores.
4
5			=head1 SYNOPSIS
6
7			use Coro::SemaphoreSet;
8
9			$sig = new Coro::SemaphoreSet [initial value];
10
11			$sig->down("semaphoreid"); # wait for signal
12
13			# ... some other "thread"
14
15			$sig->up("semaphoreid");
16
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	pcg	1.20	BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
34	root	1.4
35	root	1.1	use Coro ();
36
37	root	1.28	$VERSION = 1.11;
38	root	1.1
39			=item new [inital count]
40
41			Creates a new sempahore set with the given initial lock count for each
42			individual semaphore. See L<Coro::Semaphore>.
43
44			=cut
45
46			sub new {
47			bless [defined $_[1] ? $_[1] : 1], $_[0];
48			}
49
50	root	1.31	=item $sem->down ($id)
51	root	1.1
52			Decrement the counter, therefore "locking" the named semaphore. This
53			method waits until the semaphore is available if the counter is zero.
54
55	root	1.31	=item $status = $sem->timed_down ($id, $timeout)
56	root	1.8
57			Like C<down>, but returns false if semaphore couldn't be acquired within
58			$timeout seconds, otherwise true.
59
60	root	1.1	=cut
61
62			sub down {
63	root	1.29	while () {
64			my $sem = ($_[0][1]{$_[1]} \|\|= [$_[0][0]]);
65	root	1.31
66	root	1.30	if ($sem->[0] > 0) {
67			--$sem->[0];
68	root	1.31	return 1;
69	root	1.30	}
70	root	1.31
71	root	1.1	push @{$sem->[1]}, $Coro::current;
72			Coro::schedule;
73			}
74	root	1.8	}
75
76			sub timed_down {
77			require Coro::Timer;
78	root	1.31	my $timeout = Coro::Timer::timeout ($_[2]);
79
80			while () {
81			my $sem = ($_[0][1]{$_[1]} \|\|= [$_[0][0]]);
82
83			if ($sem->[0] > 0) {
84			--$sem->[0];
85			return 1;
86			}
87	root	1.8
88	root	1.10	if ($timeout) {
89	root	1.11	# ugly as hell.
90			for (0..$#{$sem->[1]}) {
91			if ($sem->[1][$_] == $Coro::current) {
92			splice @{$sem->[1]}, $_, 1;
93	root	1.31	return 0;
94	root	1.10	}
95			}
96			die;
97			}
98	root	1.31
99			push @{$sem->[1]}, $Coro::current;
100			Coro::schedule;
101	root	1.8	}
102	root	1.1	}
103
104	root	1.31	=item $sem->up ($id)
105	root	1.1
106			Unlock the semaphore again.
107
108			=cut
109
110			sub up {
111			my $sem = $_[0][1]{$_[1]};
112			if (++$sem->[0] > 0) {
113			(shift @{$sem->[1]})->ready if @{$sem->[1]};
114			}
115			delete $_[0][1]{$_[1]} if $sem->[0] == $_[0][0];
116			}
117
118			=item $sem->try
119
120			Try to C<down> the semaphore. Returns true when this was possible,
121			otherwise return false and leave the semaphore unchanged.
122
123			=cut
124
125			sub try {
126			my $sem = ($_[0][1]{$_[1]} \|\|= [$_[0][0]]);
127			if ($sem->[0] > 0) {
128			--$sem->[0];
129			return 1;
130			} else {
131			return 0;
132			}
133			}
134
135	root	1.31	=item $sem->waiters ($id)
136	root	1.1
137			In scalar context, returns the number of coroutines waiting for this
138			semaphore.
139
140			=cut
141
142			sub waiters {
143	root	1.33	my $sem = $_[0][1]{$_[1]}
144	root	1.32	or return;
145	root	1.33	@{ $_[0][1]{$_[1]}[1] \|\| []}
146	root	1.1	}
147
148	root	1.31	=item $guard = $sem->guard ($id)
149	root	1.1
150			This method calls C<down> and then creates a guard object. When the guard
151			object is destroyed it automatically calls C<up>.
152
153	root	1.31	=item $guard = $sem->timed_guard ($id, $timeout)
154	root	1.9
155			Like C<guard>, but returns undef if semaphore couldn't be acquired within
156			$timeout seconds, otherwise the guard object.
157
158	root	1.1	=cut
159
160			sub guard {
161			&down;
162	root	1.10	bless [@_], Coro::SemaphoreSet::guard::;
163	root	1.9	}
164
165	root	1.15	sub timed_guard {
166	root	1.9	&timed_down
167	root	1.10	? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard::
168	root	1.9	: ();
169	root	1.1	}
170
171	root	1.9	sub Coro::SemaphoreSet::guard::DESTROY {
172	root	1.1	&up(@{$_[0]});
173			}
174
175			1;
176
177			=back
178
179			=head1 AUTHOR
180
181	root	1.28	Marc Lehmann <schmorp@schmorp.de>
182	root	1.26	http://home.schmorp.de/
183	root	1.1
184			=cut
185