From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 7 Jul 1998 02:32:53 +0000 (+0300)
Subject: add extension to support SysV IPC
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0ade19845bc827615a636e5c073d498c2244ec07;p=p5sagit%2Fp5-mst-13.2.git

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
---

diff --git a/Configure b/Configure
index e58fdc8..aef0cd8 100755
--- a/Configure
+++ b/Configure
@@ -10955,6 +10955,11 @@ for xxx in $known_extensions ; do
 		true|$define|y) avail_ext="$avail_ext $xxx" ;;
 		esac
 		;;
+        IPC/SysV|ipc_sysv)
+                case "$d_sem" in 
+                true|$define|y) avail_ext="$avail_ext $xxx" ;;
+                esac
+                ;;
 	*)	avail_ext="$avail_ext $xxx"
 		;;
 	esac
diff --git a/MANIFEST b/MANIFEST
index 8211870..cdaed37 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -212,6 +212,16 @@ ext/IO/lib/IO/Pipe.pm		IO::Pipe extension Perl module
 ext/IO/lib/IO/Seekable.pm	IO::Seekable extension Perl module
 ext/IO/lib/IO/Select.pm		IO::Select extension Perl module
 ext/IO/lib/IO/Socket.pm		IO::Socket extension Perl module
+ext/IPC/SysV/ChangeLog		IPC::SysV extension Perl module
+ext/IPC/SysV/MANIFEST		IPC::SysV extension Perl module
+ext/IPC/SysV/Makefile.PL	IPC::SysV extension Perl module
+ext/IPC/SysV/README		IPC::SysV extension Perl module
+ext/IPC/SysV/SysV.pm		IPC::SysV extension Perl module
+ext/IPC/SysV/SysV.xs		IPC::SysV extension Perl module
+ext/IPC/SysV/Msg.pm		IPC::SysV extension Perl module
+ext/IPC/SysV/Semaphore.pm	IPC::SysV extension Perl module
+ext/IPC/SysV/t/msg.t		IPC::SysV extension Perl module
+ext/IPC/SysV/t/sem.t		IPC::SysV extension Perl module
 ext/NDBM_File/Makefile.PL	NDBM extension makefile writer
 ext/NDBM_File/NDBM_File.pm	NDBM extension Perl module
 ext/NDBM_File/NDBM_File.xs	NDBM extension external subroutines
diff --git a/ext/IPC/SysV/ChangeLog b/ext/IPC/SysV/ChangeLog
new file mode 100644
index 0000000..fff95be
--- /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 0000000..4b2aa00
--- /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 0000000..6f89db4
--- /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 0000000..93d2ae1
--- /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 0000000..d412c4c
--- /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 0000000..464eb0b
--- /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 0000000..eb24593
--- /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 0000000..8b30b92
--- /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 0000000..2a982f0
--- /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 0000000..9d6fff6
--- /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";
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 4e78f69..f87471b 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1254,7 +1254,7 @@ Implements the fcntl(2) function.  You'll probably have to say
 
     use Fcntl;
 
-first to get the correct function definitions.  Argument processing and
+first to get the correct constant definitions.  Argument processing and
 value return works just like ioctl() below.  
 For example:
 
@@ -2046,31 +2046,38 @@ it returns FALSE and sets C<$!> (errno).
 
 =item msgctl ID,CMD,ARG
 
-Calls the System V IPC function msgctl(2).  If CMD is &IPC_STAT, then ARG
-must be a variable that will hold the returned msqid_ds structure.
-Returns like ioctl: the undefined value for error, "0 but true" for
-zero, or the actual return value otherwise.
+Calls the System V IPC function msgctl(2).  You'll probably have to say
+
+    use IPC::SysV;
+
+first to get the correct constant definitions.  If CMD is IPC_STAT,
+then ARG must be a variable which will hold the returned msqid_ds
+structure.  Returns like ioctl: the undefined value for error, "0 but
+true" for zero, or the actual return value otherwise.  See also
+IPC::SysV and IPC::Semaphore::Msg documentation.
 
 =item msgget KEY,FLAGS
 
-Calls the System V IPC function msgget(2).  Returns the message queue id,
-or the undefined value if there is an error.
+Calls the System V IPC function msgget(2).  Returns the message queue
+id, or the undefined value if there is an error.  See also IPC::SysV
+and IPC::SysV::Msg documentation.
 
 =item msgsnd ID,MSG,FLAGS
 
 Calls the System V IPC function msgsnd to send the message MSG to the
 message queue ID.  MSG must begin with the long integer message type,
 which may be created with C<pack("l", $type)>.  Returns TRUE if
-successful, or FALSE if there is an error.
+successful, or FALSE if there is an error.  See also IPC::SysV
+and IPC::SysV::Msg documentation.
 
 =item msgrcv ID,VAR,SIZE,TYPE,FLAGS
 
 Calls the System V IPC function msgrcv to receive a message from
 message queue ID into variable VAR with a maximum message size of
-SIZE.  Note that if a message is received, the message type will be the
-first thing in VAR, and the maximum length of VAR is SIZE plus the size
-of the message type.  Returns TRUE if successful, or FALSE if there is
-an error.
+SIZE.  Note that if a message is received, the message type will be
+the first thing in VAR, and the maximum length of VAR is SIZE plus the
+size of the message type.  Returns TRUE if successful, or FALSE if
+there is an error.  See also IPC::SysV and IPC::SysV::Msg documentation.
 
 =item my EXPR
 
@@ -3037,16 +3044,21 @@ then only on POSIX systems.  You have to use sysread() instead.
 
 =item semctl ID,SEMNUM,CMD,ARG
 
-Calls the System V IPC function semctl.  If CMD is &IPC_STAT or
-&GETALL, then ARG must be a variable that will hold the returned
+Calls the System V IPC function semctl.  You'll probably have to say
+
+    use IPC::SysV;
+
+first to get the correct constant definitions.  If CMD is IPC_STAT or
+GETALL, then ARG must be a variable which will hold the returned
 semid_ds structure or semaphore value array.  Returns like ioctl: the
 undefined value for error, "0 but true" for zero, or the actual return
-value otherwise.
+value otherwise.  See also IPC::SysV and IPC::Semaphore documentation.
 
 =item semget KEY,NSEMS,FLAGS
 
 Calls the System V IPC function semget.  Returns the semaphore id, or
-the undefined value if there is an error.
+the undefined value if there is an error.  See also IPC::SysV and
+IPC::SysV::Semaphore documentation.
 
 =item semop KEY,OPSTRING
 
@@ -3061,7 +3073,8 @@ following code waits on semaphore $semnum of semaphore id $semid:
     $semop = pack("sss", $semnum, -1, 0);
     die "Semaphore trouble: $!\n" unless semop($semid, $semop);
 
-To signal the semaphore, replace "-1" with "1".
+To signal the semaphore, replace "-1" with "1".  See also IPC::SysV
+and IPC::SysV::Semaphore documentation.
 
 =item send SOCKET,MSG,FLAGS,TO
 
@@ -3110,15 +3123,21 @@ right end.
 
 =item shmctl ID,CMD,ARG
 
-Calls the System V IPC function shmctl.  If CMD is &IPC_STAT, then ARG
-must be a variable that will hold the returned shmid_ds structure.
-Returns like ioctl: the undefined value for error, "0 but true" for
-zero, or the actual return value otherwise.
+Calls the System V IPC function shmctl.  You'll probably have to say
+
+    use IPC::SysV;
+
+first to get the correct constant definitions.  If CMD is IPC_STAT,
+then ARG must be a variable which will hold the returned shmid_ds
+structure.  Returns like ioctl: the undefined value for error, "0 but
+true" for zero, or the actual return value otherwise.
+See also IPC::SysV documentation.
 
 =item shmget KEY,SIZE,FLAGS
 
 Calls the System V IPC function shmget.  Returns the shared memory
 segment id, or the undefined value if there is an error.
+See also IPC::SysV documentation.
 
 =item shmread ID,VAR,POS,SIZE
 
@@ -3130,6 +3149,7 @@ detaching from it.  When reading, VAR must be a variable that will
 hold the data read.  When writing, if STRING is too long, only SIZE
 bytes are used; if STRING is too short, nulls are written to fill out
 SIZE bytes.  Return TRUE if successful, or FALSE if there is an error.
+See also IPC::SysV documentation.
 
 =item shutdown SOCKET,HOW
 
diff --git a/pod/perlipc.pod b/pod/perlipc.pod
index 2348d39..59c5ad9 100644
--- a/pod/perlipc.pod
+++ b/pod/perlipc.pod
@@ -1306,29 +1306,33 @@ you weren't wanting it to.
 
 Here's a small example showing shared memory usage.
 
-    $IPC_PRIVATE = 0;
-    $IPC_RMID = 0;
+    use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO);
+
     $size = 2000;
-    $key = shmget($IPC_PRIVATE, $size , 0777 );
-    die unless defined $key;
+    $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!";
+    print "shm key $key\n";
 
     $message = "Message #1";
-    shmwrite($key, $message, 0, 60 ) || die "$!";
-    shmread($key,$buff,0,60) || die "$!";
+    shmwrite($key, $message, 0, 60) || die "$!";
+    print "wrote: '$message'\n";
+    shmread($key, $buff, 0, 60) || die "$!";
+    print "read : '$buff'\n";
 
-    print $buff,"\n";
+    # the buffer of shmread is zero-character end-padded.
+    substr($buff, index($buff, "\0")) = '';
+    print "un" unless $buff eq $message;
+    print "swell\n";
 
-    print "deleting $key\n";
-    shmctl($key ,$IPC_RMID, 0) || die "$!";
+    print "deleting shm $key\n";
+    shmctl($key, IPC_RMID, 0) || die "$!";
 
 Here's an example of a semaphore:
 
+    use IPC::SysV qw(IPC_CREAT);
+
     $IPC_KEY = 1234;
-    $IPC_RMID = 0;
-    $IPC_CREATE = 0001000;
-    $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
-    die if !defined($key);
-    print "$key\n";
+    $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
+    print "shm key $key\n";
 
 Put this code in a separate file to be run in more than one process.
 Call the file F<take>:
@@ -1375,9 +1379,8 @@ Call this file F<give>:
     semop($key,$opstring) || die "$!";
 
 The SysV IPC code above was written long ago, and it's definitely
-clunky looking.  It should at the very least be made to C<use strict>
-and C<require "sys/ipc.ph">.  Better yet, check out the IPC::SysV modules
-on CPAN.
+clunky looking.  For a more modern look, see the IPC::SysV module
+which is included with Perl starting from Perl 5.005.
 
 =head1 NOTES
 
diff --git a/t/op/ipcmsg.t b/t/op/ipcmsg.t
index 72e345c..8c3931a 100755
--- a/t/op/ipcmsg.t
+++ b/t/op/ipcmsg.t
@@ -5,22 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-my @define;
-
-BEGIN {
-    @define = qw(
-	IPC_PRIVATE
-	IPC_RMID
-	IPC_NOWAIT
-	IPC_STAT
-	S_IRWXU
-	S_IRWXG
-	S_IRWXO
-    );
-}
-
 use Config;
-use vars map { '$' . $_ } @define;
 
 BEGIN {
     unless($Config{'d_msgget'} eq 'define' &&
@@ -30,87 +15,16 @@ BEGIN {
 	print "1..0\n";
 	exit;
     }
-
-    use strict;
-
-    my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
-    my %done = ();
-    my %define = ();
-
-    sub process_file {
-	my($file,$level) = @_;
-
-	return unless defined $file;
-
-	my $path = undef;
-	my $dir;
-	foreach $dir (@incpath) {
-	    my $tmp = $dir . "/" . $file;
-	    next unless -r $tmp;
-	    $path = $tmp;
-	    last;
-	}
-
-	return if exists $done{$path};
-	$done{$path} = 1;
-
-	if(not defined $path and $level == 0) {
-	    warn "Cannot find '$file'";
-	    return;
-	}
-
-	local(*F);
-	open(F,$path) or return;
-        $level = 1 unless defined $level;
-	my $indent = " " x $level;
-	print "#$indent open $path\n";
-	while(<F>) {
-	    s#/\*.*(\*/|$)##;
-
-	    if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
-	        print "#${indent} include $1\n";
-		process_file($1,$level+1);
-	        print "#${indent} done include $1\n";
-	        print "#${indent} back in $path\n";
-	    }
-
-	    s/(?:\([^)]*\)\s*)//;
-
-	    if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
-	        print "#${indent} define $1 $2\n";
-		$define{$1} = $2;
-	    }
-       }
-       close(F);
-       print "#$indent close $path\n";
-    }
-
-    process_file("sys/sem.h");
-    process_file("sys/ipc.h");
-    process_file("sys/stat.h");
-
-    foreach my $d (@define) {
-	while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
-	    $define{$d} = exists $define{$define{$d}}
-		    ? $define{$define{$d}} : undef;
-	}
-	unless(defined $define{$d}) {
-	    print "# $d undefined\n";
-	    print "1..0\n";
-	    exit;
-	}
-	{
-	    no strict 'refs';
-	    ${ $d } = eval $define{$d};
-        }
-    }
 }
 
 use strict;
 
+use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID
+		 S_IRWXU S_IRWXG S_IRWXO);
+
 print "1..6\n";
 
-my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO);
+my $msg = msgget(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO);
 # Very first time called after machine is booted value may be 0 
 die "msgget failed: $!\n" unless defined($msg) && $msg >= 0;
 
@@ -124,14 +38,14 @@ msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
 print "ok 2\n";
 
 my $data;
-msgctl($msg,$IPC_STAT,$data) or print "not ";
+msgctl($msg,IPC_STAT,$data) or print "not ";
 print "ok 3\n";
 
 print "not " unless length($data);
 print "ok 4\n";
 
 my $msgbuf;
-msgrcv($msg,$msgbuf,256,0,$IPC_NOWAIT) or print "not ";
+msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT) or print "not ";
 print "ok 5\n";
 
 my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
@@ -139,5 +53,5 @@ my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
 print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
 print "ok 6\n";
 
-msgctl($msg,$IPC_RMID,0);
+msgctl($msg,IPC_RMID,0);
 
diff --git a/t/op/ipcsem.t b/t/op/ipcsem.t
index a524674..901ceea 100755
--- a/t/op/ipcsem.t
+++ b/t/op/ipcsem.t
@@ -6,24 +6,7 @@ BEGIN {
     $SIG{__DIE__} = 'cleanup';
 }
 
-my @define;
-
-BEGIN {
-    @define = qw(
-	GETALL
-	SETALL
-	IPC_PRIVATE
-	IPC_CREAT
-	IPC_RMID
-	IPC_STAT
-	S_IRWXU
-	S_IRWXG
-	S_IRWXO
-    );
-}
-
 use Config;
-use vars map { '$' . $_ } @define;
 
 BEGIN {
     unless($Config{'d_semget'} eq 'define' &&
@@ -31,94 +14,24 @@ BEGIN {
 	print "1..0\n";
 	exit;
     }
-
-    use strict;
-
-    my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
-    my %done = ();
-    my %define = ();
-
-    sub process_file {
-	my($file,$level) = @_;
-
-	return unless defined $file;
-
-	my $path = undef;
-	my $dir;
-	foreach $dir (@incpath) {
-	    my $tmp = $dir . "/" . $file;
-	    next unless -r $tmp;
-	    $path = $tmp;
-	    last;
-	}
-
-	return if exists $done{$path};
-	$done{$path} = 1;
-
-	if(not defined $path and $level == 0) {
-	    warn "Cannot find '$file'";
-	    return;
-	}
-
-	local(*F);
-	open(F,$path) or return;
-        $level = 1 unless defined $level;
-	my $indent = " " x $level;
-	print "#$indent open $path\n";
-	while(<F>) {
-	    s#/\*.*(\*/|$)##;
-
-	    if ( /^#\s*include\s*[<"]([^>"]+)[>"]/ ) {
-	        print "#${indent} include $1\n";
-		process_file($1,$level+1);
-	        print "#${indent} done include $1\n";
-	        print "#${indent} back in $path\n";
-	    }
-
-	    s/(?:\([^)]*\)\s*)//;
-
-	    if ( /^#\s*define\s+(\w+)\s+(\w+)/ ) {
-	        print "#${indent} define $1 $2\n";
-		$define{$1} = $2;
-	    }
-       }
-       close(F);
-       print "#$indent close $path\n";
-    }
-
-    process_file("sys/sem.h");
-    process_file("sys/ipc.h");
-    process_file("sys/stat.h");
-
-    foreach my $d (@define) {
-	while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
-	    $define{$d} = exists $define{$define{$d}}
-		    ? $define{$define{$d}} : undef;
-	}
-	unless(defined $define{$d}) {
-	    print "# $d undefined\n";
-	    print "1..0\n";
-	    exit;
-	}
-	{
-	    no strict 'refs';
-	    ${ $d } = eval $define{$d};
-        }
-    }
 }
 
 use strict;
 
+use IPC::SysV qw(IPC_PRIVATE IPC_CREAT IPC_STAT IPC_RMID
+		 GETALL SETALL
+		 S_IRWXU S_IRWXG S_IRWXO);
+
 print "1..10\n";
 
-my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT);
+my $sem = semget(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT);
 # Very first time called after machine is booted value may be 0 
 die "semget: $!\n" unless defined($sem) && $sem >= 0;
 
 print "ok 1\n";
 
 my $data;
-semctl($sem,0,$IPC_STAT,$data) or print "not ";
+semctl($sem,0,IPC_STAT,$data) or print "not ";
 print "ok 2\n";
 
 print "not " unless length($data);
@@ -149,11 +62,11 @@ $template .= "*";
 
 my $nsem = 10;
 
-semctl($sem,0,$SETALL,pack($template,(0) x $nsem)) or print "not ";
+semctl($sem,0,SETALL,pack($template,(0) x $nsem)) or print "not ";
 print "ok 4\n";
 
 $data = "";
-semctl($sem,0,$GETALL,$data) or print "not ";
+semctl($sem,0,GETALL,$data) or print "not ";
 print "ok 5\n";
 
 print "not " unless length($data) == length(pack($template,(0) x $nsem));
@@ -169,11 +82,11 @@ print "ok 7\n";
 my $poke = 2;
 
 $data[$poke] = 1;
-semctl($sem,0,$SETALL,pack($template,@data)) or print "not ";
+semctl($sem,0,SETALL,pack($template,@data)) or print "not ";
 print "ok 8\n";
 
 $data = "";
-semctl($sem,0,$GETALL,$data) or print "not ";
+semctl($sem,0,GETALL,$data) or print "not ";
 print "ok 9\n";
 
 @data = unpack($template,$data);
@@ -183,6 +96,6 @@ my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
 print "not " unless join("",@data) eq $bdata;
 print "ok 10\n";
 
-sub cleanup { semctl($sem,0,$IPC_RMID,undef) if defined $sem }
+sub cleanup { semctl($sem,0,IPC_RMID,undef) if defined $sem }
 
 cleanup;