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);
18 package IPC::Semaphore::stat;
20 use Class::Struct qw(struct);
22 struct 'IPC::Semaphore::stat' => [
35 @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )';
38 my $id = semget($_[0],$_[1],$_[2]);
52 (semctl($$self,0,IPC_RMID,0), undef $$self)[0];
56 @_ == 2 || croak '$sem->getncnt( SEM )';
59 my $v = semctl($$self,$sem,GETNCNT,0);
64 @_ == 2 || croak '$sem->getzcnt( SEM )';
67 my $v = semctl($$self,$sem,GETZCNT,0);
72 @_ == 2 || croak '$sem->getval( SEM )';
75 my $v = semctl($$self,$sem,GETVAL,0);
80 @_ == 2 || croak '$sem->getpid( SEM )';
83 my $v = semctl($$self,$sem,GETPID,0);
88 @_ >= 4 || croak '$sem->op( OPLIST )';
90 croak 'Bad arg count' if @_ % 3;
91 my $data = pack("s!*",@_);
98 semctl($$self,0,IPC_STAT,$data)
100 IPC::Semaphore::stat->new->unpack($data);
111 croak 'Bad arg count' if @_ % 2;
117 while(($key,$val) = each %arg);
120 my $v = semctl($$self,0,IPC_SET,$ds->pack);
127 semctl($$self,0,GETALL,$data)
129 (unpack("s!*",$data));
134 my $data = pack("s!*",@_);
135 semctl($$self,0,SETALL,$data);
139 @_ == 3 || croak '$sem->setval( SEM, VAL )';
143 semctl($$self,$sem,SETVAL,$val);
152 IPC::Semaphore - SysV Semaphore IPC object class
156 use IPC::SysV qw(IPC_PRIVATE S_IRWXU IPC_CREAT);
159 $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | IPC_CREAT);
161 $sem->setall( (0) x 10);
165 $ncnt = $sem->getncnt;
167 $zcnt = $sem->getzcnt;
175 A class providing an object based interface to SysV IPC semaphores.
181 =item new ( KEY , NSEMS , FLAGS )
183 Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
184 of semaphores in the set. A new set is created if
190 C<KEY> is equal to C<IPC_PRIVATE>
194 C<KEY> does not already have a semaphore identifier
195 associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
199 On creation of a new semaphore set C<FLAGS> is used to set the
204 Returns the values of the semaphore set as an array.
206 =item getncnt ( SEM )
208 Returns the number of processed waiting for the semaphore C<SEM> to
209 become greater than its current value
213 Returns the process id of the last process that performed an operation
214 on the semaphore C<SEM>.
218 Returns the current value of the semaphore C<SEM>.
220 =item getzcnt ( SEM )
222 Returns the number of processed waiting for the semaphore C<SEM> to
227 Returns the system identifier for the semaphore set.
231 C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
232 a concatenation of smaller lists, each which has three values. The
233 first is the semaphore number, the second is the operation and the last
234 is a flags value. See L<semop> for more details. For example
243 Remove and destroy the semaphore set from the system.
247 =item set ( NAME => VALUE [, NAME => VALUE ...] )
249 C<set> will set the following values of the C<stat> structure associated
250 with the semaphore set.
254 mode (oly the permission bits)
256 C<set> accepts either a stat object, as returned by the C<stat> method,
257 or a list of I<name>-I<value> pairs.
259 =item setall ( VALUES )
261 Sets all values in the semaphore set to those given on the C<VALUES> list.
262 C<VALUES> must contain the correct number of values.
264 =item setval ( N , VALUE )
266 Set the C<N>th value in the semaphore set to C<VALUE>
270 Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
271 C<Class::Struct>. It provides the following fields. For a description
272 of these fields see you system documentation.
287 L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop>
291 Graham Barr <gbarr@pobox.com>
295 Copyright (c) 1997 Graham Barr. All rights reserved.
296 This program is free software; you can redistribute it and/or modify it
297 under the same terms as Perl itself.