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;
179 =item new ( KEY , NSEMS , FLAGS )
181 Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
182 of semaphores in the set. A new set is created if
188 C<KEY> is equal to C<IPC_PRIVATE>
192 C<KEY> does not already have a semaphore identifier
193 associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
197 On creation of a new semaphore set C<FLAGS> is used to set the
202 Returns the values of the semaphore set as an array.
204 =item getncnt ( SEM )
206 Returns the number of processed waiting for the semaphore C<SEM> to
207 become greater than it's current value
211 Returns the process id of the last process that performed an operation
212 on the semaphore C<SEM>.
216 Returns the current value of the semaphore C<SEM>.
218 =item getzcnt ( SEM )
220 Returns the number of processed waiting for the semaphore C<SEM> to
225 Returns the system identifier for the semaphore set.
229 C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
230 a concatenation of smaller lists, each which has three values. The
231 first is the semaphore number, the second is the operation and the last
232 is a flags value. See L<semop> for more details. For example
241 Remove and destroy the semaphore set from the system.
245 =item set ( NAME => VALUE [, NAME => VALUE ...] )
247 C<set> will set the following values of the C<stat> structure associated
248 with the semaphore set.
252 mode (oly the permission bits)
254 C<set> accepts either a stat object, as returned by the C<stat> method,
255 or a list of I<name>-I<value> pairs.
257 =item setall ( VALUES )
259 Sets all values in the semaphore set to those given on the C<VALUES> list.
260 C<VALUES> must contain the correct number of values.
262 =item setval ( N , VALUE )
264 Set the C<N>th value in the semaphore set to C<VALUE>
268 Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
269 C<Class::Struct>. It provides the following fields. For a description
270 of these fields see you system documentation.
285 L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop>
289 Graham Barr <gbarr@pobox.com>
293 Copyright (c) 1997 Graham Barr. All rights reserved.
294 This program is free software; you can redistribute it and/or modify it
295 under the same terms as Perl itself.