package Lire::Test::HashConfig; use strict; use base qw/ Lire::Config /; use Carp; use Lire::Utils qw/ check_param /; =pod =head1 NAME Lire::Test::HashConfig - Braindead Lire::Config implementation =head1 SYNOPSIS use base qw/Test::Unit::TestCase/; use Lire::Test::HashConfig; sub set_up { my $self = $_[0]; $self->{'old_config'} = $Lire::Config::SINGLETON; $Lire::Config::SINGLETON = new Lire::Test::HashConfig( { 'lr_archive' => undef, } ); } =head1 DESCRIPTION This is a simple module which is meant to be used from the set_up() method in unit tests. It can be used to create a 'fake' configuration to provide known values to the module under test. The new() method takes an hash reference which contains the configuration variable. The only methods of the Lire::Config interface implemented are the get() and config_spec(). The get() method which will return exactly the values provided in the new() method. Trying to get other configuration variables will throw a 'No such configuration variable' exception (as if the variable wasn't defined in the schema). The config_spec() method will return the object associated with the '_lr_config_spec' key. It will throw an exception if this key wasn't set. All other Lire::Config methods will throw a 'Unimplemented method' exception. =head1 SEE ALSO Lire::Config(3pm), Test::Unit::TestCase(3pm) =head1 VERSION $Id: HashConfig.pm,v 1.9 2006/07/23 13:16:31 vanbaal Exp $ =head1 AUTHORS Francis J. Lacoste =head1 COPYRIGHT Copyright (C) 2003 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 sub new { my ( $pkg, $cfg ) = @_; check_param( $cfg, 'cfg', sub { ref $_[0] eq 'HASH' }, "'cfg' parameter should be a hash reference" ); return bless {%$cfg}, $pkg; } sub get { my ( $self, $name ) = @_; check_param( $name, 'name', sub { exists $self->{$_[0]} }, "No such configuration variable" ); return ( UNIVERSAL::isa( $self->{$name}, 'Lire::Config::Value' ) ? $self->{$name}->get() : $self->{$name} ); } sub get_var { my ( $self, $name ) = @_; my $value = $self->{$name}; return $value if UNIVERSAL::isa( $value, 'Lire::Config::Value' ); croak "'$name' isn't a Lire::Config::Value object and '_lr_config_spec' isn't set" unless defined $self->{'_lr_config_spec'}; return $self->{'_lr_config_spec'}->get( $name )->instance( 'value' => $value ); } sub config_spec { my $self = $_[0]; croak "attribute '_lr_config_spec' is undef" unless defined $self->{'_lr_config_spec'}; return $self->{'_lr_config_spec'}; } sub init { } BEGIN { no strict 'refs'; foreach my $method ( qw/config_spec_path add_config_spec_path_dir del_config_spec_path_dir config_files add_config_path add_config_file get_config_file del_config_file / ) { *{$method} = sub { die "Unimplemented method: $method()" }; } } 1;