package tests::ConfigValuesTest;

use strict;

use base qw/Test::Unit::TestSuite/;

use Lire::Config::TypeSpec;
use Lire::Config::Value;
use IO::Scalar;

sub name {
    return "Configuration Values Tests";
}

sub include_tests {
    return qw/tests::ConfigScalarTest tests::ConfigListTest
              tests::ConfigDictionaryTest /;
}

package tests::ConfigValueTest;

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

sub new {
    my $self = shift->SUPER::new( @_ );

    $self->{'config_spec'} = new Lire::Config::ConfigSpec();
    $self->{'list_spec'} = new Lire::Config::ListSpec( 'name' => "list" );
    $self->{'config_spec'}->add( $self->{'list_spec'} );
    $self->{'int_spec'} = new Lire::Config::IntegerSpec( 'name' => "int" );
    $self->{'config_spec'}->add( $self->{'int_spec'} );
    $self->{'string_spec'} = new Lire::Config::StringSpec( 'name' => "string" );
    $self->{'config_spec'}->add( $self->{'string_spec'} );
    $self->{'list_spec'}->add( $self->{'int_spec'} );
    $self->{'select_spec'} = new Lire::Config::SelectSpec( 'name' => "select" );
    $self->{'config_spec'}->add( $self->{'select_spec'} );
    $self->{'list_spec'}->add( $self->{'select_spec'} );
    $self->{'select_spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_1" ));
    $self->{'select_spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_2" ));

    return $self;
}

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

    my $value = $self->type()->new( 'spec' => $self->spec() );
    $self->assert_isa( $self->type(), $value );
    $self->assert_str_equals( $self->spec()->name(), $value->name() );

    my $proto = $value->new();
    $self->assert_isa( $self->type(), $proto );
    $self->assert_str_not_equals( $proto, $value );
    $self->assert_deep_equals( $proto, $value );

    $self->assert_dies( qr/missing 'spec' parameter/,
                        sub { $self->type()->new() } );

    $self->assert_dies( qr/'spec' parameter.*should be a.*instance/,
                        sub { $self->type()->new( 'spec' => $self ) } );

}

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

    my $value = $self->type()->new( 'spec' => $self->spec() );
    my $name = $value->name();
    $self->assert_matches( qr/$name=.*not supported/, $value->as_shell_var() );
}

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

    my $value = $self->type()->new( 'spec' => $self->spec() );
    my $clone = $value->clone();

    $self->assert_str_not_equals( $value, $clone );
    $self->assert_deep_equals( $value, $clone );
    $self->assert_str_equals( $value->{'spec'}, $clone->{'spec'} );
}

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

    my $value = $self->type()->new( 'spec' => $self->spec() );
    $self->assert( $value->is_equals( $value ), 'is_equals( $self )' );
    $self->assert( $value->is_equals( $value->clone() ),
                   'is_equals( clone )' );

    # Changing the spec, should returns false.
    my $other_value = $value->clone();
    $other_value->{'spec'} = {};
    $self->assert( ! $value->is_equals( $other_value ),
                   '! is_equals( other_spec )' );
}

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

    my $default = $self->spec()->instance();
    $self->assert( ! $default->is_default(), "!is_default()" );
    $self->spec()->default( $default );

    my $value = $self->type()->new( 'spec' => $self->spec() );
    $self->assert( $value->is_default(), "is_default() != 1" );
}

sub check_save_xml_default {
    my ( $self, $value ) = @_;

    my $name =  $self->spec()->name();
    my $fh = new IO::Scalar();
    my $buf = $fh->sref();
    $value->save_xml( $fh );
    my $pos = index( $$buf, "<param name=\"$name\"" );
    $self->assert( $pos >= 0, $$buf || 'Nothing written' );

    $self->spec()->default( $value );
    my $default = $self->spec()->instance();
    $$buf = '';
    $default->save_xml( $fh );
    $self->assert_str_equals( '', $$buf );

    $self->spec()->default( undef );
}

sub check_save_xml_obsolete {
    my ( $self, $value ) = @_;

    my $name =  $self->spec()->name();
    my $fh = new IO::Scalar();
    my $buf = $fh->sref();
    $self->spec()->obsolete( 1 );
    $value->save_xml( $fh );
    $self->assert_str_equals( '', $$buf );

    $self->spec()->obsolete( 0 );
    $value->save_xml( $fh, 0, 'lrcml:' );
    my $pos = index( $$buf, "<lrcml:param name=\"$name\"" );
    $self->assert( $pos >= 0, $$buf || 'Nothing written' );
}

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

    my $value = $self->spec()->instance();
    $self->check_save_xml_default( $value->clone() );
    $self->check_save_xml_obsolete( $value->clone() );
}

package tests::ConfigScalarTest;

use base qw/tests::ConfigValueTest/;

sub type {
    return "Lire::Config::Scalar";
}

sub spec {
    return $_[0]{'int_spec'};
}

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

    $self->SUPER::test_new;

    my $value = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'},
                                          'value' => 10,
                                        );

    $self->assert_equals( 10, $value->as_value() );
    $self->assert_deep_equals( $value, $value->new() );

    my $other = $value->new( 'value' => 11 );
    $self->assert_num_equals( 11, $other->{'value'} );
}


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

    my $value = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'} );
    $value->set( 10 );
    $self->assert_equals( 10, $value->as_value() );

    $value = new Lire::Config::Scalar( 'spec' => $self->{'select_spec'} );
    $value->set( "OPTION_1" );
    $self->assert_equals( "OPTION_1", $value->get() );
    $self->assert_equals( "option_1", $value->as_value() );

    my $warning = '';
    local $SIG{'__WARN__'} = sub { $warning .= join "", @_ };
    $value = new Lire::Config::Scalar( 'spec' => $self->{'select_spec'} );
    $value->{'value'} = "no_such_option";
    my @array_context = $value->as_value();
    $self->assert_matches( qr/invalid value for parameter 'select':/,
                           $warning );
    $self->assert_deep_equals( [], \@array_context );

    # Second as_value() shouldn't emit another warning
    $warning = '';
    $self->assert_null( scalar $value->as_value(),
                        "should return undef in scalar context" );
    $self->assert_equals( '', $warning );
}

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

    my $int = $self->type->new( 'spec' => $self->{'int_spec'}, value => 10 );
    $self->assert_equals( "int='10'", $int->as_shell_var() );

    my $undefined_int = $self->type->new( 'spec' => $self->{'int_spec'} );
    $self->assert_equals( "", $undefined_int->as_shell_var() );

    my $s = q{> Long string with shell `metacharacters`, 'quote', "double"};
    my $quoted = q{> Long string with shell `metacharacters`, '\''quote'\'', "double"};
    my $string = $self->type->new( 'spec' => $self->{'string_spec'}, value => $s );
    $self->assert_equals( "string='$quoted'", $string->as_shell_var() );

    local $SIG{'__WARN__'} = sub { $self->annotate( join "", @_ ) };
    my $bad_option = $self->type->new( 'spec' => $self->{'select_spec'},
                                       'value' => "bad_option" );
    $self->assert_equals( '', $bad_option->as_shell_var() );
}

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

    my $value = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'} );

    $value->set( 10 );
    $self->assert_equals( 10, $value->get() );

    my $warning = undef;
    my $oldwarn = $SIG{'__WARN__'};
    $SIG{'__WARN__'} = sub { $warning = join(' ', @_); };
    $value->set('file');
    $SIG{'__WARN__'} = $oldwarn;
    $self->assert_null($warning, "set() with invalid value should NOT warn");
}

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

    $self->SUPER::test_is_equals();

    my $string = new Lire::Config::Scalar( 'spec' => $self->{'string_spec'} );
    my $other_string = $string->clone();
    $string->{'value'} = 'A value';
    my $int = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'} );
    my $other_int = $int->clone();
    $int->{'value'} = 10;

    $self->assert( ! $string->is_equals( $other_string ),
                   "! is_equals( undef )" );
    $other_int->{'value'} = 11;
    $self->assert( ! $int->is_equals( $other_int ), "! is_equals( 11 )" );
    $other_int->{'value'} = "10.0000";
    $self->assert( $int->is_equals( $other_int ), "is_equals( 10.00 )" );
}


package tests::ConfigListTest;

use base qw/tests::ConfigValueTest/;

sub type {
    return "Lire::Config::List";
}

sub spec {
    return $_[0]{'list_spec'};
}

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

    $self->SUPER::test_new();

    my $list = $self->{'list_spec'}->instance();
    $list->append( $self->{'select_spec'}->instance() );
    $self->assert_deep_equals( $list, $list->new() );
}

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

    local $SIG{'__WARN__'} = sub { $self->annotate( join "",  @_ ) };
    my $list = $self->{'list_spec'}->instance();
    $self->assert_deep_equals( [], $list->as_value() );
    $list->append( $self->{'int_spec'}->instance( 'value' => 10 ) );
    $list->append( $self->{'select_spec'}->instance( 'value' => "option_1" ) );
    $list->append( $self->{'select_spec'}->instance( 'value' => "no_such_option" ) );
    $self->assert_deep_equals( [ 10, "option_1" ],
                               $list->as_value(),
                             );
}

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

    my $list = $self->{'list_spec'}->instance();
    $self->assert( $list->is_valid(), 'is_valid()' );

    $list->append( $self->{'int_spec'}->instance( 'value' => 'abc' ) );
    $self->assert( !$list->is_valid(), '!is_valid()' );
    $list->get( 0 )->set( '10' );
    $self->assert( $list->is_valid(), 'is_valid()' );
    $list->append( $self->{'select_spec'}->instance( 'value' => "bad_option"));
    $self->assert( !$list->is_valid(), '!is_valid()' );
    $list->get( 1 )->spec()->required( 0 );
    $self->assert( $list->is_valid(), 'is_valid()' );
}


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

    my $list = $self->{'list_spec'}->instance();
    $self->assert_dies( qr/index out of bounds/,
                        sub { $list->get( 0 ) } );

    my $int = $self->{'int_spec'}->instance( 'value' => 10 );
    $list->append( $int );
    $self->assert_equals( $int, $list->get( 0 ) );
    $self->assert_equals( $int, $list->get( -1 ) );

    $self->assert_dies( qr/'idx' parameter should be an integer/,
                        sub { $list->get( "string" ) } );
}

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

    my $list = $self->{'list_spec'}->instance();
    $self->assert_dies( qr/missing 'idx' parameter/,
                        sub { $list->set() });
    my $int = $self->{'int_spec'}->instance( 'value' => 10 );
    $self->assert_dies( qr/index out of bounds: 0/,
                        sub { $list->set( 0, $int ) } );
    $list->append( $int );
    $self->assert_dies( qr/missing 'value' parameter/,
                        sub { $list->set( 0, undef ) } );

    $int = $self->{'int_spec'}->instance( 'value' => 5 );
    $list->set( 0, $int );
    $self->assert_str_equals( $int, $list->{'elements'}[0] );
}

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

    my $list = $self->{'list_spec'}->instance();
    $self->assert_equals( 0, scalar $list->elements() );

    my $select = $self->{'select_spec'}->instance();
    my $int = $self->{'int_spec'}->instance( 'value' => 10 );
    $list->append( $select );
    $self->assert_equals( 1, scalar $list->elements() );
    $list->append( $int );
    $self->assert_deep_equals( [ $select, $int ], [$list->elements()] );

    $self->assert_dies( qr/missing 'value' parameter/,
                        sub { $list->append() });
    $self->assert_dies( qr/cannot contains config parameters/,
                        sub { $list->append( $self->{'config_spec'}->instance() )});

    my $bad_select = new Lire::Config::SelectSpec( 'name' => $self->{'select_spec'}->name );
    $self->assert_dies( qr/is not a valid instance for component/,
                        sub { $list->append( $bad_select->instance() ) } );
}

sub test_check_idx {
    my $self = $_[0];
    my $list = $self->{'list_spec'}->instance();

    $self->assert_dies( qr/not an integer: wawa/,
                        sub { $list->check_idx( 'wawa' ) } );
    $self->assert_dies( qr/index out of bounds: 0/,
                        sub { $list->check_idx( 0 ) } );
    $self->assert_dies( qr/index out of bounds: -1/,
                        sub { $list->check_idx( -1 ) } );

    $list->{'elements'} = [ undef, undef, undef ];
    foreach my $idx ( qw/ 0 1 2 -1 -2 -3/ ) {
        eval { $list->check_idx( $idx ) };
        $self->fail( "$@" ) if $@;
    }
}

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

    my $list = $self->{'list_spec'}->instance();
    my $int = $self->{'int_spec'}->instance( 'value' => 10 );
    $list->{'elements'} = [ undef, undef ];
    $list->append( $int, 0 );
    $self->assert_deep_equals( [ undef, $int, undef ], $list->{'elements'} );
    $list->append( $int, -1 );
    $self->assert_deep_equals( [ undef, $int, undef, $int ],
                               $list->{'elements'} );
}

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

    my $list = $self->{'list_spec'}->instance();
    $list->{'elements'} = [ 0, 1, 2, 3, 4 ];
    $list->move( 0, -1 );
    $self->assert_deep_equals( [ 1, 2, 3, 4, 0 ], $list->{'elements'} );
    $list->move( 1, 0 );
    $self->assert_deep_equals( [ 2, 1, 3, 4, 0 ], $list->{'elements'} );
    $list->move( 2, -2 );
    $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} );
    $list->move( 0, 0 );
    $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} );
    $list->move( 0, -5 );
    $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} );
    $list->move( -5, -5 );
    $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} );
    $list->move( -5, -4 );
    $self->assert_deep_equals( [ 1, 2, 4, 3, 0 ], $list->{'elements'} );
}

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

    my $list = $self->{'list_spec'}->instance();
    $list->{'elements'} = [ 0, 1, 2, 3, 4 ];
    $list->clear();

    $self->assert_deep_equals( [], $list->{'elements'} );
}

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

    $self->SUPER::test_is_equals();

    my $list = $self->{'list_spec'}->instance();
    my $other = $list->clone();
    my $int = $self->{'int_spec'}->instance( 'value' => 10 );
    $list->append( $int );
    $self->assert( ! $list->is_equals( $other ),
                   '! is_equals( count )' );
    $other->append( $self->{'int_spec'}->instance( 'value' => 11 ) );
    $self->assert( ! $list->is_equals( $other ),
                   '! is_equals( different )' );
    $other->set( 0, $int->clone() );
    $self->assert( $list->is_equals( $other ), 'is_equals()' );
}

package tests::ConfigDictionaryTest;

use base qw/tests::ConfigValueTest/;

sub type {
    return "Lire::Config::Dictionary";
}

sub spec {
    return $_[0]{'config_spec'};
}

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

    $self->SUPER::test_new();

    my $dict = $self->{'config_spec'}->instance();
    $dict->set( $self->{'int_spec'}->instance() );
    $self->assert_deep_equals( $dict, $dict->new() );
}

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

    local $SIG{'__WARN__'} = sub { $self->annotate( join "", $@ ) };
    my $dict = $self->{'config_spec'}->instance();
    $self->assert_deep_equals( { 'select' => undef,
                                 'int'    => 0,
                                 'list'   => [],
                                 'string' => '',
                               },
                               $dict->as_value,
                             );

    $dict->set( $self->{'select_spec'}->instance( 'value' => "option_1" ) );
    $dict->set( $self->{'int_spec'}->instance( 'value' => "10" ) );
    $self->assert_deep_equals( {
                                'select' => "option_1",
                                'int'    => 10,
                                'list'   => [],
                                'string' => '',
                               },
                               $dict->as_value,
                             );
}

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

    my $dict = $self->{'config_spec'}->instance();

    $self->assert( !$dict->is_set( "int" ), "is_set() returned true" );
    $dict->get( 'int' );
    $self->assert( $dict->is_set( "int" ), "is_set() returned false" );

    $self->assert_dies( qr/missing 'name' parameter/,
                        sub { $dict->is_set() } );

    ;
    $self->assert_dies( qr/no parameter no_such_param defined/,
                        sub { $dict->is_set( "no_such_param") } );
}

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

    my $dict = $self->{'config_spec'}->instance();
    my $int = $dict->get( "int" );
    $self->assert_not_null( $int, "get() should create the instance" );
    $self->assert_equals( "int", $int->name() );
    $self->assert_str_equals( '', $int->get() );

    $self->assert_equals( $int, $dict->get( "int" ) );

    $self->assert_dies( qr/missing 'name' parameter/,
                        sub { $dict->get() } );

    $self->assert_dies( qr/no parameter bad_param defined in/,
                        sub { $dict->get( "bad_param" ) } );
}

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

    my $dict = $self->{'config_spec'}->instance();

    $self->assert_dies( qr/missing 'value' parameter/,
                        sub { $dict->set() } );

    $self->assert_dies( qr/\'value\' parameter should be a \'Lire::Config::Value\' instance, not/,
                      sub{ $dict->set( $self->{'config_spec'} ) } );

    my $int = $self->{'int_spec'}->instance();
    $dict->set( $int );
    $self->assert_equals( $int, $dict->get( 'int' ) );

    my $select = new Lire::Config::SelectSpec( 'name' => 'int' )->instance();
    ;
    $self->assert_dies( qr/is not a valid instance for parameter/,
                        sub { $dict->set( $select ) } );
}

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

    $self->SUPER::test_is_equals();

    my $dict = $self->{'config_spec'}->instance();
    my $other = $dict->clone();
    $dict->set( $self->{'string_spec'}->instance( 'value' => 'A value' ) );
    $self->assert( ! $dict->is_equals( $other ), "!is_equals()" );

    $other->set( $self->{'string_spec'}->instance( 'value' => 'A value' ) );
    $self->assert( $dict->is_equals( $other ), "is_equals()" );
}

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

    my $cfg = $self->{'config_spec'}->instance();
    $self->assert( !$cfg->is_valid(), '!is_valid()' );

    $cfg->get( 'int' )->set( 10 );
    $cfg->get( 'select' )->spec()->required( 0 );
    $cfg->get( 'string' )->spec()->required( 0 );
    $self->assert( $cfg->is_valid(), 'is_valid()' );
}

1;


syntax highlighted by Code2HTML, v. 0.9.1