# 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