aboutsummaryrefslogtreecommitdiff
path: root/contrib/perl5/ext/IPC/SysV/Semaphore.pm
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/ext/IPC/SysV/Semaphore.pm')
-rw-r--r--contrib/perl5/ext/IPC/SysV/Semaphore.pm297
1 files changed, 0 insertions, 297 deletions
diff --git a/contrib/perl5/ext/IPC/SysV/Semaphore.pm b/contrib/perl5/ext/IPC/SysV/Semaphore.pm
deleted file mode 100644
index faf7411950b9..000000000000
--- a/contrib/perl5/ext/IPC/SysV/Semaphore.pm
+++ /dev/null
@@ -1,297 +0,0 @@
-# IPC::Semaphore
-#
-# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package IPC::Semaphore;
-
-use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL
- IPC_STAT IPC_SET IPC_RMID);
-use strict;
-use vars qw($VERSION);
-use Carp;
-
-$VERSION = "1.00";
-
-{
- package IPC::Semaphore::stat;
-
- use Class::Struct qw(struct);
-
- struct 'IPC::Semaphore::stat' => [
- uid => '$',
- gid => '$',
- cuid => '$',
- cgid => '$',
- mode => '$',
- ctime => '$',
- otime => '$',
- nsems => '$',
- ];
-}
-
-sub new {
- @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )';
- my $class = shift;
-
- my $id = semget($_[0],$_[1],$_[2]);
-
- defined($id)
- ? bless \$id, $class
- : undef;
-}
-
-sub id {
- my $self = shift;
- $$self;
-}
-
-sub remove {
- my $self = shift;
- (semctl($$self,0,IPC_RMID,0), undef $$self)[0];
-}
-
-sub getncnt {
- @_ == 2 || croak '$sem->getncnt( SEM )';
- my $self = shift;
- my $sem = shift;
- my $v = semctl($$self,$sem,GETNCNT,0);
- $v ? 0 + $v : undef;
-}
-
-sub getzcnt {
- @_ == 2 || croak '$sem->getzcnt( SEM )';
- my $self = shift;
- my $sem = shift;
- my $v = semctl($$self,$sem,GETZCNT,0);
- $v ? 0 + $v : undef;
-}
-
-sub getval {
- @_ == 2 || croak '$sem->getval( SEM )';
- my $self = shift;
- my $sem = shift;
- my $v = semctl($$self,$sem,GETVAL,0);
- $v ? 0 + $v : undef;
-}
-
-sub getpid {
- @_ == 2 || croak '$sem->getpid( SEM )';
- my $self = shift;
- my $sem = shift;
- my $v = semctl($$self,$sem,GETPID,0);
- $v ? 0 + $v : undef;
-}
-
-sub op {
- @_ >= 4 || croak '$sem->op( OPLIST )';
- my $self = shift;
- croak 'Bad arg count' if @_ % 3;
- my $data = pack("s*",@_);
- semop($$self,$data);
-}
-
-sub stat {
- my $self = shift;
- my $data = "";
- semctl($$self,0,IPC_STAT,$data)
- or return undef;
- IPC::Semaphore::stat->new->unpack($data);
-}
-
-sub set {
- my $self = shift;
- my $ds;
-
- if(@_ == 1) {
- $ds = shift;
- }
- else {
- croak 'Bad arg count' if @_ % 2;
- my %arg = @_;
- my $ds = $self->stat
- or return undef;
- my($key,$val);
- $ds->$key($val)
- while(($key,$val) = each %arg);
- }
-
- my $v = semctl($$self,0,IPC_SET,$ds->pack);
- $v ? 0 + $v : undef;
-}
-
-sub getall {
- my $self = shift;
- my $data = "";
- semctl($$self,0,GETALL,$data)
- or return ();
- (unpack("s*",$data));
-}
-
-sub setall {
- my $self = shift;
- my $data = pack("s*",@_);
- semctl($$self,0,SETALL,$data);
-}
-
-sub setval {
- @_ == 3 || croak '$sem->setval( SEM, VAL )';
- my $self = shift;
- my $sem = shift;
- my $val = shift;
- semctl($$self,$sem,SETVAL,$val);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-IPC::Semaphore - SysV Semaphore IPC object class
-
-=head1 SYNOPSIS
-
- use IPC::SysV qw(IPC_PRIVATE S_IRWXU IPC_CREAT);
- use IPC::Semaphore;
-
- $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | IPC_CREAT);
-
- $sem->setall( (0) x 10);
-
- @sem = $sem->getall;
-
- $ncnt = $sem->getncnt;
-
- $zcnt = $sem->getzcnt;
-
- $ds = $sem->stat;
-
- $sem->remove;
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=over 4
-
-=item new ( KEY , NSEMS , FLAGS )
-
-Create a new semaphore set associated with C<KEY>. C<NSEMS> is the number
-of semaphores in the set. A new set is created if
-
-=over 4
-
-=item *
-
-C<KEY> is equal to C<IPC_PRIVATE>
-
-=item *
-
-C<KEY> does not already have a semaphore identifier
-associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
-
-=back
-
-On creation of a new semaphore set C<FLAGS> is used to set the
-permissions.
-
-=item getall
-
-Returns the values of the semaphore set as an array.
-
-=item getncnt ( SEM )
-
-Returns the number of processed waiting for the semaphore C<SEM> to
-become greater than it's current value
-
-=item getpid ( SEM )
-
-Returns the process id of the last process that performed an operation
-on the semaphore C<SEM>.
-
-=item getval ( SEM )
-
-Returns the current value of the semaphore C<SEM>.
-
-=item getzcnt ( SEM )
-
-Returns the number of processed waiting for the semaphore C<SEM> to
-become zero.
-
-=item id
-
-Returns the system identifier for the semaphore set.
-
-=item op ( OPLIST )
-
-C<OPLIST> is a list of operations to pass to C<semop>. C<OPLIST> is
-a concatenation of smaller lists, each which has three values. The
-first is the semaphore number, the second is the operation and the last
-is a flags value. See L<semop> for more details. For example
-
- $sem->op(
- 0, -1, IPC_NOWAIT,
- 1, 1, IPC_NOWAIT
- );
-
-=item remove
-
-Remove and destroy the semaphore set from the system.
-
-=item set ( STAT )
-
-=item set ( NAME => VALUE [, NAME => VALUE ...] )
-
-C<set> will set the following values of the C<stat> structure associated
-with the semaphore set.
-
- uid
- gid
- mode (oly the permission bits)
-
-C<set> accepts either a stat object, as returned by the C<stat> method,
-or a list of I<name>-I<value> pairs.
-
-=item setall ( VALUES )
-
-Sets all values in the semaphore set to those given on the C<VALUES> list.
-C<VALUES> must contain the correct number of values.
-
-=item setval ( N , VALUE )
-
-Set the C<N>th value in the semaphore set to C<VALUE>
-
-=item stat
-
-Returns an object of type C<IPC::Semaphore::stat> which is a sub-class of
-C<Class::Struct>. It provides the following fields. For a description
-of these fields see you system documentation.
-
- uid
- gid
- cuid
- cgid
- mode
- ctime
- otime
- nsems
-
-=back
-
-=head1 SEE ALSO
-
-L<IPC::SysV> L<Class::Struct> L<semget> L<semctl> L<semop>
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 COPYRIGHT
-
-Copyright (c) 1997 Graham Barr. All rights reserved.
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-13 14:18:01 +0000