diff options
Diffstat (limited to 'contrib/perl5/ext/IPC')
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/ChangeLog | 28 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/MANIFEST | 10 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/Makefile.PL | 38 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/Msg.pm | 223 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/README | 20 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/Semaphore.pm | 297 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/SysV.pm | 102 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/SysV.xs | 443 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/hints/cygwin.pl | 2 | ||||
| -rw-r--r-- | contrib/perl5/ext/IPC/SysV/hints/next_3.pl | 1 | ||||
| -rwxr-xr-x | contrib/perl5/ext/IPC/SysV/t/msg.t | 41 | ||||
| -rwxr-xr-x | contrib/perl5/ext/IPC/SysV/t/sem.t | 51 |
12 files changed, 0 insertions, 1256 deletions
diff --git a/contrib/perl5/ext/IPC/SysV/ChangeLog b/contrib/perl5/ext/IPC/SysV/ChangeLog deleted file mode 100644 index fff95be..0000000 --- a/contrib/perl5/ext/IPC/SysV/ChangeLog +++ /dev/null @@ -1,28 +0,0 @@ -Fri Jul 3 15:06:40 1998 Jarkko Hietaniemi <jhi@iki.fi> - - - Integrated IPC::SysV 1.03 to Perl 5.004_69. - -Change 142 on 1998/05/31 by <gbarr@pobox.com> (Graham Barr) - - - Changed SHMLBA from a constSUB to an XS sub as on some systems it is not - a constant - - Added a missing MODULE line to SysV.xs so ftok is defined in IPC::SysV - -Change 138 on 1998/05/23 by <gbarr@pobox.com> (Graham Barr) - - Applied patch from Jarkko Hietaniemi to add constats for UNICOS - - Reduced size of XS object by changing constant sub definition - into a loop - - Updated POD to include ftok() - -Change 135 on 1998/05/18 by <gbarr@pobox.com> (Graham Barr) - - applied changes from Jarkko Hietaniemi <jhi@iki.fi> to add - new constants and ftok - - fixed to compile with >5.004_50 - - surrounded newCONSTSUB with #ifndef as perl now defines this itself - diff --git a/contrib/perl5/ext/IPC/SysV/MANIFEST b/contrib/perl5/ext/IPC/SysV/MANIFEST deleted file mode 100644 index 4b2aa00..0000000 --- a/contrib/perl5/ext/IPC/SysV/MANIFEST +++ /dev/null @@ -1,10 +0,0 @@ -MANIFEST -Makefile.PL -Msg.pm -README -Semaphore.pm -SysV.pm -SysV.xs -t/msg.t -t/sem.t -ChangeLog diff --git a/contrib/perl5/ext/IPC/SysV/Makefile.PL b/contrib/perl5/ext/IPC/SysV/Makefile.PL deleted file mode 100644 index 6831176..0000000 --- a/contrib/perl5/ext/IPC/SysV/Makefile.PL +++ /dev/null @@ -1,38 +0,0 @@ -# This -*- perl -*- script makes the Makefile -# $Id: Makefile.PL,v 1.3 1997/03/04 09:21:12 gbarr Exp $ -# $FreeBSD$ - -require 5.002; -use ExtUtils::MakeMaker; - -#--- MY package - -sub MY::libscan -{ - my($self,$path) = @_; - - return '' - if($path =~ m:/(RCS|CVS|SCCS)/: || - $path =~ m:[~%]$: || - $path =~ m:\.(orig|rej)$: - ); - - $path; -} - -WriteMakefile( - VERSION_FROM => "SysV.pm", - NAME => "IPC::SysV", - MAN3PODS => {}, # Pods will be built by installman. - - 'dist' => {COMPRESS => 'gzip -9f', - SUFFIX => 'gz', - DIST_DEFAULT => 'all tardist', - }, - - 'clean' => {FILES => join(" ", - map { "$_ */$_ */*/$_" } - qw(*% *.html *.b[ac]k *.old)) - }, - 'macro' => { INSTALLDIRS => 'perl' }, -); diff --git a/contrib/perl5/ext/IPC/SysV/Msg.pm b/contrib/perl5/ext/IPC/SysV/Msg.pm deleted file mode 100644 index 120a5b2..0000000 --- a/contrib/perl5/ext/IPC/SysV/Msg.pm +++ /dev/null @@ -1,223 +0,0 @@ -# IPC::Msg.pm -# -# 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::Msg; - -use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID); -use strict; -use vars qw($VERSION); -use Carp; - -$VERSION = "1.00"; - -{ - package IPC::Msg::stat; - - use Class::Struct qw(struct); - - struct 'IPC::Msg::stat' => [ - uid => '$', - gid => '$', - cuid => '$', - cgid => '$', - mode => '$', - qnum => '$', - qbytes => '$', - lspid => '$', - lrpid => '$', - stime => '$', - rtime => '$', - ctime => '$', - ]; -} - -sub new { - @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )'; - my $class = shift; - - my $id = msgget($_[0],$_[1]); - - defined($id) - ? bless \$id, $class - : undef; -} - -sub id { - my $self = shift; - $$self; -} - -sub stat { - my $self = shift; - my $data = ""; - msgctl($$self,IPC_STAT,$data) or - return undef; - IPC::Msg::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); - } - - msgctl($$self,IPC_SET,$ds->pack); -} - -sub remove { - my $self = shift; - (msgctl($$self,IPC_RMID,0), undef $$self)[0]; -} - -sub rcv { - @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; - my $self = shift; - my $buf = ""; - msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or - return; - my $type; - ($type,$_[0]) = unpack("l! a*",$buf); - $type; -} - -sub snd { - @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )'; - my $self = shift; - msgsnd($$self,pack("l! a*",$_[0],$_[1]), $_[2] || 0); -} - - -1; - -__END__ - -=head1 NAME - -IPC::Msg - SysV Msg IPC object class - -=head1 SYNOPSIS - - use IPC::SysV qw(IPC_PRIVATE S_IRWXU); - use IPC::Msg; - - $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU); - - $msg->snd(pack("l! a*",$msgtype,$msg)); - - $msg->rcv($buf,256); - - $ds = $msg->stat; - - $msg->remove; - -=head1 DESCRIPTION - -=head1 METHODS - -=over 4 - -=item new ( KEY , FLAGS ) - -Creates a new message queue associated with C<KEY>. A new queue is -created if - -=over 4 - -=item * - -C<KEY> is equal to C<IPC_PRIVATE> - -=item * - -C<KEY> does not already have a message queue -associated with it, and C<I<FLAGS> & IPC_CREAT> is true. - -=back - -On creation of a new message queue C<FLAGS> is used to set the -permissions. - -=item id - -Returns the system message queue identifier. - -=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] ) - -Read a message from the queue. Returns the type of the message read. -See L<msgrcv>. The BUF becomes tainted. - -=item remove - -Remove and destroy the message queue 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 message queue. - - uid - gid - mode (oly the permission bits) - qbytes - -C<set> accepts either a stat object, as returned by the C<stat> method, -or a list of I<name>-I<value> pairs. - -=item snd ( TYPE, MSG [, FLAGS ] ) - -Place a message on the queue with the data from C<MSG> and with type C<TYPE>. -See L<msgsnd>. - -=item stat - -Returns an object of type C<IPC::Msg::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 - qnum - qbytes - lspid - lrpid - stime - rtime - ctime - -=back - -=head1 SEE ALSO - -L<IPC::SysV> L<Class::Struct> - -=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 - diff --git a/contrib/perl5/ext/IPC/SysV/README b/contrib/perl5/ext/IPC/SysV/README deleted file mode 100644 index d412c4c..0000000 --- a/contrib/perl5/ext/IPC/SysV/README +++ /dev/null @@ -1,20 +0,0 @@ -Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved. -This package is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -The SysV-IPC contains three packages - - IPC::Semaphore - - Provides an object interface to using SysV IPC semaphores - - IPC::Msg - - Provides an object interface to using SysV IPC messages - - IPC::SysV - - Provides the constants required to use the system SysV IPC calls. - -Currently there is not object support for SysV shared memory, but -SysV::SharedMem is a project for the future. - -Share and enjoy! - diff --git a/contrib/perl5/ext/IPC/SysV/Semaphore.pm b/contrib/perl5/ext/IPC/SysV/Semaphore.pm deleted file mode 100644 index faf7411..0000000 --- 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 diff --git a/contrib/perl5/ext/IPC/SysV/SysV.pm b/contrib/perl5/ext/IPC/SysV/SysV.pm deleted file mode 100644 index bebb8fd..0000000 --- a/contrib/perl5/ext/IPC/SysV/SysV.pm +++ /dev/null @@ -1,102 +0,0 @@ -# IPC::SysV.pm -# -# 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::SysV; - -use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -use Carp; -use Config; - -require Exporter; -@ISA = qw(Exporter); - -$VERSION = "1.03"; - -@EXPORT_OK = qw( - GETALL GETNCNT GETPID GETVAL GETZCNT - - IPC_ALLOC IPC_CREAT IPC_EXCL IPC_GETACL IPC_LOCKED IPC_M - IPC_NOERROR IPC_NOWAIT IPC_PRIVATE IPC_R IPC_RMID IPC_SET - IPC_SETACL IPC_SETLABEL IPC_STAT IPC_W IPC_WANTED - - MSG_FWAIT MSG_LOCKED MSG_MWAIT MSG_NOERROR MSG_QWAIT - MSG_R MSG_RWAIT MSG_STAT MSG_W MSG_WWAIT - - SEM_A SEM_ALLOC SEM_DEST SEM_ERR SEM_ORDER SEM_R SEM_UNDO - - SETALL SETVAL - - SHMLBA - - SHM_A SHM_CLEAR SHM_COPY SHM_DCACHE SHM_DEST SHM_ECACHE - SHM_FMAP SHM_ICACHE SHM_INIT SHM_LOCK SHM_LOCKED SHM_MAP - SHM_NOSWAP SHM_R SHM_RDONLY SHM_REMOVED SHM_RND SHM_SHARE_MMU - SHM_SHATTR SHM_SIZE SHM_UNLOCK SHM_W - - S_IRUSR S_IWUSR S_IRWXU - S_IRGRP S_IWGRP S_IRWXG - S_IROTH S_IWOTH S_IRWXO - - ftok -); - -BOOT_XS: { - # If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO - require DynaLoader; - - # DynaLoader calls dl_load_flags as a static method. - *dl_load_flags = DynaLoader->can('dl_load_flags'); - - do { - __PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap - }->(__PACKAGE__, $VERSION); -} - -1; - -__END__ - -=head1 NAME - -IPC::SysV - SysV IPC constants - -=head1 SYNOPSIS - - use IPC::SysV qw(IPC_STAT IPC_PRIVATE); - -=head1 DESCRIPTION - -C<IPC::SysV> defines and conditionally exports all the constants -defined in your system include files which are needed by the SysV -IPC calls. - -=over - -=item ftok( PATH, ID ) - -Return a key based on PATH and ID, which can be used as a key for -C<msgget>, C<semget> and C<shmget>. See L<ftok> - -=back - -=head1 SEE ALSO - -L<IPC::Msg>, L<IPC::Semaphore>, L<ftok> - -=head1 AUTHORS - -Graham Barr <gbarr@pobox.com> -Jarkko Hietaniemi <jhi@iki.fi> - -=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 - diff --git a/contrib/perl5/ext/IPC/SysV/SysV.xs b/contrib/perl5/ext/IPC/SysV/SysV.xs deleted file mode 100644 index c7985f9..0000000 --- a/contrib/perl5/ext/IPC/SysV/SysV.xs +++ /dev/null @@ -1,443 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <sys/types.h> -#ifdef __linux__ -# include <asm/page.h> -#endif -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) -#ifndef HAS_SEM -# include <sys/ipc.h> -#endif -# ifdef HAS_MSG -# include <sys/msg.h> -# endif -# ifdef HAS_SHM -# if defined(PERL_SCO) || defined(PERL_ISC) -# include <sys/sysmacros.h> /* SHMLBA */ -# endif -# include <sys/shm.h> -# ifndef HAS_SHMAT_PROTOTYPE - extern Shmat_t shmat (int, char *, int); -# endif -# if defined(__sparc__) && (defined(__NetBSD__) || defined(__OpenBSD__)) -# undef SHMLBA /* not static: determined at boot time */ -# define SHMLBA getpagesize() -# endif -# endif -#endif - -/* Required to get 'struct pte' for SHMLBA on ULTRIX. */ -#if defined(__ultrix) || defined(__ultrix__) || defined(ultrix) -#include <machine/pte.h> -#endif - -/* Required in BSDI to get PAGE_SIZE definition for SHMLBA. - * Ugly. More beautiful solutions welcome. - * Shouting at BSDI sounds quite beautiful. */ -#ifdef __bsdi__ -# include <vm/vm_param.h> /* move upwards under HAS_SHM? */ -#endif - -#ifndef S_IRWXU -# ifdef S_IRUSR -# define S_IRWXU (S_IRUSR|S_IWUSR|S_IWUSR) -# define S_IRWXG (S_IRGRP|S_IWGRP|S_IWGRP) -# define S_IRWXO (S_IROTH|S_IWOTH|S_IWOTH) -# else -# define S_IRWXU 0700 -# define S_IRWXG 0070 -# define S_IRWXO 0007 -# endif -#endif - -MODULE=IPC::SysV PACKAGE=IPC::Msg::stat - -PROTOTYPES: ENABLE - -void -pack(obj) - SV * obj -PPCODE: -{ -#ifdef HAS_MSG - SV *sv; - struct msqid_ds ds; - AV *list = (AV*)SvRV(obj); - sv = *av_fetch(list,0,TRUE); ds.msg_perm.uid = SvIV(sv); - sv = *av_fetch(list,1,TRUE); ds.msg_perm.gid = SvIV(sv); - sv = *av_fetch(list,4,TRUE); ds.msg_perm.mode = SvIV(sv); - sv = *av_fetch(list,6,TRUE); ds.msg_qbytes = SvIV(sv); - ST(0) = sv_2mortal(newSVpvn((char *)&ds,sizeof(ds))); - XSRETURN(1); -#else - croak("System V msgxxx is not implemented on this machine"); -#endif -} - -void -unpack(obj,buf) - SV * obj - SV * buf -PPCODE: -{ -#ifdef HAS_MSG - STRLEN len; - SV **sv_ptr; - struct msqid_ds *ds = (struct msqid_ds *)SvPV(buf,len); - AV *list = (AV*)SvRV(obj); - if (len != sizeof(*ds)) { - croak("Bad arg length for %s, length is %d, should be %d", - "IPC::Msg::stat", - len, sizeof(*ds)); - } - sv_ptr = av_fetch(list,0,TRUE); - sv_setiv(*sv_ptr, ds->msg_perm.uid); - sv_ptr = av_fetch(list,1,TRUE); - sv_setiv(*sv_ptr, ds->msg_perm.gid); - sv_ptr = av_fetch(list,2,TRUE); - sv_setiv(*sv_ptr, ds->msg_perm.cuid); - sv_ptr = av_fetch(list,3,TRUE); - sv_setiv(*sv_ptr, ds->msg_perm.cgid); - sv_ptr = av_fetch(list,4,TRUE); - sv_setiv(*sv_ptr, ds->msg_perm.mode); - sv_ptr = av_fetch(list,5,TRUE); - sv_setiv(*sv_ptr, ds->msg_qnum); - sv_ptr = av_fetch(list,6,TRUE); - sv_setiv(*sv_ptr, ds->msg_qbytes); - sv_ptr = av_fetch(list,7,TRUE); - sv_setiv(*sv_ptr, ds->msg_lspid); - sv_ptr = av_fetch(list,8,TRUE); - sv_setiv(*sv_ptr, ds->msg_lrpid); - sv_ptr = av_fetch(list,9,TRUE); - sv_setiv(*sv_ptr, ds->msg_stime); - sv_ptr = av_fetch(list,10,TRUE); - sv_setiv(*sv_ptr, ds->msg_rtime); - sv_ptr = av_fetch(list,11,TRUE); - sv_setiv(*sv_ptr, ds->msg_ctime); - XSRETURN(1); -#else - croak("System V msgxxx is not implemented on this machine"); -#endif -} - -MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat - -void -unpack(obj,ds) - SV * obj - SV * ds -PPCODE: -{ -#ifdef HAS_SEM - STRLEN len; - AV *list = (AV*)SvRV(obj); - struct semid_ds *data = (struct semid_ds *)SvPV(ds,len); - if(!sv_isa(obj, "IPC::Semaphore::stat")) - croak("method %s not called a %s object", - "unpack","IPC::Semaphore::stat"); - if (len != sizeof(*data)) { - croak("Bad arg length for %s, length is %d, should be %d", - "IPC::Semaphore::stat", - len, sizeof(*data)); - } - sv_setiv(*av_fetch(list,0,TRUE), data[0].sem_perm.uid); - sv_setiv(*av_fetch(list,1,TRUE), data[0].sem_perm.gid); - sv_setiv(*av_fetch(list,2,TRUE), data[0].sem_perm.cuid); - sv_setiv(*av_fetch(list,3,TRUE), data[0].sem_perm.cgid); - sv_setiv(*av_fetch(list,4,TRUE), data[0].sem_perm.mode); - sv_setiv(*av_fetch(list,5,TRUE), data[0].sem_ctime); - sv_setiv(*av_fetch(list,6,TRUE), data[0].sem_otime); - sv_setiv(*av_fetch(list,7,TRUE), data[0].sem_nsems); - XSRETURN(1); -#else - croak("System V semxxx is not implemented on this machine"); -#endif -} - -void -pack(obj) - SV * obj -PPCODE: -{ -#ifdef HAS_SEM - SV **sv_ptr; - SV *sv; - struct semid_ds ds; - AV *list = (AV*)SvRV(obj); - if(!sv_isa(obj, "IPC::Semaphore::stat")) - croak("method %s not called a %s object", - "pack","IPC::Semaphore::stat"); - if((sv_ptr = av_fetch(list,0,TRUE)) && (sv = *sv_ptr)) - ds.sem_perm.uid = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,1,TRUE)) && (sv = *sv_ptr)) - ds.sem_perm.gid = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,2,TRUE)) && (sv = *sv_ptr)) - ds.sem_perm.cuid = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,3,TRUE)) && (sv = *sv_ptr)) - ds.sem_perm.cgid = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,4,TRUE)) && (sv = *sv_ptr)) - ds.sem_perm.mode = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,5,TRUE)) && (sv = *sv_ptr)) - ds.sem_ctime = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,6,TRUE)) && (sv = *sv_ptr)) - ds.sem_otime = SvIV(*sv_ptr); - if((sv_ptr = av_fetch(list,7,TRUE)) && (sv = *sv_ptr)) - ds.sem_nsems = SvIV(*sv_ptr); - ST(0) = sv_2mortal(newSVpvn((char *)&ds,sizeof(ds))); - XSRETURN(1); -#else - croak("System V semxxx is not implemented on this machine"); -#endif -} - -MODULE=IPC::SysV PACKAGE=IPC::SysV - -void -ftok(path, id) - char * path - int id - CODE: -#if defined(HAS_SEM) || defined(HAS_SHM) - key_t k = ftok(path, id); - ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k)); -#else - DIE(aTHX_ PL_no_func, "ftok"); -#endif - -void -SHMLBA() - CODE: -#ifdef SHMLBA - ST(0) = sv_2mortal(newSViv(SHMLBA)); -#else - croak("SHMLBA is not defined on this architecture"); -#endif - -BOOT: -{ - HV *stash = gv_stashpvn("IPC::SysV", 9, TRUE); - /* - * constant subs for IPC::SysV - */ - struct { char *n; I32 v; } IPC__SysV__const[] = { -#ifdef GETVAL - {"GETVAL", GETVAL}, -#endif -#ifdef GETPID - {"GETPID", GETPID}, -#endif -#ifdef GETNCNT - {"GETNCNT", GETNCNT}, -#endif -#ifdef GETZCNT - {"GETZCNT", GETZCNT}, -#endif -#ifdef GETALL - {"GETALL", GETALL}, -#endif -#ifdef IPC_ALLOC - {"IPC_ALLOC", IPC_ALLOC}, -#endif -#ifdef IPC_CREAT - {"IPC_CREAT", IPC_CREAT}, -#endif -#ifdef IPC_EXCL - {"IPC_EXCL", IPC_EXCL}, -#endif -#ifdef IPC_GETACL - {"IPC_GETACL", IPC_EXCL}, -#endif -#ifdef IPC_LOCKED - {"IPC_LOCKED", IPC_LOCKED}, -#endif -#ifdef IPC_M - {"IPC_M", IPC_M}, -#endif -#ifdef IPC_NOERROR - {"IPC_NOERROR", IPC_NOERROR}, -#endif -#ifdef IPC_NOWAIT - {"IPC_NOWAIT", IPC_NOWAIT}, -#endif -#ifdef IPC_PRIVATE - {"IPC_PRIVATE", IPC_PRIVATE}, -#endif -#ifdef IPC_R - {"IPC_R", IPC_R}, -#endif -#ifdef IPC_RMID - {"IPC_RMID", IPC_RMID}, -#endif -#ifdef IPC_SET - {"IPC_SET", IPC_SET}, -#endif -#ifdef IPC_SETACL - {"IPC_SETACL", IPC_SETACL}, -#endif -#ifdef IPC_SETLABEL - {"IPC_SETLABEL", IPC_SETLABEL}, -#endif -#ifdef IPC_STAT - {"IPC_STAT", IPC_STAT}, -#endif -#ifdef IPC_W - {"IPC_W", IPC_W}, -#endif -#ifdef IPC_WANTED - {"IPC_WANTED", IPC_WANTED}, -#endif -#ifdef MSG_NOERROR - {"MSG_NOERROR", MSG_NOERROR}, -#endif -#ifdef MSG_FWAIT - {"MSG_FWAIT", MSG_FWAIT}, -#endif -#ifdef MSG_LOCKED - {"MSG_LOCKED", MSG_LOCKED}, -#endif -#ifdef MSG_MWAIT - {"MSG_MWAIT", MSG_MWAIT}, -#endif -#ifdef MSG_WAIT - {"MSG_WAIT", MSG_WAIT}, -#endif -#ifdef MSG_R - {"MSG_R", MSG_R}, -#endif -#ifdef MSG_RWAIT - {"MSG_RWAIT", MSG_RWAIT}, -#endif -#ifdef MSG_STAT - {"MSG_STAT", MSG_STAT}, -#endif -#ifdef MSG_W - {"MSG_W", MSG_W}, -#endif -#ifdef MSG_WWAIT - {"MSG_WWAIT", MSG_WWAIT}, -#endif -#ifdef SEM_A - {"SEM_A", SEM_A}, -#endif -#ifdef SEM_ALLOC - {"SEM_ALLOC", SEM_ALLOC}, -#endif -#ifdef SEM_DEST - {"SEM_DEST", SEM_DEST}, -#endif -#ifdef SEM_ERR - {"SEM_ERR", SEM_ERR}, -#endif -#ifdef SEM_R - {"SEM_R", SEM_R}, -#endif -#ifdef SEM_ORDER - {"SEM_ORDER", SEM_ORDER}, -#endif -#ifdef SEM_UNDO - {"SEM_UNDO", SEM_UNDO}, -#endif -#ifdef SETVAL - {"SETVAL", SETVAL}, -#endif -#ifdef SETALL - {"SETALL", SETALL}, -#endif -#ifdef SHM_CLEAR - {"SHM_CLEAR", SHM_CLEAR}, -#endif -#ifdef SHM_COPY - {"SHM_COPY", SHM_COPY}, -#endif -#ifdef SHM_DCACHE - {"SHM_DCACHE", SHM_DCACHE}, -#endif -#ifdef SHM_DEST - {"SHM_DEST", SHM_DEST}, -#endif -#ifdef SHM_ECACHE - {"SHM_ECACHE", SHM_ECACHE}, -#endif -#ifdef SHM_FMAP - {"SHM_FMAP", SHM_FMAP}, -#endif -#ifdef SHM_ICACHE - {"SHM_ICACHE", SHM_ICACHE}, -#endif -#ifdef SHM_INIT - {"SHM_INIT", SHM_INIT}, -#endif -#ifdef SHM_LOCK - {"SHM_LOCK", SHM_LOCK}, -#endif -#ifdef SHM_LOCKED - {"SHM_LOCKED", SHM_LOCKED}, -#endif -#ifdef SHM_MAP - {"SHM_MAP", SHM_MAP}, -#endif -#ifdef SHM_NOSWAP - {"SHM_NOSWAP", SHM_NOSWAP}, -#endif -#ifdef SHM_RDONLY - {"SHM_RDONLY", SHM_RDONLY}, -#endif -#ifdef SHM_REMOVED - {"SHM_REMOVED", SHM_REMOVED}, -#endif -#ifdef SHM_RND - {"SHM_RND", SHM_RND}, -#endif -#ifdef SHM_SHARE_MMU - {"SHM_SHARE_MMU", SHM_SHARE_MMU}, -#endif -#ifdef SHM_SHATTR - {"SHM_SHATTR", SHM_SHATTR}, -#endif -#ifdef SHM_SIZE - {"SHM_SIZE", SHM_SIZE}, -#endif -#ifdef SHM_UNLOCK - {"SHM_UNLOCK", SHM_UNLOCK}, -#endif -#ifdef SHM_W - {"SHM_W", SHM_W}, -#endif -#ifdef S_IRUSR - {"S_IRUSR", S_IRUSR}, -#endif -#ifdef S_IWUSR - {"S_IWUSR", S_IWUSR}, -#endif -#ifdef S_IRWXU - {"S_IRWXU", S_IRWXU}, -#endif -#ifdef S_IRGRP - {"S_IRGRP", S_IRGRP}, -#endif -#ifdef S_IWGRP - {"S_IWGRP", S_IWGRP}, -#endif -#ifdef S_IRWXG - {"S_IRWXG", S_IRWXG}, -#endif -#ifdef S_IROTH - {"S_IROTH", S_IROTH}, -#endif -#ifdef S_IWOTH - {"S_IWOTH", S_IWOTH}, -#endif -#ifdef S_IRWXO - {"S_IRWXO", S_IRWXO}, -#endif - {Nullch,0}}; - char *name; - int i; - - for(i = 0 ; (name = IPC__SysV__const[i].n) ; i++) { - newCONSTSUB(stash,name, newSViv(IPC__SysV__const[i].v)); - } -} - diff --git a/contrib/perl5/ext/IPC/SysV/hints/cygwin.pl b/contrib/perl5/ext/IPC/SysV/hints/cygwin.pl deleted file mode 100644 index e1a1dea..0000000 --- a/contrib/perl5/ext/IPC/SysV/hints/cygwin.pl +++ /dev/null @@ -1,2 +0,0 @@ -# SysV IPC is an optional Cygwin package -$self->{LIBS} = ['-lcygipc'] diff --git a/contrib/perl5/ext/IPC/SysV/hints/next_3.pl b/contrib/perl5/ext/IPC/SysV/hints/next_3.pl deleted file mode 100644 index 2290ac7..0000000 --- a/contrib/perl5/ext/IPC/SysV/hints/next_3.pl +++ /dev/null @@ -1 +0,0 @@ -$self->{CCFLAGS} = $Config{ccflags} . ' -D_POSIX_SOURCE' ; diff --git a/contrib/perl5/ext/IPC/SysV/t/msg.t b/contrib/perl5/ext/IPC/SysV/t/msg.t deleted file mode 100755 index 2a982f0..0000000 --- a/contrib/perl5/ext/IPC/SysV/t/msg.t +++ /dev/null @@ -1,41 +0,0 @@ -use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO); - -use IPC::Msg; -#Creating a message queue - -print "1..9\n"; - -$msq = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO) - || die "msgget: ",$!+0," $!\n"; - -print "ok 1\n"; - -#Putting a message on the queue -$msgtype = 1; -$msg = "hello"; -$msq->snd($msgtype,$msg,0) || print "not "; -print "ok 2\n"; - -#Check if there are messages on the queue -$ds = $msq->stat() or print "not "; -print "ok 3\n"; - -print "not " unless $ds && $ds->qnum() == 1; -print "ok 4\n"; - -#Retreiving a message from the queue -$rmsgtype = 0; # Give me any type -$rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT) || print "not "; -print "ok 5\n"; - -print "not " unless $rmsgtype == $msgtype && $rmsg eq $msg; -print "ok 6\n"; - -$ds = $msq->stat() or print "not "; -print "ok 7\n"; - -print "not " unless $ds && $ds->qnum() == 0; -print "ok 8\n"; - -$msq->remove || print "not "; -print "ok 9\n"; diff --git a/contrib/perl5/ext/IPC/SysV/t/sem.t b/contrib/perl5/ext/IPC/SysV/t/sem.t deleted file mode 100755 index 9d6fff6..0000000 --- a/contrib/perl5/ext/IPC/SysV/t/sem.t +++ /dev/null @@ -1,51 +0,0 @@ - -use IPC::SysV qw( - SETALL - IPC_PRIVATE - IPC_CREAT - IPC_RMID - IPC_NOWAIT - IPC_STAT - S_IRWXU - S_IRWXG - S_IRWXO -); -use IPC::Semaphore; - -print "1..10\n"; - -$sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT) - || die "semget: ",$!+0," $!\n"; - -print "ok 1\n"; - -my $st = $sem->stat || print "not "; -print "ok 2\n"; - -$sem->setall( (0) x 10) || print "not "; -print "ok 3\n"; - -my @sem = $sem->getall; -print "not " unless join("",@sem) eq "0000000000"; -print "ok 4\n"; - -$sem[2] = 1; -$sem->setall( @sem ) || print "not "; -print "ok 5\n"; - -@sem = $sem->getall; -print "not " unless join("",@sem) eq "0010000000"; -print "ok 6\n"; - -my $ncnt = $sem->getncnt(0); -print "not " if $sem->getncnt(0) || !defined($ncnt); -print "ok 7\n"; - -$sem->op(2,-1,IPC_NOWAIT) || print "not "; -print "ok 8\n"; - -print "not " if $sem->getncnt(0); -print "ok 9\n"; - -$sem->remove || print "not "; -print "ok 10\n"; |
