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.
7 package IPC::Semaphore;
9 use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL
10 IPC_STAT IPC_SET IPC_RMID);
12 use vars qw($VERSION);
16 $VERSION = eval $VERSION;
19 package IPC::Semaphore::stat;
21 use Class::Struct qw(struct);
23 struct 'IPC::Semaphore::stat' => [
36 @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )';
39 my $id = semget($_[0],$_[1],$_[2]);
53 (semctl($$self,0,IPC_RMID,0), undef $$self)[0];
57 @_ == 2 || croak '$sem->getncnt( SEM )';
60 my $v = semctl($$self,$sem,GETNCNT,0);
65 @_ == 2 || croak '$sem->getzcnt( SEM )';
68 my $v = semctl($$self,$sem,GETZCNT,0);
73 @_ == 2 || croak '$sem->getval( SEM )';
76 my $v = semctl($$self,$sem,GETVAL,0);
81 @_ == 2 || croak '$sem->getpid( SEM )';
84 my $v = semctl($$self,$sem,GETPID,0);
89 @_ >= 4 || croak '$sem->op( OPLIST )';
91 croak 'Bad arg count' if @_ % 3;
92 my $data = pack("s!*",@_);
99 semctl($$self,0,IPC_STAT,$data)
101 IPC::Semaphore::stat->new->unpack($data);
112 croak 'Bad arg count' if @_ % 2;
118 while(($key,$val) = each %arg);
121 my $v = semctl($$self,0,IPC_SET,$ds->pack);
128 semctl($$self,0,GETALL,$data)
130 (unpack("s!*",$data));
135 my $data = pack("s!*",@_);
136 semctl($$self,0,SETALL,$data);
140 @_ == 3 || croak '$sem->setval( SEM, VAL )';
144 semctl($$self,$sem,SETVAL,$val);
153 IPC::Semaphore - SysV Semaphore IPC object class
157 use IPC::SysV qw(IPC_PRIVATE S_IRWXU IPC_CREAT);
160 $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | IPC_CREAT);
162 $sem->setall( (0) x 10);
166 $ncnt = $sem->getncnt;
168 $zcnt = $sem->getzcnt;
176 A class providing an object based interface to SysV IPC semaphores.
182 =item new ( KEY , NSEMS , FLAGS )
184 Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
185 of semaphores in the set. A new set is created if
191 C<KEY> is equal to C<IPC_PRIVATE>
195 C<KEY> does not already have a semaphore identifier
196 associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
200 On creation of a new semaphore set C<FLAGS> is used to set the
205 Returns the values of the semaphore set as an array.
207 =item getncnt ( SEM )
209 Returns the number of processes waiting for the semaphore C<SEM> to
210 become greater than its current value
214 Returns the process id of the last process that performed an operation
215 on the semaphore C<SEM>.
219 Returns the current value of the semaphore C<SEM>.
221 =item getzcnt ( SEM )
223 Returns the number of processes waiting for the semaphore C<SEM> to
228 Returns the system identifier for the semaphore set.
232 C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
233 a concatenation of smaller lists, each which has three values. The
234 first is the semaphore number, the second is the operation and the last
235 is a flags value. See L<semop> for more details. For example
244 Remove and destroy the semaphore set from the system.
248 =item set ( NAME => VALUE [, NAME => VALUE ...] )
250 C<set> will set the following values of the C<stat> structure associated
251 with the semaphore set.
255 mode (only the permission bits)
257 C<set> accepts either a stat object, as returned by the C<stat> method,
258 or a list of I<name>-I<value> pairs.
260 =item setall ( VALUES )
262 Sets all values in the semaphore set to those given on the C<VALUES> list.
263 C<VALUES> must contain the correct number of values.
265 =item setval ( N , VALUE )
267 Set the C<N>th value in the semaphore set to C<VALUE>
271 Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
272 C<Class::Struct>. It provides the following fields. For a description
273 of these fields see your system documentation.
288 L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop>
292 Graham Barr <gbarr@pobox.com>
296 Copyright (c) 1997 Graham Barr. All rights reserved.
297 This program is free software; you can redistribute it and/or modify it
298 under the same terms as Perl itself.