File Coverage

blib/lib/Connector/Proxy/Config/Std.pm

Criterion	Covered	Total	%
statement	91	104	87.5
branch	24	36	66.6
condition			n/a
subroutine	17	17	100.0
pod	7	7	100.0
total	139	164	84.7

# Connector::Proxy::Config::Std
#
# Proxy class for reading Config::Std configuration
#
# Written by Scott Hardin and Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Proxy::Config::Std;

use strict;
use warnings;
use English;
use Config::Std;
use Data::Dumper;

use Moose;
extends 'Connector::Proxy';

sub _build_config {
    my $self = shift;

    my $config;
    read_config($self->LOCATION(), $config);
    $self->_config($config);
}


sub get {
    my $self = shift;
    my @path = $self->_build_path_with_prefix( shift );

    # Config::Std does not allow nested data structures, emulate that
    # by separating last element from path and using that as key
    # in the section defined by the remaining prefix
    my $key = pop @path;
    my $section = $self->_build_section_name_from_path( @path);

    return $self->_config()->{$section}->{$key};
}

sub _get_node {

    my $self = shift;
    my @path = $self->_build_path_with_prefix( shift );
    my $fullpath = $self->_build_section_name_from_path( @path);
    return $self->_config()->{$fullpath};
}


sub get_size {

    my $self = shift;
    my $node = $self->get( shift );

    if (!defined $node) {
        return 0;
    }

    if (ref $node ne "ARRAY") {
       die "requested path looks not like a list";
    }

    return scalar @{$node};
}


sub get_list {

    my $self = shift;
    my $path = shift;

    # List is similar to scalar, the last path item is a hash key
    # in the section of the remaining prefix

    my $node = $self->get( $path );

    if (!defined $node) {
        return $self->_node_not_exists( $path );
    }

    if (ref $node ne "ARRAY") {
       die "requested path looks not like a hash";
    }
    return @{$node};
}


sub get_keys {

    my $self = shift;
    my $node = $self->_get_node( shift );

    if (!defined $node) {
        return @{[]};
    }

    if (ref $node ne "HASH") {
       die "requested path looks not like a hash";
    }
    return keys (%{$node});
}

sub get_hash {

    my $self = shift;
    my $path = shift;

    my $node = $self->_get_node( $path );

    if (!defined $node) {
        return $self->_node_not_exists($path);
    }

    if (ref $node ne "HASH") {
       die "requested path looks not like a hash";
    }
    return $node;
}


sub get_meta {

    my $self = shift;
    my $origin = shift;

    my @path = $self->_build_path_with_prefix( $origin );

    # We dont have a real tree, so we look if there is a config entry
    # that has the full path as key

    my $section = $self->_build_section_name_from_path( @path );

    # As top node iteration is not supported we report a connector
    if (!$section) {
        return { 'TYPE' => 'connector'};
    }

    # This is either a hash or undef
    my $node = $self->_config()->{$section};
    my $meta;

    # Array and scalar exist one level above
    if (!defined $node) {

        my $key = pop @path;
        $section = $self->_build_section_name_from_path( @path );
        $node = $self->_config()->{$section}->{$key};

        if (!defined $node) {
            return $self->_node_not_exists( \@path );
        }
        if (ref $node eq '') {
            $meta = {TYPE  => "scalar", VALUE => $node };
        } elsif (ref $node eq "SCALAR") {
            # I guess thats not supported
            $meta = {TYPE  => "reference", VALUE => $$node };
        } elsif (ref $node eq "ARRAY") {
            $meta = {TYPE  => "list", VALUE => $node };
        } else {
            die "Unsupported node type";
        }
    } elsif (ref $node eq "HASH") {
        $meta = {TYPE  => "hash" };
    } else {
        die "Unsupported node type";
    }
    return $meta;
}

sub exists {

    my $self = shift;

    my @path = $self->_build_path_with_prefix( shift );

    # No path always exists
    if (!@path) {
        return 1;
    }

    # Test if it is a section
    my $section = $self->_build_section_name_from_path( @path );
    if ($self->_config()->{$section}) {
        return 1;
    }

    # Test if it is a node
    my $key = pop @path;
    $section = $self->_build_section_name_from_path( @path );
    if (defined $self->_config()->{$section}->{$key}) {
        return 1;
    }

    return 0;

}

# might be refined to use a section delimiter different from connector
sub _build_section_name_from_path {

    my $self = shift;
    return join( $self->DELIMITER() , @_ );
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 Name

Connector::Proxy::Config::Std

=head1 Description