package Lire::Config::Dictionary; use strict; use base qw/Lire::Config::Value/; use Carp; use Locale::TextDomain 'lire'; use Lire::Utils qw/ check_param check_object_param /; =pod =head1 NAME Lire::Config::Dictionary - Dictionary Value object. =head1 SYNOPSIS use Lire::Config::Dictionary; =head1 DESCRIPTION Configuration parameter which contain a bunch of named parameters other values accessible by name. This value is used for top-level configuration sets. =cut sub new { my $self = shift->SUPER::new(@_); check_object_param( $self->{'spec'}, 'spec', "Lire::Config::CompoundSpec"); $self->{'values'} = {} unless exists $self->{'values'}; return $self; } sub as_value { my $self = $_[0]; my $ret = {}; foreach my $param ( $self->spec()->components() ) { next if $param->obsolete(); $ret->{ $param->name() } = $self->get( $param->name() )->as_value(); } return $ret; } sub as_label { my $self = $_[0]; my $label = $self->{'spec'}->label_component(); if ( defined $label ) { my $label = $self->get( $label )->get() || ''; $label =~ s/(^\s*|\s*$)//g; $label = __( '-- unidentified --' ) if $label eq ''; return $label; } else { return $self; } } =pod =head2 is_set( $name ) Returns true if the parameter $name was set in this dictionary. =cut sub is_set { my ( $self, $name ) = @_; check_param( $name, 'name' ); croak "no parameter $name defined in ", $self->name() unless $self->spec()->has_component( $name ); return exists $self->{'values'}{$name}; } =pod =head2 get( $name ) Returns the Value object for the $name subparameter. An exception will be thrown if there is no subparameter named $name. =cut sub get { my ($self, $name) = @_; check_param( $name, 'name' ); croak "no parameter $name defined in ", $self->name() unless $self->spec()->has_component( $name ); unless ( exists $self->{'values'}{$name} ) { # Create empty var $self->{'values'}{$name} = $self->spec()->get( $name )->instance() } return $self->{'values'}{$name}; } =pod =head2 set( $value ) Sets a parameter in this dictionary. =cut sub set { my ( $self, $value ) = @_; check_object_param( $value, 'value', 'Lire::Config::Value' ); my $name = $value->name(); croak $self->name(), " cannot contains a ", $name, " parameter" unless $self->spec()->has_component( $name ); croak "$value is not a valid instance for parameter ", $name unless $self->spec()->get( $name )->is_instance( $value ); $self->{'values'}{$value->name() } = $value; return; } sub save_value { my ( $self, $fh, $indent, $xmlns ) = @_; while(my ($key, $val) = each(%{$self->{'values'}})) { $val->save_xml( $fh, $indent+1, $xmlns ); } } sub is_equals { my ( $self, $other ) = @_; return 0 unless $self->SUPER::is_equals( $other ); foreach my $param ( $self->spec()->components() ) { return 0 unless $self->get( $param->name() )->is_equals( $other->get( $param->name() ) ); } return 1; } sub is_valid { my $self = $_[0]; foreach my $comp ( $self->spec()->component_names() ) { my $elmnt = $self->get( $comp ); return 0 if $elmnt->spec()->required() && !$elmnt->is_valid(); } return 1; } 1; # whine, whine __END__ =pod =head1 AUTHORS Wessel Dankers Wolfgang Sourdeau Francis J. Lacoste =head1 VERSION $Id: Dictionary.pm,v 1.19 2006/07/23 13:16:30 vanbaal Exp $ =head1 COPYRIGHT Copyright (C) 2002-2004 Stichting LogReport Foundation LogReport@LogReport.org This file is part of Lire. Lire is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program (see COPYING); if not, check with http://www.gnu.org/copyleft/gpl.html. =cut