package tests::ConfigSpecTest;

use strict;

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

sub name {
    return "Configuration Specification Tests";
}

sub include_tests {
    return qw/tests::ConfigListSpecTest tests::ConfigTypeSpecTest
              tests::ConfigFileSpecTest tests::ConfigExecutableSpecTest
              tests::ConfigDirectorySpecTest tests::ConfigBooleanSpecTest
              tests::ConfigStringSpecTest tests::ConfigIntegerSpecTest
              tests::ConfigSelectSpecTest tests::ConfigOptionSpecTest
              tests::ConfigConfigSpecTest tests::ConfigCommandSpecTest
            /;
}

package tests::ConfigTypeSpecBase;

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

use Lire::Config::TypeSpec;

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

    $self->init();
    $self->init_i18n();

    return $self;
}

sub set_up {
    my $self = $_[0];
    $self->SUPER::set_up();
    $self->set_up_locale();
    $self->set_up_spec();

    return;
}

sub tear_down {
    my $self = $_[0];
    $self->SUPER::tear_down();
    $self->tear_down_locale();

    return;
}

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

    $self->{'spec'} = $self->type()->new( 'name' => "test_spec",
                                          $self->additional_new_params() );
}

sub additional_new_params { return () }

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

    my $type = $self->type();
    my $spec = $type->new( 'name' => "parameter",
                           'summary' => "Parameter Summary",
                           'description' => "<para>Parameter Description</para>",
                           'required' => 0,
                           'obsolete' => 1,
                           $self->additional_new_params(),
                         );
    $self->assert_isa( $type, $spec );

    $self->assert_str_equals( "parameter", $spec->name() );
    $self->assert_str_equals( "Parameter Summary", $spec->summary() );
    $self->assert_str_equals( "<para>Parameter Description</para>",
                              $spec->description() );
    $self->assert( ! $spec->required(), '!required()' );
    $self->assert( $spec->obsolete(), 'obsolete()' );

    $self->assert_dies( qr/missing 'name' parameter/,
                        sub { $type->new( $self->additional_new_params() ) } );
    $self->assert_dies( qr/name should only contain/,
                        sub { $type->new( 'name' => 'wrong%name',
                                          $self->additional_new_params() ) } );
}

package MockTypeSpec;

use base qw/Lire::Config::TypeSpec/;

sub instance_class {
    return "MockValue";
}

package MockValue;

use base qw/Lire::Config::Value/;

package tests::ConfigTypeSpecTest;

use base qw/tests::ConfigTypeSpecBase/;

use Lire::Utils qw/deep_copy/;

sub type {
    return "MockTypeSpec";
}

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

    my $value = $self->{'spec'}->instance();
    $self->assert_isa( 'MockValue', $value );

    $value->{'my_attribute'} = 3;
    $self->{'spec'}{'_default'} = $value;

    my $default = $self->{'spec'}->instance();
    $self->assert_str_not_equals( $value, $default );
    $self->assert_deep_equals( $value, $default );
}

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

    my $spec = $self->{'spec'};
    $self->assert( ! $spec->has_default(), "!has_default()" );
    $self->assert_null( $spec->default(), "default() -> !undef" );

    my $value = $spec->instance();

    $spec->default( $value );
    $self->assert_str_equals( $value, $spec->{'_default'} );
    $self->assert( $spec->has_default(), "has_default() != 1" );
    $self->assert_str_equals( $value, $spec->default() );

    my $spec2 = deep_copy( $spec );
    $self->assert_dies( qr/default value doesn't come from this specification/,
                        sub { $spec->default( $spec2->instance() ) } );


    $spec->default( undef );
    $self->assert_null( $spec->{'_default'} );
}

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

    my $spec = $self->{'spec'};
    $self->assert_num_equals( 1, $spec->{'_required'} );
    $self->assert_num_equals( 1, $spec->required() );
    $spec->required( 0 );
    $self->assert_num_equals( 0, $spec->{'_required'} );
}

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

    my $spec = $self->{'spec'};
    $self->assert_num_equals( 0, $spec->{'_obsolete'} );
    $self->assert_num_equals( 0, $spec->obsolete() );
    $spec->obsolete( 1 );
    $self->assert_num_equals( 1, $spec->{'_obsolete'} );
}

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

    my $value = $self->{'spec'}->instance();
    $self->assert( $self->{'spec'}->is_instance( $value ),
                   "is_instance() returned false",
                 );
    $self->assert_dies( qr/missing \'instance\' parameter/,
                        sub { $self->{'spec'}->is_instance() } );
    $self->assert_dies( qr/\'instance\' parameter should be a \'Lire::Config::Value\' instance, not/,
                        sub { $self->{'spec'}->is_instance( $self->{'spec'}) } );

    my $bad_value = $self->type()->new( 'name'=> "bad_name",
                                        $self->additional_new_params(),
                                      )->instance();
    $self->assert( ! $self->{'spec'}->is_instance( $bad_value ),
                   "is_instance() with value with different name should return false"
                 );

    my $clone = $self->type()->new( 'name' => $self->{'spec'}->name(),
                                    $self->additional_new_params(),
                                  )->instance();
    $self->assert( ! $self->{'spec'}->is_instance( $clone ),
                   "is_instance() with different spec should fail" );
}

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

    $self->assert_str_equals( "test_spec", $self->{'spec'}->summary() );
    $self->{'spec'}->summary( 'Test Summary' );
    $self->assert_str_equals( "Test Summary", $self->{'spec'}{'summary'} );
    $self->assert_str_equals("Test Summary", $self->{'spec'}->summary() );

    $self->{'spec'}->summary( "Summary with\nnewlines   \n   and wawas" );
    $self->assert_str_equals( "Summary with\nnewlines   \n   and wawas",
                              $self->{'spec'}{'summary'} );
    $self->assert_str_equals( 'Summary with newlines and wawas',
                              $self->{'spec'}->summary() );

    no warnings 'redefine';
    my $dgettext_param = '';
    my $dgettext = sub {
        $dgettext_param = $_[1];
        return "  dgettext\ncalled\n";
    };
    local *Lire::Config::TypeSpec::dgettext = $dgettext;
    $self->assert_str_equals( "  dgettext\ncalled\n",
                              $self->{'spec'}->summary() );
    $self->assert_str_equals ( 'Summary with newlines and wawas',
                               $dgettext_param );

    return;
}

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

    $self->assert_null( $self->{'spec'}->description(),
                        "uninitialized description should be empty" );

    my $desc = "<para>Description</para>";
    $self->{'spec'}->description( $desc );
    $self->assert_equals( $desc, $self->{'spec'}->description() );


    $self->assert_dies( qr/'description' parameter should be a DocBook/,
                        sub {$self->{'spec'}->description( "Description" ) } );

    $desc = "<para>Multi-line\n   description</para>";
    $self->{'spec'}->description( $desc );
    $self->assert_equals( "<para>Multi-line description</para>",
                          $self->{'spec'}->description() );
}

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

    my $spec = $self->{'spec'};
    $spec->{'i18n_domain'} = 'lire-test';
    $spec->{'summary'} = 'JPEG Files';
    $self->annotate( "There is a bug somewhere that seems to prevent the locale to be set correctly to 'C'." );
    $self->assert_str_equals( 'JPEG Files', $spec->summary() );
    $self->set_locale( 'fr_CA.iso8859-1' );
    $self->assert_str_equals( 'Fichiers JPEG', $spec->summary() );

    return;
}

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

    my $spec = $self->{'spec'};
    $spec->{'description'} = '<para>JPEG Files</para>';
    $spec->{'i18n_domain'} = 'lire-test';
    $self->annotate( "There is a bug somewhere that seems to prevent the locale to be set correctly to 'C'." );
    $self->assert_str_equals( '<para>JPEG Files</para>',
                              $spec->description() );
    $self->set_locale( 'fr_CA.iso8859-1' );
    $self->assert_str_equals( '<para>Fichiers JPEG</para>',
                              $spec->description() );
}

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

    my $spec = $self->{'spec'};
    $spec->{'description'} = "<para>A parameter's description</para>";
    $self->assert_str_equals( "A parameter's description",
                              $spec->text_description() );

    $spec->{'description'} = <<EOT;
<para>A very very long multi-paragraphs text description for
this parameter. It is really long for a filled paragraph.</para>

      <para>This is yet another paragraph. This description never
ends.</para>

EOT
    my $expected = "A very very long multi-paragraphs text description for this parameter. It is really long for a filled paragraph.\n\nThis is yet another paragraph. This description never ends.";
    $self->assert_str_equals( $expected, $spec->text_description() );
}

package tests::ConfigScalarSpecTest;

use base qw/tests::ConfigTypeSpecBase/;

use Lire::Config::ScalarSpec;

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

    $self->assert_null( $self->{'spec'}->normalize( undef ),
                        "normalize( undef ) should return undef",
                      );

    my %normalize_test_data = $self->normalize_test_data;
    while ( my ( $value, $expected ) = each %normalize_test_data ) {
        my $normalized = $self->{'spec'}->normalize( $value );
        if ( ! defined $expected ) {
            $self->assert_null( $normalized,
                                'expected undef from ' . ref( $self->{'spec'}) . "->normalize( $value ), got " . ($normalized || '<undef>') );
        } else {
            $self->assert_str_equals( $expected, $normalized );
        }
    }
}

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

    my $warning = '';
    local $SIG{'__WARN__'} = sub { $warning .= join "", @_ };
    $self->assert( ! $self->{'spec'}->is_valid( undef ),
                   "is_valid( undef ) returned true" );
    $self->assert( ! $warning, "is_valid( undef ) had warnings: $warning" );
    foreach my $v ( $self->valid_test_data ) {
        $self->assert( $self->{'spec'}->is_valid( $v ),
                       $self->type(). "->is_valid should return true for $v" );
        $self->assert( ! $warning, "is_valid( '$v' ) had warnings: $warning" );
    }

    foreach my $v ( $self->invalid_test_data ) {
        $self->assert( !$self->{'spec'}->is_valid( $v ),
                       $self->type(). "->is_valid should return false for $v" );
        $self->assert( ! $warning, "is_valid( '$v' ) had warnings: $warning" );
    }
    $self->{'spec'}->required( 0 );
    $self->assert_num_equals( 1, $self->{'spec'}->is_valid( undef ) );
}

package tests::ConfigFileSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::FileSpec;

sub type {
    return 'Lire::Config::FileSpec';
}

sub normalize_test_data {
    return (
            "/etc/passwd" => "/etc/passwd",
            "~/tmp" => "$ENV{'HOME'}/tmp",
           );
}

sub valid_test_data {
    return ( "/etc/passwd", __FILE__ );
}

sub invalid_test_data {
    return ( "~", "/no/such/file", "/dev/null" );
}

package tests::ConfigExecutableSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::ExecutableSpec;

sub set_up {
    my $self = $_[0];
    $self->SUPER::set_up();

    $self->{'old_PATH'} = $ENV{'PATH'};
    $ENV{'PATH'} = '/bin:/sbin';
}

sub tear_down {
    my $self = $_[0];
    $self->SUPER::tear_down();


    $ENV{'PATH'} = defined $self->{'old_PATH'} ? $self->{'old_PATH'} : '';
}

sub type {
    return 'Lire::Config::ExecutableSpec';
}

sub normalize_test_data {
    return (
            "sh" => "/bin/sh",
            "/bin/sh" => "/bin/sh",
            "echo" => "/bin/echo",
            "bin/echo" => "bin/echo",
            "/./bin/echo" => "/bin/echo",
           );
}

sub valid_test_data {
    return ( "sh", "/bin/sh", "/bin//cat" );
}

sub invalid_test_data {
    return ( "/bin/nosuchfile", "/etc", "/dev/null", "/etc/passwd" );
}

package tests::ConfigDirectorySpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::DirectorySpec;
use File::Basename;

sub type {
    return 'Lire::Config::DirectorySpec';
}

sub normalize_test_data {
    return (
            "/etc/passwd" => "/etc/passwd",
            "/bin/./../" => "/bin/..",
            "~" => "$ENV{'HOME'}",
           );
}

sub valid_test_data {
    return ( ".", "/bin", dirname( __FILE__ ) . "/../../" );
}

sub invalid_test_data {
    return ( "/bin/nosuchfile", __FILE__, "/dev/null", "/etc/passwd" );
}

package tests::ConfigListSpecTest;

use base qw/tests::ConfigCompoundSpecTest/;

use Lire::Config::ListSpec;

sub type {
    return 'Lire::Config::ListSpec';
}

package tests::ConfigConfigSpecTest;

use base qw/tests::ConfigTypeSpecBase/;

use Lire::Config::ConfigSpec;

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

    my $spec = $self->{'spec'};
    my $test1_spec = new Lire::Config::StringSpec( 'name' => 'test1',
                                                   'section' => 'section1' );
    my $test2_spec = new Lire::Config::StringSpec( 'name' => 'test2',
                                                   'section' => 'section2' );
    my $test3_spec = new Lire::Config::StringSpec( 'name' => 'test3',
                                                   'section' => 'section1' );
    $spec->add( $test1_spec );
    $spec->add( $test2_spec );
    $spec->add( $test3_spec );

    $self->assert_dies( qr/missing 'section' parameter/,
                        sub { $spec->components_by_section() } );
    $self->assert_deep_equals( [ $test1_spec, $test3_spec ],
                               $spec->components_by_section( 'section1' ) );
    $self->assert_deep_equals( [ $test2_spec ],
                               $spec->components_by_section( 'section2' ) );
    $self->assert_deep_equals( [],
                               $spec->components_by_section( 'section3' ) );
}

sub type {
    return 'Lire::Config::ConfigSpec';
}

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

    my $spec = $self->type()->new();
    $self->assert_isa( $self->type(), $spec );
}

package tests::ConfigStringSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::StringSpec;

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

    my $string = new Lire::Config::StringSpec( 'name' => 'valid-re',
                                               'valid-re' => '^\w+$' );
    $self->assert_str_equals( qr/^\w+$/, $string->{'_compiled_re'} );
    $self->assert_str_equals( '^\w+$', $string->valid_re() );
    $string->valid_re( undef );
    $self->assert_null( $string->{'_compiled_re'} );
    $self->assert_null( $string->{'_valid_re'} );

    $string->valid_re( '^\d+$' );
    $self->assert( $string->is_valid( 10 ), 'is_valid( 10 )' );
    $self->assert( ! $string->is_valid( 'abc' ), '!is_valid( "abc" )' );
}

sub type {
    return 'Lire::Config::StringSpec';
}

sub normalize_test_data {
    return ( 'test' => "test",
             "another string" => "another string",
           );
}

sub valid_test_data {
    return ( "test", "string", 10 );
}

sub invalid_test_data {
    return ();
}

package tests::ConfigIntegerSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::IntegerSpec;

sub type {
    return 'Lire::Config::IntegerSpec';
}

sub normalize_test_data {
    return (
            0 => 0,
            -1_100_200 => -1100200,
            1 => 1,
           );
}

sub valid_test_data {
    return ( 0, 1, -1, 1_200_300, -1_100, "-10", "-1_000_000" );
}

sub invalid_test_data {
    return ( 0.1, "two" );
}

package tests::ConfigBooleanSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::BooleanSpec;

sub type {
    return 'Lire::Config::BooleanSpec';
}

sub normalize_test_data {
    return (
            '' => '',
            '0' => '',
            '1' => 1,
            'enabled' => 1,
            'disabled' => '',
            'on' => 1,
            'off' => '',
            'Yes' => 1,
            'yes' => 1,
            'no' => '',
            'NO' => '',
            'F' => '',
            'FALSE' => '',
            'TRUE' => 1,
            't' => 1,
           );
}

sub valid_test_data {
    return ('', qw/0 1 enabled DISABLED Off oN Yes no True false t f/);
}

sub invalid_test_data {
    return qw/y n boolean/;
}

package tests::ConfigSelectSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::SelectSpec;

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

    $self->SUPER::set_up;

    $self->{'spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_1" ) );
    $self->{'spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_2" ) );
    $self->{'spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_3" ) );
}

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

sub normalize_test_data {
    return (
            'option_1' => "option_1",
            'option_2' => "option_2",
            'option_3' => "option_3",
            'option_4' => undef,
            'OPTION_1' => "option_1",
            'OpTiOn_2' => "option_2",
           );
}

sub valid_test_data {
    return qw/option_1 Option_2 OPTION_3 option_3 option_2/;
}

sub invalid_test_data {
    return qw/option_4/;
}

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

    my $select = new Lire::Config::SelectSpec( 'name' => "select" );
    $self->assert_equals( 0, scalar $select->options );

    my $option_1 = new Lire::Config::OptionSpec( 'name' => "option_1" );
    $select->add( $option_1 );
    $self->assert_deep_equals( [ $option_1 ], [ $select->options ] );

    my $option_2 = new Lire::Config::OptionSpec( 'name' => "option_2" );
    $select->add( $option_2 );
    $self->assert_deep_equals( [ sort ($option_1, $option_2) ],
                               [ sort $select->options ] );

    $self->assert_dies( qr/missing 'option' parameter/,
                        sub { $select->add( undef ) } );
#    $self->assert_dies( qr/already contains an option named 'option_1'/,
#                         sub { $select->add( new Lire::Config::OptionSpec( 'name' => "OPTION_1" ) ) },
# );

    $self->assert_dies( qr/\'option\' parameter should be a \'Lire::Config::OptionSpec\' instance, not \'Lire::Config::ListSpec/,
                      sub { $select->add( new Lire::Config::ListSpec( 'name' => "OPTION_1" ) ) } );
}

package tests::ConfigOptionSpecTest;

use base qw/tests::ConfigTypeSpecBase/;

use Lire::Config::OptionSpec;

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

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

    $self->assert_dies( qr/not implemented/,
                        sub { $self->{'spec'}->instance() });
}

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

    my $scalar = new Lire::Config::Scalar( 'spec' => new Lire::Config::ScalarSpec( name => "test" ) );
    $self->assert( !$self->{'spec'}->is_instance( $scalar ),
                   "is_instance() should return false" );
}

package tests::ConfigCommandSpecTest;

use base qw/tests::ConfigScalarSpecTest/;

use Lire::Config::CommandSpec;

use File::Basename;

sub set_up {
    my $self = $_[0];
    $self->SUPER::set_up();

    $self->{'old_PATH'} = $ENV{'PATH'};
    $ENV{'PATH'} = '/bin:/sbin';
}

sub tear_down {
    my $self = $_[0];
    $self->SUPER::tear_down();


    $ENV{'PATH'} = defined $self->{'old_PATH'} ? $self->{'old_PATH'} : '';
}

sub type {
    return 'Lire::Config::CommandSpec';
}

sub normalize_test_data {
    return (
            "//bin//sh" => "/bin/sh",
            "sh" => "/bin/sh",
           );
}

sub valid_test_data {
    return ( "sh", "/bin/sh", "ls", "cat" );
}

sub invalid_test_data {
    return ( "/bin/nosuchfile", __FILE__, "/dev/null" );
}

1;