This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The last parameter to gv_stashpv/gv_stashpvn/gv_stashsv is a bitmask
[perl5.git] / ext / IPC / SysV / Semaphore.pm
CommitLineData
0ade1984
JH
1# IPC::Semaphore
2#
3# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6
7package IPC::Semaphore;
8
9use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL
10 IPC_STAT IPC_SET IPC_RMID);
11use strict;
12use vars qw($VERSION);
13use Carp;
14
e9d8cdc0 15$VERSION = "1.02";
105cd853 16$VERSION = eval $VERSION;
0ade1984
JH
17
18{
19 package IPC::Semaphore::stat;
20
21 use Class::Struct qw(struct);
22
23 struct 'IPC::Semaphore::stat' => [
24 uid => '$',
25 gid => '$',
26 cuid => '$',
27 cgid => '$',
28 mode => '$',
29 ctime => '$',
30 otime => '$',
31 nsems => '$',
32 ];
33}
34
35sub new {
36 @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )';
37 my $class = shift;
38
39 my $id = semget($_[0],$_[1],$_[2]);
40
41 defined($id)
42 ? bless \$id, $class
43 : undef;
44}
45
46sub id {
47 my $self = shift;
48 $$self;
49}
50
51sub remove {
52 my $self = shift;
53 (semctl($$self,0,IPC_RMID,0), undef $$self)[0];
54}
55
56sub getncnt {
57 @_ == 2 || croak '$sem->getncnt( SEM )';
58 my $self = shift;
59 my $sem = shift;
60 my $v = semctl($$self,$sem,GETNCNT,0);
61 $v ? 0 + $v : undef;
62}
63
64sub getzcnt {
65 @_ == 2 || croak '$sem->getzcnt( SEM )';
66 my $self = shift;
67 my $sem = shift;
68 my $v = semctl($$self,$sem,GETZCNT,0);
69 $v ? 0 + $v : undef;
70}
71
72sub getval {
73 @_ == 2 || croak '$sem->getval( SEM )';
74 my $self = shift;
75 my $sem = shift;
76 my $v = semctl($$self,$sem,GETVAL,0);
77 $v ? 0 + $v : undef;
78}
79
80sub getpid {
81 @_ == 2 || croak '$sem->getpid( SEM )';
82 my $self = shift;
83 my $sem = shift;
84 my $v = semctl($$self,$sem,GETPID,0);
85 $v ? 0 + $v : undef;
86}
87
88sub op {
89 @_ >= 4 || croak '$sem->op( OPLIST )';
90 my $self = shift;
91 croak 'Bad arg count' if @_ % 3;
24342b83 92 my $data = pack("s!*",@_);
0ade1984
JH
93 semop($$self,$data);
94}
95
96sub stat {
97 my $self = shift;
98 my $data = "";
99 semctl($$self,0,IPC_STAT,$data)
100 or return undef;
101 IPC::Semaphore::stat->new->unpack($data);
102}
103
104sub set {
105 my $self = shift;
106 my $ds;
107
108 if(@_ == 1) {
109 $ds = shift;
110 }
111 else {
112 croak 'Bad arg count' if @_ % 2;
113 my %arg = @_;
fcf3e904 114 $ds = $self->stat
0ade1984
JH
115 or return undef;
116 my($key,$val);
117 $ds->$key($val)
118 while(($key,$val) = each %arg);
119 }
120
121 my $v = semctl($$self,0,IPC_SET,$ds->pack);
122 $v ? 0 + $v : undef;
123}
124
125sub getall {
126 my $self = shift;
127 my $data = "";
128 semctl($$self,0,GETALL,$data)
129 or return ();
24342b83 130 (unpack("s!*",$data));
0ade1984
JH
131}
132
133sub setall {
134 my $self = shift;
24342b83 135 my $data = pack("s!*",@_);
0ade1984
JH
136 semctl($$self,0,SETALL,$data);
137}
138
139sub setval {
140 @_ == 3 || croak '$sem->setval( SEM, VAL )';
141 my $self = shift;
142 my $sem = shift;
143 my $val = shift;
144 semctl($$self,$sem,SETVAL,$val);
145}
146
1471;
148
149__END__
150
151=head1 NAME
152
153IPC::Semaphore - SysV Semaphore IPC object class
154
155=head1 SYNOPSIS
156
7b34eba2 157 use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT);
0ade1984 158 use IPC::Semaphore;
3cb6de81 159
7b34eba2 160 $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRUSR | S_IWUSR | IPC_CREAT);
3cb6de81 161
0ade1984 162 $sem->setall( (0) x 10);
3cb6de81 163
0ade1984 164 @sem = $sem->getall;
3cb6de81 165
0ade1984 166 $ncnt = $sem->getncnt;
3cb6de81 167
0ade1984 168 $zcnt = $sem->getzcnt;
3cb6de81 169
0ade1984 170 $ds = $sem->stat;
3cb6de81 171
0ade1984
JH
172 $sem->remove;
173
174=head1 DESCRIPTION
175
bbc7dcd2
MS
176A class providing an object based interface to SysV IPC semaphores.
177
0ade1984
JH
178=head1 METHODS
179
180=over 4
181
182=item new ( KEY , NSEMS , FLAGS )
183
184Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
185of semaphores in the set. A new set is created if
186
187=over 4
188
189=item *
190
191C<KEY> is equal to C<IPC_PRIVATE>
192
193=item *
194
195C<KEY> does not already have a semaphore identifier
196associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
197
198=back
199
200On creation of a new semaphore set C<FLAGS> is used to set the
7b34eba2
JH
201permissions. Be careful not to set any flags that the Sys V
202IPC implementation does not allow: in some systems setting
203execute bits makes the operations fail.
0ade1984
JH
204
205=item getall
206
207Returns the values of the semaphore set as an array.
208
209=item getncnt ( SEM )
210
dad0832b 211Returns the number of processes waiting for the semaphore C<SEM> to
022735b4 212become greater than its current value
0ade1984
JH
213
214=item getpid ( SEM )
215
216Returns the process id of the last process that performed an operation
217on the semaphore C<SEM>.
218
219=item getval ( SEM )
220
221Returns the current value of the semaphore C<SEM>.
222
223=item getzcnt ( SEM )
224
dad0832b 225Returns the number of processes waiting for the semaphore C<SEM> to
0ade1984
JH
226become zero.
227
228=item id
229
230Returns the system identifier for the semaphore set.
231
232=item op ( OPLIST )
233
234C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
235a concatenation of smaller lists, each which has three values. The
236first is the semaphore number, the second is the operation and the last
237is a flags value. See L<semop> for more details. For example
238
239 $sem->op(
240 0, -1, IPC_NOWAIT,
241 1, 1, IPC_NOWAIT
242 );
243
244=item remove
245
246Remove and destroy the semaphore set from the system.
247
248=item set ( STAT )
249
250=item set ( NAME => VALUE [, NAME => VALUE ...] )
251
252C<set> will set the following values of the C<stat> structure associated
253with the semaphore set.
254
255 uid
256 gid
dad0832b 257 mode (only the permission bits)
0ade1984
JH
258
259C<set> accepts either a stat object, as returned by the C<stat> method,
260or a list of I<name>-I<value> pairs.
261
262=item setall ( VALUES )
263
264Sets all values in the semaphore set to those given on the C<VALUES> list.
265C<VALUES> must contain the correct number of values.
266
267=item setval ( N , VALUE )
268
269Set the C<N>th value in the semaphore set to C<VALUE>
270
271=item stat
272
273Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
274C<Class::Struct>. It provides the following fields. For a description
dad0832b 275of these fields see your system documentation.
0ade1984
JH
276
277 uid
278 gid
279 cuid
280 cgid
281 mode
282 ctime
283 otime
284 nsems
285
286=back
287
288=head1 SEE ALSO
289
290L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop>
291
292=head1 AUTHOR
293
294Graham Barr <gbarr@pobox.com>
295
296=head1 COPYRIGHT
297
298Copyright (c) 1997 Graham Barr. All rights reserved.
299This program is free software; you can redistribute it and/or modify it
300under the same terms as Perl itself.
301
302=cut