package tests::TestHashConfigTest;

use strict;

use base qw/Lire::Test::TestCase/;

use Lire::Config;
use Lire::Config::TypeSpec;
use Lire::Test::HashConfig;

sub set_up {
    # We do not link to SUPER which uses Lire::Test::HashConfig
    my $self = $_[0];

    $self->{'cfg_struct'} = { 'dir' => '/etc/',
                            'file' => '/etc/passwd',
                            'list_1' => [ 1..3 ],
                            'hash_1' => { a => 'b',
                                        'b' => 'c', },
                          };
    $self->{'cfg'} = new Lire::Test::HashConfig( $self->{'cfg_struct'} );

    $self->{'spec'} = new Lire::Config::ConfigSpec( 'name' => 'mock' );
    $self->{'spec'}->add( new Lire::Config::StringSpec( 'name' => 'string'));
    $self->{'spec'}->add( new Lire::Config::IntegerSpec( 'name' => 'int') );

    return;
}

sub tear_down {
    my $self = $_[0];

    return;
}

sub test_new {
    my $self = $_[0];

    my $cfg = $self->{'cfg'};

    $self->assert_not_null( $cfg, "new() returned undef" );
    $self->assert( UNIVERSAL::isa( $cfg, "Lire::Config" ),
                   "$cfg isn't a Lire::Config object" );
}

sub test_get {
    my $self = $_[0];

    my $cfg = $self->{'cfg'};
    my $cfg_struct = $self->{'cfg_struct'};
    foreach my $var_name ( keys %$cfg_struct ) {
        my $value = $cfg->get( $var_name );
        $self->assert_not_null( $value, "get( $var_name ) returned undef" );
        $self->assert_equals( $value, $cfg_struct->{$var_name} );
    }

    $self->assert_died( sub { $cfg->get( 'unknown' ) },
                        qr/No such configuration variable/ );

    $cfg->{'string'} =
      $self->{'spec'}->get( 'string' )->instance( 'value' => 'A value' );
    $self->assert_equals( 'A value', $cfg->get( 'string' ) );
}

sub test_Lire_Config_get {
    my $self = $_[0];

    local $Lire::Config::SINGLETON = $self->{'cfg'};

    my $cfg_struct = $self->{'cfg_struct'};
    foreach my $var_name ( keys %$cfg_struct ) {
        my $value = Lire::Config->get( $var_name );
        $self->assert_not_null( $value, "get( $var_name ) returned undef" );
        $self->assert_equals( $value, $cfg_struct->{$var_name} );
    }
}

sub test_unimplemented_methods {
    my $self = $_[0];

    my $cfg = $self->{'cfg'};
    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 del_config_file get_config_file / )
    {
        no strict 'refs';
        eval { $cfg->$method() };
        $self->assert( $@, "method $method() didn't failed" );
        $self->assert( $@ =~ /Unimplemented method/,
                       "expected 'Unimplemented method' error, got '$@'" );
    }
}

sub test_config_spec {
    my $self = $_[0];

    my $cfg = $self->{'cfg'};
    $self->assert_died( sub { $cfg->config_spec() },
                        qr/attribute '_lr_config_spec' is undef/ );

    my $spec = new Lire::Config::ConfigSpec( 'name' => 'mock' );
    $cfg->{'_lr_config_spec'} = $spec;
    $self->assert_str_equals( $spec, $cfg->config_spec() );
}

sub test_get_var {
    my $self = $_[0];

    my $cfg = $self->{'cfg'};
    $cfg->{'string'} = 'A value';
    $cfg->{'int'} = $self->{'spec'}->get( 'int' )->instance( 'value' => 10 );

    $self->assert_died( sub { $cfg->get_var( 'string' ) },
                        qr/'string' isn't a Lire::Config::Value object and '_lr_config_spec' isn't set/ );

    $self->assert_str_equals( $cfg->{'int'},
                              $cfg->get_var( 'int' ) );

    $cfg->{'_lr_config_spec'} = $self->{'spec'};
    my $var = $cfg->get_var( 'string' );
    $self->assert( UNIVERSAL::isa( $var, 'Lire::Config::Scalar' ),
                   "expected a Lire::Config::Scalar, $var" );
    $self->assert_str_equals( 'A value', $var->get() );
}
1;


syntax highlighted by Code2HTML, v. 0.9.1