File Coverage

blib/lib/CIAO/Lib/Param.pm

Criterion	Covered	Total	%
statement	55	68	80.8
branch	12	14	85.7
condition	2	2	100.0
subroutine	12	20	60.0
pod	4	4	100.0
total	85	108	78.7

package CIAO::Lib::Param;

# ABSTRACT: An interface to the CIAO parameter library.

use 5.012;

use strict;
use warnings;

require Exporter;

use parent 'Exporter';
our @CARP_NOT = qw/ CIAO::Lib::Param::Croak /;

sub _croak {
    require Carp;
    goto \&Carp::croak;
}

our %EXPORT_TAGS = (
    'all' => [ qw(
          pget
          pquery
          pset
          pfind
        ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our $VERSION = '0.09';

require XSLoader;
XSLoader::load( 'CIAO::Lib::Param', $VERSION );

## no critic (Modules::ProhibitMultiplePackages)
# very simple exception class.  don't use Exception::Class to avoid
# too many dependencies for users.
{
    package CIAO::Lib::Param::Error;

    use overload
      '""'     => \&error,
      bool     => sub { 1 },
      eq       => sub { die },
      '.'      => sub { $_[0]->errstr . $_[1] },
      fallback => !!0;

    sub new { my $class = shift; bless {@_}, $class; }

    sub error  { $_[0]->{error} }
    sub errno  { $_[0]->{errno} }
    sub errstr { $_[0]->{errstr} }
    sub errmsg { $_[0]->{errmsg} }
}



# simple wrapper around open to get croakability. note
# that the object is blessed into CIAO::Lib::ParamPtr
# by open.
sub new {
    #my $class =
    shift;

    my $self;
    my $file = shift;
    my $mode = shift || 'r';

    my @arglist = @_;

    my $filename;

    if ( 'ARRAY' eq ref $file ) {
        $filename = $file->[0];
        unshift @arglist, $file->[1];
    }

    else {
        unshift @arglist, $file;
        $filename = undef;
    }

    $self = CIAO::Lib::Param::open( $filename, $mode, @arglist );


    $self;
}

sub _pread {
    my $pfile = shift;
    my $mode  = shift;


    my $argv      = 'ARRAY' eq ref $_[0] ? shift : undef;
    my $wantarray = wantarray();                            ## no critic (Community::Wantarray)

    my $pf = CIAO::Lib::Param->new( $pfile, $mode, defined $argv ? @$argv : () );

    if ( @_ ) {
        my @bogus = grep { !$pf->access( $_ ) } @_;
        _croak( 'unknown parameters: ', join( ', ', @bogus ), "\n" )
          if @bogus;
        return $wantarray ? map { $pf->get( $_ ) } @_ : $pf->get( $_[0] );
    }

    else {
        my $pm = $pf->match( q{*} );

        my @params;
        push @params, $_ while $_ = $pm->next;

        return map { ( $_ => $pf->get( $_ ) ) } @params;
    }

    die( "impossible!\n" );
}

# class get method to perform a one shot read of parameters
# never query
sub pget {
    my $pfile = shift;

    unshift @_, $pfile, 'rH';
    # act like we were never here
    goto &_pread;
}

# class get method to perform a one shot read of parameters
sub pquery {
    my $pfile = shift;

    unshift @_, $pfile, 'r';
    # act like we were never here
    goto &_pread;
}

sub pset {
    my ( $pfile, %params ) = @_;

    return unless keys %params;

    my $pf = CIAO::Lib::Param->new( $pfile, 'w' );

    $pf->set( $_, $params{$_} ) for keys %params;
}

1;

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

__END__