[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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 7 package IPC::Semaphore; 8 9 use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL 10 IPC_STAT IPC_SET IPC_RMID); 11 use strict; 12 use vars qw($VERSION); 13 use Carp; 14 15 $VERSION = "1.02"; 16 $VERSION = eval $VERSION; 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 35 sub 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 46 sub id { 47 my $self = shift; 48 $$self; 49 } 50 51 sub remove { 52 my $self = shift; 53 (semctl($$self,0,IPC_RMID,0), undef $$self)[0]; 54 } 55 56 sub 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 64 sub 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 72 sub 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 80 sub 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 88 sub op { 89 @_ >= 4 || croak '$sem->op( OPLIST )'; 90 my $self = shift; 91 croak 'Bad arg count' if @_ % 3; 92 my $data = pack("s!*",@_); 93 semop($$self,$data); 94 } 95 96 sub 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 104 sub 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 = @_; 114 $ds = $self->stat 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 125 sub getall { 126 my $self = shift; 127 my $data = ""; 128 semctl($$self,0,GETALL,$data) 129 or return (); 130 (unpack("s!*",$data)); 131 } 132 133 sub setall { 134 my $self = shift; 135 my $data = pack("s!*",@_); 136 semctl($$self,0,SETALL,$data); 137 } 138 139 sub 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 147 1; 148 149 __END__ 150 151 =head1 NAME 152 153 IPC::Semaphore - SysV Semaphore IPC object class 154 155 =head1 SYNOPSIS 156 157 use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT); 158 use IPC::Semaphore; 159 160 $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRUSR | S_IWUSR | IPC_CREAT); 161 162 $sem->setall( (0) x 10); 163 164 @sem = $sem->getall; 165 166 $ncnt = $sem->getncnt; 167 168 $zcnt = $sem->getzcnt; 169 170 $ds = $sem->stat; 171 172 $sem->remove; 173 174 =head1 DESCRIPTION 175 176 A class providing an object based interface to SysV IPC semaphores. 177 178 =head1 METHODS 179 180 =over 4 181 182 =item new ( KEY , NSEMS , FLAGS ) 183 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 186 187 =over 4 188 189 =item * 190 191 C<KEY> is equal to C<IPC_PRIVATE> 192 193 =item * 194 195 C<KEY> does not already have a semaphore identifier 196 associated with it, and C<I<FLAGS> & IPC_CREAT> is true. 197 198 =back 199 200 On creation of a new semaphore set C<FLAGS> is used to set the 201 permissions. Be careful not to set any flags that the Sys V 202 IPC implementation does not allow: in some systems setting 203 execute bits makes the operations fail. 204 205 =item getall 206 207 Returns the values of the semaphore set as an array. 208 209 =item getncnt ( SEM ) 210 211 Returns the number of processes waiting for the semaphore C<SEM> to 212 become greater than its current value 213 214 =item getpid ( SEM ) 215 216 Returns the process id of the last process that performed an operation 217 on the semaphore C<SEM>. 218 219 =item getval ( SEM ) 220 221 Returns the current value of the semaphore C<SEM>. 222 223 =item getzcnt ( SEM ) 224 225 Returns the number of processes waiting for the semaphore C<SEM> to 226 become zero. 227 228 =item id 229 230 Returns the system identifier for the semaphore set. 231 232 =item op ( OPLIST ) 233 234 C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is 235 a concatenation of smaller lists, each which has three values. The 236 first is the semaphore number, the second is the operation and the last 237 is 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 246 Remove and destroy the semaphore set from the system. 247 248 =item set ( STAT ) 249 250 =item set ( NAME => VALUE [, NAME => VALUE ...] ) 251 252 C<set> will set the following values of the C<stat> structure associated 253 with the semaphore set. 254 255 uid 256 gid 257 mode (only the permission bits) 258 259 C<set> accepts either a stat object, as returned by the C<stat> method, 260 or a list of I<name>-I<value> pairs. 261 262 =item setall ( VALUES ) 263 264 Sets all values in the semaphore set to those given on the C<VALUES> list. 265 C<VALUES> must contain the correct number of values. 266 267 =item setval ( N , VALUE ) 268 269 Set the C<N>th value in the semaphore set to C<VALUE> 270 271 =item stat 272 273 Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of 274 C<Class::Struct>. It provides the following fields. For a description 275 of these fields see your system documentation. 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 290 L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop> 291 292 =head1 AUTHOR 293 294 Graham Barr <gbarr@pobox.com> 295 296 =head1 COPYRIGHT 297 298 Copyright (c) 1997 Graham Barr. All rights reserved. 299 This program is free software; you can redistribute it and/or modify it 300 under the same terms as Perl itself. 301 302 =cut
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |