################################################################################
#
# $Revision: 19 $
# $Author: mhx $
# $Date: 2010/05/23 10:37:46 +0200 $
#
################################################################################
#
# Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz <[email protected]>.
# Version 1.x, Copyright (C) 1997, Graham Barr <[email protected]>.
#
# 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 = do { my @r = '$Snapshot: /IPC-SysV/2.03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
$VERSION = eval $VERSION;

# 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' => [
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 = @_;
$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$N a*",$buf);
$type;
}

sub snd {
@_ <= 4 && @_ >= 3 or croak '$msg->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->new(IPC_PRIVATE, S_IRUSR | S_IWUSR);

$msg->snd($msgtype, $msgdata);

$msg->rcv($buf, 256);

$ds = $msg->stat;

$msg->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<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. 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<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 AUTHORS

Graham Barr <[email protected]>,
Marcus Holland-Moritz <[email protected]>

=head1 COPYRIGHT

Version 2.x, Copyright (C) 2007-2010, 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