add extension to support SysV IPC

	Message-Id: <199807062332.CAA25792@alpha.hut.fi>
	Subject: [PATCH] 5.004_70: IPC::SysV

p4raw-id: //depot/perl@1372

10 files changed, 1236 insertions, 0 deletions

diff --git a/ext/IPC/SysV/ChangeLog b/ext/IPC/SysV/ChangeLog
new file mode 100644
index 0000000000..fff95bec43
--- /dev/null
+++ b/ext/IPC/SysV/ChangeLog
@@ -0,0 +1,28 @@
+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/ext/IPC/SysV/MANIFEST b/ext/IPC/SysV/MANIFEST
new file mode 100644
index 0000000000..4b2aa00daf
--- /dev/null
+++ b/ext/IPC/SysV/MANIFEST
@@ -0,0 +1,10 @@
+MANIFEST
+Makefile.PL
+Msg.pm
+README
+Semaphore.pm
+SysV.pm
+SysV.xs
+t/msg.t
+t/sem.t
+ChangeLog
diff --git a/ext/IPC/SysV/Makefile.PL b/ext/IPC/SysV/Makefile.PL
new file mode 100644
index 0000000000..6f89db4535
--- /dev/null
+++ b/ext/IPC/SysV/Makefile.PL
@@ -0,0 +1,37 @@
+# This -*- perl -*- script makes the Makefile
+# $Id: Makefile.PL,v 1.3 1997/03/04 09:21:12 gbarr Exp $
+
+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",
+ 
+	'linkext' 	=> {LINKTYPE => 'dynamic' },
+	'dist'    	=> {COMPRESS => 'gzip -9f',
+			    SUFFIX   => 'gz', 
+			    DIST_DEFAULT => 'all tardist',
+			   },
+ 
+	'clean'   	=> {FILES => join(" ",
+					map { "$_ */$_ */*/$_" }
+					qw(*% *.html *.b[ac]k *.old *.orig))
+			   },
+	'macro'		=> { INSTALLDIRS => 'perl' },
+);
diff --git a/ext/IPC/SysV/Msg.pm b/ext/IPC/SysV/Msg.pm
new file mode 100644
index 0000000000..93d2ae16ee
--- /dev/null
+++ b/ext/IPC/SysV/Msg.pm
@@ -0,0 +1,223 @@
+# 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 || 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 || 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 S_IRWXG S_IRWXO);
+    use IPC::Msg;
+    
+    $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO);
+    
+    $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>
+
+=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/ext/IPC/SysV/README b/ext/IPC/SysV/README
new file mode 100644
index 0000000000..d412c4c712
--- /dev/null
+++ b/ext/IPC/SysV/README
@@ -0,0 +1,20 @@
+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/ext/IPC/SysV/Semaphore.pm b/ext/IPC/SysV/Semaphore.pm
new file mode 100644
index 0000000000..464eb0bc19
--- /dev/null
+++ b/ext/IPC/SysV/Semaphore.pm
@@ -0,0 +1,297 @@
+# 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/ext/IPC/SysV/SysV.pm b/ext/IPC/SysV/SysV.pm
new file mode 100644
index 0000000000..eb245937aa
--- /dev/null
+++ b/ext/IPC/SysV/SysV.pm
@@ -0,0 +1,98 @@
+# 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.
+
+=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>
+
+=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/ext/IPC/SysV/SysV.xs b/ext/IPC/SysV/SysV.xs
new file mode 100644
index 0000000000..8b30b929a2
--- /dev/null
+++ b/ext/IPC/SysV/SysV.xs
@@ -0,0 +1,431 @@
+#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)
+#include <sys/ipc.h>
+#ifdef HAS_MSG
+#include <sys/msg.h>
+#endif
+#ifdef HAS_SEM
+#include <sys/sem.h>
+#endif
+#ifdef HAS_SHM
+#include <sys/shm.h>
+# ifndef HAS_SHMAT_PROTOTYPE
+    extern Shmat_t shmat _((int, char *, int));
+# endif
+#endif
+#endif
+
+#ifndef newCONSTSUB
+static void
+newCONSTSUB(stash,name,sv)
+    HV *stash;
+    char *name;
+    SV *sv;
+{
+#ifdef dTHR
+    dTHR;
+#endif
+    U32 oldhints = hints;
+    HV *old_cop_stash = curcop->cop_stash;
+    HV *old_curstash = curstash;
+    line_t oldline = curcop->cop_line;
+    curcop->cop_line = copline;
+
+    hints &= ~HINT_BLOCK_SCOPE;
+    if(stash)
+	curstash = curcop->cop_stash = stash;
+
+    newSUB(
+	start_subparse(FALSE, 0),
+	newSVOP(OP_CONST, 0, newSVpv(name,0)),
+	newSVOP(OP_CONST, 0, &sv_no),	/* SvPV(&sv_no) == "" -- GMB */
+	newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+    );
+
+    hints = oldhints;
+    curcop->cop_stash = old_cop_stash;
+    curstash = old_curstash;
+    curcop->cop_line = oldline;
+}
+#endif
+
+MODULE=IPC::SysV	PACKAGE=IPC::Msg::stat
+
+PROTOTYPES: ENABLE
+
+void
+pack(obj)
+    SV	* obj
+PPCODE:
+{
+    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(newSVpv((char *)&ds,sizeof(ds)));
+    XSRETURN(1);
+}
+
+void
+unpack(obj,buf)
+    SV * obj
+    SV * buf
+PPCODE:
+{
+    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);
+}
+
+MODULE=IPC::SysV	PACKAGE=IPC::Semaphore::stat
+
+void
+unpack(obj,ds)
+    SV * obj
+    SV * ds
+PPCODE:
+{
+    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);
+}
+
+void
+pack(obj)
+    SV	* obj
+PPCODE:
+{
+    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(newSVpv((char *)&ds,sizeof(ds)));
+    XSRETURN(1);
+}
+
+MODULE=IPC::SysV	PACKAGE=IPC::SysV
+
+int
+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 ? &sv_undef : sv_2mortal(newSViv(k));
+#else
+        DIE(no_func, "ftok");
+#endif
+
+int
+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/ext/IPC/SysV/t/msg.t b/ext/IPC/SysV/t/msg.t
new file mode 100755
index 0000000000..2a982f054a
--- /dev/null
+++ b/ext/IPC/SysV/t/msg.t
@@ -0,0 +1,41 @@
+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/ext/IPC/SysV/t/sem.t b/ext/IPC/SysV/t/sem.t
new file mode 100755
index 0000000000..9d6fff64f2
--- /dev/null
+++ b/ext/IPC/SysV/t/sem.t
@@ -0,0 +1,51 @@
+
+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";