<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::Msg;

use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID);
use strict;
use vars qw($VERSION);
use Carp;

$VERSION = '2.07';

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

{
    package IPC::Msg::stat;

    use Class::Struct qw(struct);

    struct 'IPC::Msg::stat' =&gt; [
	uid	=&gt; '$',
	gid	=&gt; '$',
	cuid	=&gt; '$',
	cgid	=&gt; '$',
	mode	=&gt; '$',
	qnum	=&gt; '$',
	qbytes	=&gt; '$',
	lspid	=&gt; '$',
	lrpid	=&gt; '$',
	stime	=&gt; '$',
	rtime	=&gt; '$',
	ctime	=&gt; '$',
    ];
}

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-&gt;new-&gt;unpack($data);
}

sub set {
    my $self = shift;
    my $ds;

    if(@_ == 1) {
	$ds = shift;
    }
    else {
	croak 'Bad arg count' if @_ % 2;
	my %arg = @_;
	$ds = $self-&gt;stat
		or return undef;
	my($key,$val);
	$ds-&gt;$key($val)
	    while(($key,$val) = each %arg);
    }

    msgctl($$self,IPC_SET,$ds-&gt;pack);
}

sub remove {
    my $self = shift;
    (msgctl($$self,IPC_RMID,0), undef $$self)[0];
}

sub rcv {
    @_ &lt;= 5 &amp;&amp; @_ &gt;= 3 or croak '$msg-&gt;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$N a*",$buf);
    $type;
}

sub snd {
    @_ &lt;= 4 &amp;&amp; @_ &gt;= 3 or  croak '$msg-&gt;snd( TYPE, BUF, FLAGS )';
    my $self = shift;
    msgsnd($$self,pack("l$N 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_IRUSR S_IWUSR);
    use IPC::Msg;

    $msg = IPC::Msg-&gt;new(IPC_PRIVATE, S_IRUSR | S_IWUSR);

    $msg-&gt;snd($msgtype, $msgdata);

    $msg-&gt;rcv($buf, 256);

    $ds = $msg-&gt;stat;

    $msg-&gt;remove;

=head1 DESCRIPTION

A class providing an object based interface to SysV IPC message queues.

=head1 METHODS

=over 4

=item new ( KEY , FLAGS )

Creates a new message queue associated with C&lt;KEY&gt;. A new queue 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 message queue associated with
it, and C&lt;I&lt;FLAGS&gt; &amp; IPC_CREAT&gt; is true.

=back

On creation of a new message queue 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 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&lt;msgrcv(2)&gt;.  The BUF becomes tainted.

=item remove

Remove and destroy the message queue from the system.

=item set ( STAT )

=item set ( NAME =&gt; VALUE [, NAME =&gt; VALUE ...] )

C&lt;set&gt; will set the following values of the C&lt;stat&gt; structure associated
with the message queue.

    uid
    gid
    mode (oly the permission bits)
    qbytes

C&lt;set&gt; accepts either a stat object, as returned by the C&lt;stat&gt; method,
or a list of I&lt;name&gt;-I&lt;value&gt; pairs.

=item snd ( TYPE, MSG [, FLAGS ] )

Place a message on the queue with the data from C&lt;MSG&gt; and with type C&lt;TYPE&gt;.
See L&lt;msgsnd(2)&gt;.

=item stat

Returns an object of type C&lt;IPC::Msg::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
    qnum
    qbytes
    lspid
    lrpid
    stime
    rtime
    ctime

=back

=head1 SEE ALSO

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

=head1 AUTHORS

Graham Barr &lt;gbarr@pobox.com&gt;,
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>