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

=over 4

=cut

package Coro::Semaphore;

use Coro ();

$VERSION = 0.12;

=item new [inital count, default zero]

Creates a new sempahore object with the given initial lock count. The
default lock count is 1, which means it is unlocked 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.10
Committed:	Wed Jul 25 04:14:38 2001 UTC (22 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.9:	+1 -1 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			=over 4
20
21			=cut
22
23			package Coro::Semaphore;
24
25	root	1.5	use Coro ();
26	root	1.1
27	root	1.10	$VERSION = 0.12;
28	root	1.1
29	root	1.3	=item new [inital count, default zero]
30
31			Creates a new sempahore object with the given initial lock count. The
32			default lock count is 1, which means it is unlocked by default.
33
34			=cut
35
36	root	1.1	sub new {
37	root	1.2	bless [defined $_[1] ? $_[1] : 1], $_[0];
38	root	1.1	}
39
40	root	1.3	=item $sem->down
41
42			Decrement the counter, therefore "locking" the semaphore. This method
43			waits until the semaphore is available if the counter is zero.
44
45			=cut
46
47	root	1.1	sub down {
48			my $self = shift;
49			while ($self->[0] <= 0) {
50	root	1.5	push @{$self->[1]}, $Coro::current;
51			Coro::schedule;
52	root	1.1	}
53			--$self->[0];
54			}
55
56	root	1.3	=item $sem->up
57
58			Unlock the semaphore again.
59
60			=cut
61
62	root	1.1	sub up {
63			my $self = shift;
64	root	1.2	if (++$self->[0] > 0) {
65	root	1.1	(shift @{$self->[1]})->ready if @{$self->[1]};
66			}
67			}
68	root	1.3
69			=item $sem->try
70
71			Try to C<down> the semaphore. Returns true when this was possible,
72			otherwise return false and leave the semaphore unchanged.
73
74			=cut
75	root	1.1
76			sub try {
77			my $self = shift;
78			if ($self->[0] > 0) {
79			--$self->[0];
80			return 1;
81			} else {
82			return 0;
83			}
84			}
85
86			1;
87
88			=back
89
90			=head1 AUTHOR
91
92			Marc Lehmann <pcg@goof.com>
93			http://www.goof.com/pcg/marc/
94
95			=cut
96