File Coverage

blib/lib/IPC/XPA.pm

Criterion	Covered	Total	%
statement	55	62	88.7
branch	18	38	47.3
condition	6	12	50.0
subroutine	13	14	92.8
pod	7	7	100.0
total	99	133	74.4

package IPC::XPA;

# ABSTRACT: Interface to the XPA messaging system

use strict;
use warnings;

our $VERSION = '0.16';

use parent 'DynaLoader';

bootstrap IPC::XPA $VERSION;

use Carp;

use namespace::clean;


# default attributes for Get, Set, Info, Access
my %def_attrs = ( max_servers => 1000, mode => {} );

sub _flatten_mode {
    my ( $mode ) = @_;

    return q{} unless keys %$mode;

    join( q{,}, map { "$_=" . $mode->{$_} } keys %$mode );
}





























sub Open {
    my ( $class, $mode ) = @_;
    $class = ref( $class ) || $class;

    # _Open will bless $xpa into the IPC::XPA class, but
    # need to worry about inheritance.
    my $xpa = _Open( _flatten_mode( $mode ) );
    bless { xpa => $xpa }, $class;
}










sub Close {
    my $xpa = shift;
    _Close( $xpa->{xpa} ) if defined $xpa->{xpa};
    undef $xpa->{xpa};
}

sub DESTROY {
    $_[0]->Close;
}
































































sub Get {
    my $obj = shift;

    my $attrs = 'HASH' eq ref $_[-1] ? pop @_ : {};

    @_ == 2
      or croak( 'usage: IPC::XPA->Get( $template, $paramlist [,\%attrs]' );

    my ( $template, $paramlist ) = @_;

    my %attrs = ( %def_attrs, %$attrs );

    # if called as a class method (ref($obj) not defined)
    # create an essentially NULL pointer for pass to XPAGet
    my $xpa = ref( $obj ) ? $obj->{xpa} : nullXPA();

    _Get( $xpa, $template, $paramlist, _flatten_mode( $attrs{mode} ), $attrs{max_servers} );
}








































































sub Set {
    my $obj = shift;

    my $attrs = 'HASH' eq ref $_[-1] ? pop @_ : {};

    @_ == 2 || @_ == 3
      or croak( 'usage: IPC::XPA->Set( $template, $paramlist [, [$buf],[\%attrs]]' );

    my $template  = shift;
    my $paramlist = shift;

    my %attrs = ( %def_attrs, %$attrs );

    # we want a reference to the data to avoid copying it.
    # if it's already a reference, use that directly, else
    # make one.  also, if no buffer was passed, make an empty one.
    my $valref
      = @_ && defined $_[0] ? ( ref( $_[0] ) ? $_[0] : \( $_[0] ) ) : \( q{} );

    $attrs{len} = length( $$valref ) unless defined $attrs{len};

    # if called as a class method (ref($obj) not defined)
    # create an essentially NULL pointer for pass to XPAGet
    my $xpa = ref( $obj ) ? $obj->{xpa} : nullXPA();

    _Set( $xpa, $template, $paramlist, _flatten_mode( $attrs{mode} ),
        $$valref, $attrs{len}, $attrs{max_servers} );
}















































sub Info {
    my $obj = shift;

    my $attrs = 'HASH' eq ref $_[-1] ? pop @_ : {};

    @_ == 2
      or croak( 'usage: IPC::XPA->Info( $template, $paramlist [,\%attrs]' );

    my ( $template, $paramlist ) = @_;

    my %attrs = ( %def_attrs, %$attrs );

    # if called as a class method (ref($obj) not defined)
    # create an essentially NULL pointer for pass to XPAGet
    my $xpa = ref( $obj ) ? $obj->{xpa} : nullXPA();

    _Info( $xpa, $template, $paramlist, _flatten_mode( $attrs{mode} ), $attrs{max_servers} );
}
































sub Access {
    my $obj = shift;

    my $attrs = 'HASH' eq ref $_[-1] ? pop @_ : {};

    @_ == 1 || @_ == 2
      or croak( 'usage: IPC::XPA->Access( $template, [,$paramlist] [,\%attrs]' );

    my ( $template, $paramlist ) = @_;

    my %attrs = ( %def_attrs, %$attrs );

    # if called as a class method (ref($obj) not defined)
    # create an essentially NULL pointer for pass to XPAGet
    my $xpa = ref( $obj ) ? $obj->{xpa} : nullXPA();

    _Access( $xpa, $template, $paramlist, _flatten_mode( $attrs{mode} ), $attrs{max_servers} );
}
































sub NSLookup {
    my $obj = shift;

    @_ == 2
      || croak( 'usage: IPC::XPA->NSLookup( $template, $type)' );

    # if called as a class method (ref($obj) not defined)
    # create an essentially NULL pointer for pass to XPAGet
    my $xpa = ref( $obj ) ? $obj->{xpa} : nullXPA();

    _NSLookup( $xpa, @_ );
}

#
# This file is part of IPC-XPA
#
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

1;

__END__