File Coverage

blib/lib/POSIX/RT/MQ.pm

Criterion	Covered	Total	%
statement	71	72	98.6
branch	37	52	71.1
condition	6	14	42.8
subroutine	17	18	94.4
pod	9	12	75.0
total	140	168	83.3

package POSIX::RT::MQ;

# $Id: MQ.pm,v 1.12 2003/01/28 07:10:03 ilja Exp $

use 5.006;
use strict;
use warnings;
use Carp 'croak';
use Fcntl 'O_NONBLOCK';

require DynaLoader;

our @ISA = qw(DynaLoader);
our $VERSION = '0.05';

bootstrap POSIX::RT::MQ $VERSION;

sub open
{
    my $proto  = shift;
    (@_ >= 2 && @_ <= 4)
        or croak 'Usage: POSIX::RT::MQ->open(name, oflag [, mode [, attr]])';

    my @args = @_;
    $args[2] = 0666                 unless defined $args[2];
    # work around 'using undefined value' warnings
    # todo: fix XS?
    delete $args[3] unless defined $args[3];
    $args[3] = attr_pack($args[3])  if     defined $args[3]; # pack attr

    defined(my $mqdes  = mq_open(@args))  or return undef;
    my $class  = ref($proto) || $proto;
    my $self   = bless { name=>$args[0], mqdes=>$mqdes }, $class;

    # get attributes and save for future references (in receive())
    $self->{_saved_attr_} = $self->attr  or return undef;

    return $self;
}

sub unlink
{
    my $self  = shift;
    if (ref $self)
    {
        (@_ == 0) or croak 'Usage: $mq->unlink()';
        my $rc = mq_unlink($self->{name});
        $self->{name} = undef  if defined $rc;
        return $rc;
    }
    else
    {
        (@_ == 1) or croak 'Usage: POSIX::RT::MQ->unlink(name)';
        return mq_unlink($_[0]);
    }
}

sub attr
{
    my $self = shift;
    (@_ >= 0 && @_ <= 1) or croak 'Usage: $mq->attr( [new_attr] )';
    my $attr_packed = mq_attr( $self->{mqdes}, map {attr_pack($_)} @_ );

    defined $attr_packed ? attr_unpack($attr_packed) : undef;
}

sub send
{
    my $self = shift;
    (@_ >= 1 && @_ <= 2) or croak 'Usage: $mq->send($msg ,[ $prio ])';
    return mq_send( $self->{mqdes}, $_[0], ($_[1] || 0) );
}

sub receive
{
    my $self = shift;
    (@_ == 0) or croak 'Usage: $mq->receive()';
    my @result = mq_receive($self->{mqdes}, $self->{_saved_attr_}{mq_msgsize});
    wantarray ? @result : $result[0];
}

sub timedreceive
{
    my $self = shift;
    (@_ <= 1) or croak 'Usage: $mq->timedreceive([ $time_in_seconds] )';
    my @result = mq_timedreceive($self->{mqdes}, $self->{_saved_attr_}{mq_msgsize}, @_ );
    wantarray ? @result : $result[0];
}

sub notify
{
    my $self = shift;
    (@_ <= 1) or croak 'Usage: $mq->notify([ $signo ])';
    mq_notify( $self->{mqdes}, @_ );
}

sub blocking
{
    my $self = shift;
    (@_ <= 1) or croak 'Usage: $mq->blocking([ BOOL ])';

    my $a = $self->attr()  or return undef;
    my $old_blocking = ($a->{mq_flags} & O_NONBLOCK) ? 0 : 1;
    if (@_)
    {
        if ($_[0]) { $a->{mq_flags} &= (~O_NONBLOCK); }
        else       { $a->{mq_flags} |= O_NONBLOCK;    }

        $self->attr($a) or $old_blocking = undef;;
    }

    $old_blocking;
}

sub name { $_[0]->{name} }

# expose mqdes
sub mqdes { $_[0]->{mqdes} }

sub DESTROY
{
    my $self  = shift;
    #print "destrsroying $self\n";
    defined($self->{mqdes}) and mq_close($self->{mqdes});
    $self->{mqdes} = undef;
}

# allow explicit close
*close = \&DESTROY;

sub attr_pack
{
    my $as_hash = shift;
    mq_attr_pack( map {defined $as_hash->{$_} ? $as_hash->{$_} : 0}
                      qw/mq_flags mq_maxmsg mq_msgsize mq_curmsgs/ );
}


sub attr_unpack
{
    my @attr = mq_attr_unpack(shift);
    { mq_flags=>$attr[0], mq_maxmsg=>$attr[1], mq_msgsize=>$attr[2], mq_curmsgs=>$attr[3] };
}

1;

__END__