<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">################################################################################
#
#  Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz &lt;mhx@cpan.org&gt;.
#  Version 1.x, Copyright (C) 1997, Graham Barr &lt;gbarr@pobox.com&gt;.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

package IPC::SharedMem;

use IPC::SysV qw(IPC_STAT IPC_RMID shmat shmdt memread memwrite);
use strict;
use vars qw($VERSION);
use Carp;

$VERSION = '2.09';

# Figure out if we have support for native sized types
my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' };

{
    package IPC::SharedMem::stat;

    use Class::Struct qw(struct);

    struct 'IPC::SharedMem::stat' =&gt; [
	uid	=&gt; '$',
	gid	=&gt; '$',
	cuid	=&gt; '$',
	cgid	=&gt; '$',
	mode	=&gt; '$',
	segsz	=&gt; '$',
	lpid	=&gt; '$',
	cpid	=&gt; '$',
	nattch	=&gt; '$',
	atime	=&gt; '$',
	dtime	=&gt; '$',
	ctime	=&gt; '$',
    ];
}

sub new
{
  @_ == 4 or croak 'IPC::SharedMem-&gt;new(KEY, SIZE, FLAGS)';
  my($class, $key, $size, $flags) = @_;

  my $id = shmget $key, $size, $flags;

  return undef unless defined $id;

  bless { _id =&gt; $id, _addr =&gt; undef, _isrm =&gt; 0 }, $class
}

sub id
{
  my $self = shift;
  $self-&gt;{_id};
}

sub addr
{
  my $self = shift;
  $self-&gt;{_addr};
}

sub stat
{
  my $self = shift;
  my $data = '';
  shmctl $self-&gt;id, IPC_STAT, $data or return undef;
  IPC::SharedMem::stat-&gt;new-&gt;unpack($data);
}

sub attach
{
  @_ &gt;= 1 &amp;&amp; @_ &lt;= 2 or croak '$shm-&gt;attach([FLAG])';
  my($self, $flag) = @_;
  defined $self-&gt;addr and return undef;
  $self-&gt;{_addr} = shmat($self-&gt;id, undef, $flag || 0);
  defined $self-&gt;addr;
}

sub detach
{
  my $self = shift;
  defined $self-&gt;addr or return undef;
  my $rv = defined shmdt($self-&gt;addr);
  undef $self-&gt;{_addr} if $rv;
  $rv;
}

sub remove
{
  my $self = shift;
  return undef if $self-&gt;is_removed;
  my $rv = shmctl $self-&gt;id, IPC_RMID, 0;
  $self-&gt;{_isrm} = 1 if $rv;
  return $rv;
}

sub is_removed
{
  my $self = shift;
  $self-&gt;{_isrm};
}

sub read
{
  @_ == 3 or croak '$shm-&gt;read(POS, SIZE)';
  my($self, $pos, $size) = @_;
  my $buf = '';
  if (defined $self-&gt;addr) {
    memread($self-&gt;addr, $buf, $pos, $size) or return undef;
  }
  else {
    shmread($self-&gt;id, $buf, $pos, $size) or return undef;
  }
  $buf;
}

sub write
{
  @_ == 4 or croak '$shm-&gt;write(STRING, POS, SIZE)';
  my($self, $str, $pos, $size) = @_;
  if (defined $self-&gt;addr) {
    return memwrite($self-&gt;addr, $str, $pos, $size);
  }
  else {
    return shmwrite($self-&gt;id, $str, $pos, $size);
  }
}

1;

__END__

=head1 NAME

IPC::SharedMem - SysV Shared Memory IPC object class

=head1 SYNOPSIS

    use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR);
    use IPC::SharedMem;

    $shm = IPC::SharedMem-&gt;new(IPC_PRIVATE, 8, S_IRWXU);

    $shm-&gt;write(pack("S", 4711), 2, 2);

    $data = $shm-&gt;read(0, 2);

    $ds = $shm-&gt;stat;

    $shm-&gt;remove;

=head1 DESCRIPTION

A class providing an object based interface to SysV IPC shared memory.

=head1 METHODS

=over 4

=item new ( KEY , SIZE , FLAGS )

Creates a new shared memory segment of C&lt;SIZE&gt; bytes size associated
with C&lt;KEY&gt;. A new segment is created if

=over 4

=item *

C&lt;KEY&gt; is equal to C&lt;IPC_PRIVATE&gt;

=item *

C&lt;KEY&gt; does not already have a shared memory segment associated
with it, and C&lt;I&lt;FLAGS&gt; &amp; IPC_CREAT&gt; is true.

=back

On creation of a new shared memory segment C&lt;FLAGS&gt; is used to
set the permissions.  Be careful not to set any flags that the
Sys V IPC implementation does not allow: in some systems setting
execute bits makes the operations fail.

=item id

Returns the shared memory identifier.

=item read ( POS, SIZE )

Read C&lt;SIZE&gt; bytes from the shared memory segment at C&lt;POS&gt;. Returns
the string read, or C&lt;undef&gt; if there was an error. The return value
becomes tainted. See L&lt;shmread&gt;.

=item write ( STRING, POS, SIZE )

Write C&lt;SIZE&gt; bytes to the shared memory segment at C&lt;POS&gt;. Returns
true if successful, or false if there is an error. See L&lt;shmwrite&gt;.

=item remove

Remove the shared memory segment from the system or mark it as
removed as long as any processes are still attached to it.

=item is_removed

Returns true if the shared memory segment has been removed or
marked for removal.

=item stat

Returns an object of type C&lt;IPC::SharedMem::stat&gt; which is a sub-class
of C&lt;Class::Struct&gt;. It provides the following fields. For a description
of these fields see you system documentation.

    uid
    gid
    cuid
    cgid
    mode
    segsz
    lpid
    cpid
    nattch
    atime
    dtime
    ctime

=item attach ( [FLAG] )

Permanently attach to the shared memory segment. When a C&lt;IPC::SharedMem&gt;
object is attached, it will use L&lt;memread&gt; and L&lt;memwrite&gt; instead of
L&lt;shmread&gt; and L&lt;shmwrite&gt; for accessing the shared memory segment.
Returns true if successful, or false on error. See L&lt;shmat(2)&gt;.

=item detach

Detach from the shared memory segment that previously has been attached
to. Returns true if successful, or false on error. See L&lt;shmdt(2)&gt;.

=item addr

Returns the address of the shared memory that has been attached to in a
format suitable for use with C&lt;pack('P')&gt;. Returns C&lt;undef&gt; if the shared
memory has not been attached.

=back

=head1 SEE ALSO

L&lt;IPC::SysV&gt;, L&lt;Class::Struct&gt;

=head1 AUTHORS

Marcus Holland-Moritz &lt;mhx@cpan.org&gt;

=head1 COPYRIGHT

Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.

Version 1.x, Copyright (c) 1997, Graham Barr.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

</pre></body></html>