The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use utf8;

use File::Spec;
use Test::More;

use DateTime::Locale;

my @locale_ids   = sort DateTime::Locale->ids();
my %locale_names = map { $_ => 1 } DateTime::Locale->names;
my %locale_ids   = map { $_ => 1 } DateTime::Locale->ids;

plan tests =>
      5                               # starting
    + 1                               # one test for root locale
    + ( ( @locale_ids - 1 ) * 21 )    # tests for each other local
    + 56                              # check_root
    + 24                              # check_en
    + 66                              # check_en_GB
    + 23                              # check_en_US
    + 11                              # check_es_ES
    + 5                               # check_en_US_POSIX
    + 2                               # check_af
    + 3                               # check_C_locales
    + 9                               # check_DT_Lang
    ;

{
    ok( @locale_ids >= 240,     'Coverage looks complete' );
    ok( $locale_names{English}, "Locale name 'English' found" );
    ok( $locale_ids{ar_JO},     "Locale id 'ar_JO' found" );

    eval { DateTime::Locale->load('Does not exist') };
    like( $@, qr/invalid/i,
        'invalid locale name/id to load() causes an error' );

    # this type of locale id should work
    my $l = DateTime::Locale->load('en_US.LATIN-1');
    is( $l->id, 'en_US', 'id is en_US' );
}

# testing the basics for all ids
{
    for my $locale_id (@locale_ids) {
        my $locale = eval { DateTime::Locale->load($locale_id) };

        isa_ok( $locale, 'DateTime::Locale::Base' );

        next if $locale_id eq 'root';

        ok( $locale_ids{ $locale->id() },
            "'$locale_id':  Has a valid locale id" );

        ok( length $locale->name(), "'$locale_id':  Has a locale name" );
        ok(
            length $locale->native_name(),
            "'$locale_id':  Has a native locale name"
        );

        for my $test (
            {
                locale_method => 'month_format_wide',
                count         => 12,
            }, {
                locale_method => 'month_format_abbreviated',
                count         => 12,
            }, {
                locale_method => 'day_format_wide',
                count         => 7,
            }, {
                locale_method => 'day_format_abbreviated',
                count         => 7,
            }, {
                locale_method => 'quarter_format_wide',
                count         => 4,
            }, {
                locale_method => 'quarter_format_abbreviated',
                count         => 4,
            }, {
                locale_method => 'am_pm_abbreviated',
                count         => 2,
            }, {
                locale_method => 'era_wide',
                count         => 2,
            }, {
                locale_method => 'era_abbreviated',
                count         => 2,
            },
            ) {
            check_array( locale => $locale, %$test );
        }

        # We can't actually expect these to be unique.
        is( scalar @{ $locale->day_format_narrow() }, 7,
            'day_format_narrow() returns 7 items' );
        is( scalar @{ $locale->month_format_narrow() }, 12,
            'month_format_narrow() returns 12 items' );
        is( scalar @{ $locale->day_stand_alone_narrow() }, 7,
            'day_stand_alone_narrow() returns 7 items' );
        is( scalar @{ $locale->month_stand_alone_narrow() }, 12,
            'month_stand_alone_narrow() returns 12 items' );

        check_formats( $locale_id, $locale, 'date_formats', 'date_format' );
        check_formats( $locale_id, $locale, 'time_formats', 'time_format' );
    }
}

check_root();
check_en();
check_en_GB();
check_en_US();
check_es_ES();
check_en_US_POSIX();
check_af();
check_C_locales();
check_DT_Lang();

sub check_array {
    my %test = @_;

    my $locale_method = $test{locale_method};

    my %unique = map { $_ => 1 } @{ $test{locale}->$locale_method() };

    my $locale_id = $test{locale}->id();

TODO:
    {
        local $TODO
            = 'The ii locale does not have unique abbreviated days for some reason'
            if $test{locale}->id() =~ /^ii/
                && $locale_method eq 'day_format_abbreviated';

        is(
            keys %unique, $test{count},
            qq{'$locale_id': '$locale_method' contains $test{count} unique items}
        );
    }
}

sub check_formats {
    my ( $locale_id, $locale, $hash_func, $item_func ) = @_;

    my %unique = map { $_ => 1 } values %{ $locale->$hash_func() };

    ok( keys %unique >= 1,
        "'$locale_id': '$hash_func' contains at least 1 unique item" );

    foreach my $length (qw( full long medium short )) {
        my $method = $item_func . q{_} . $length;

        my $val = $locale->$method();

        if ( defined $val ) {
            delete $unique{$val};
        }
        else {
            Test::More::diag("$locale_id returned undef for $method()");
        }
    }

    is(
        keys %unique, 0,
        "'$locale_id':  Data returned by '$hash_func' and '$item_func patterns' matches"
    );
}

sub check_root {
    my $locale = DateTime::Locale->load('root');

    my %tests = (
        day_format_wide => [qw( 2 3 4 5 6 7 1 )],

        day_format_abbreviated => [qw( 2 3 4 5 6 7 1 )],

        day_format_narrow => [qw( 2 3 4 5 6 7 1 )],

        day_stand_alone_wide => [qw( 2 3 4 5 6 7 1 )],

        day_stand_alone_abbreviated => [qw( 2 3 4 5 6 7 1 )],

        day_stand_alone_narrow => [qw( 2 3 4 5 6 7 1 )],

        month_format_wide => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],

        month_format_abbreviated => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],

        month_format_narrow => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],

        month_stand_alone_wide => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],

        month_stand_alone_abbreviated => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],

        month_stand_alone_narrow => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],

        quarter_format_wide => [qw( Q1 Q2 Q3 Q4 )],

        quarter_format_abbreviated => [qw( Q1 Q2 Q3 Q4 )],

        quarter_format_narrow => [qw( 1 2 3 4 )],

        quarter_stand_alone_wide => [qw( Q1 Q2 Q3 Q4 )],

        quarter_stand_alone_abbreviated => [qw( Q1 Q2 Q3 Q4 )],

        quarter_stand_alone_narrow => [qw( 1 2 3 4 )],

        era_wide => [qw( BCE CE )],

        era_abbreviated => [qw( BCE CE )],

        era_narrow => [qw( BCE CE )],

        am_pm_abbreviated => [qw( AM PM )],

        datetime_format_full   => 'EEEE, y MMMM dd HH:mm:ss zzzz',
        datetime_format_long   => 'y MMMM d HH:mm:ss z',
        datetime_format_medium => 'y MMM d HH:mm:ss',
        datetime_format_short  => 'yyyy-MM-dd HH:mm',

        datetime_format_default => 'y MMM d HH:mm:ss',

        glibc_datetime_format => '%a %b %e %H:%M:%S %Y',
        glibc_date_format     => '%m/%d/%y',
        glibc_time_format     => '%H:%M:%S',

        first_day_of_week => 1,

        prefers_24_hour_time => 1,
    );

    test_data( $locale, %tests );

    my %formats = (
        d      => 'd',
        EEEd   => 'd EEE',
        hm     => 'h:mm a',
        Hm     => 'H:mm',
        hms    => 'h:mm:ss a',
        Hms    => 'H:mm:ss',
        M      => 'L',
        Md     => 'M-d',
        MEd    => 'E, M-d',
        MMM    => 'LLL',
        MMMd   => 'MMM d',
        MMMEd  => 'E MMM d',
        MMMMd  => 'MMMM d',
        MMMMEd => 'E MMMM d',
        ms     => 'mm:ss',
        y      => 'y',
        yM     => 'y-M',
        yMEd   => 'EEE, y-M-d',
        yMMM   => 'y MMM',
        yMMMEd => 'EEE, y MMM d',
        yMMMM  => 'y MMMM',
        yQ     => 'y Q',
        yQQQ   => 'y QQQ',
    );

    test_formats( $locale, %formats );
}

sub check_en {
    my $locale = DateTime::Locale->load('en');

    my %tests = (
        en_data(),

        name => 'English',
    );

    test_data( $locale, %tests );
}

sub check_en_GB {
    my $locale = DateTime::Locale->load('en_GB');

    my %tests = (
        en_data(),

        first_day_of_week => 7,

        name             => 'English United Kingdom',
        native_name      => 'English United Kingdom',
        language         => 'English',
        native_language  => 'English',
        territory        => 'United Kingdom',
        native_territory => 'United Kingdom',
        variant          => undef,
        native_variant   => undef,

        language_id  => 'en',
        territory_id => 'GB',
        variant_id   => undef,

        glibc_datetime_format => '%a %d %b %Y %T %Z',
        glibc_date_format     => '%d/%m/%y',
        glibc_time_format     => '%T',

        datetime_format_default => 'd MMM y HH:mm:ss',
    );

    test_data( $locale, %tests );

    my %formats = (
        Md       => 'd/M',
        MEd      => 'E, d/M',
        MMdd     => 'dd/MM',
        MMMEd    => 'E d MMM',
        MMMMd    => 'd MMMM',
        yMEd     => 'EEE, d/M/yyyy',
        yyMMM    => 'MMM yy',
        yyyyMM   => 'MM/yyyy',
        yyyyMMMM => 'MMMM y',

        # from en
        d      => 'd',
        EEEd   => 'd EEE',
        hm     => 'h:mm a',
        Hm     => 'H:mm',
        Hms    => 'H:mm:ss',
        M      => 'L',
        MMM    => 'LLL',
        MMMd   => 'MMM d',
        MMMMEd => 'E, MMMM d',
        ms     => 'mm:ss',
        y      => 'y',
        yM     => 'M/yyyy',
        yMMM   => 'MMM y',
        yMMMEd => 'EEE, MMM d, y',
        yMMMM  => 'MMMM y',
        yQ     => 'Q yyyy',
        yQQQ   => 'QQQ y',

        # from root
        hms => 'h:mm:ss a',
    );

    test_formats( $locale, %formats );
}

sub check_en_US {
    my $locale = DateTime::Locale->load('en_US');

    my %tests = (
        en_data(),

        first_day_of_week => 7,
    );

    test_data( $locale, %tests );
}

sub en_data {
    return (
        day_format_wide =>
            [qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday )],

        day_format_abbreviated => [qw( Mon Tue Wed Thu Fri Sat Sun )],

        day_format_narrow => [qw( M T W T F S S )],

        day_stand_alone_wide =>
            [qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday )],

        day_stand_alone_abbreviated => [qw( Mon Tue Wed Thu Fri Sat Sun )],

        day_stand_alone_narrow => [qw( M T W T F S S )],

        month_format_wide => [
            qw( January February March April May June
                July August September October November December )
        ],

        month_format_abbreviated =>
            [qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )],

        month_format_narrow => [qw( J F M A M J J A S O N D )],

        month_stand_alone_wide => [
            qw( January February March April May June
                July August September October November December )
        ],

        month_stand_alone_abbreviated =>
            [qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )],

        month_stand_alone_narrow => [qw( J F M A M J J A S O N D )],

        quarter_format_wide =>
            [ '1st quarter', '2nd quarter', '3rd quarter', '4th quarter' ],

        quarter_format_abbreviated => [qw( Q1 Q2 Q3 Q4 )],

        quarter_format_narrow => [qw( 1 2 3 4 )],

        quarter_stand_alone_wide =>
            [ '1st quarter', '2nd quarter', '3rd quarter', '4th quarter' ],

        quarter_stand_alone_abbreviated => [qw( Q1 Q2 Q3 Q4 )],

        quarter_stand_alone_narrow => [qw( 1 2 3 4 )],

        era_wide => [ 'Before Christ', 'Anno Domini' ],

        era_abbreviated => [qw( BC AD )],

        era_narrow => [qw( B A )],

        am_pm_abbreviated => [qw( AM PM )],

        first_day_of_week => 1,
    );
}

sub test_data {
    my $locale = shift;
    my %tests  = @_;

    for my $k ( sort keys %tests ) {
        my $desc = "$k for " . $locale->id();
        if ( ref $tests{$k} ) {
            is_deeply( $locale->$k(), $tests{$k}, $desc );
        }
        else {
            is( $locale->$k(), $tests{$k}, $desc );
        }
    }
}

sub test_formats {
    my $locale  = shift;
    my %formats = @_;

    for my $name ( keys %formats ) {
        is(
            $locale->format_for($name), $formats{$name},
            "Format for $name with " . $locale->id()
        );
    }

    is_deeply(
        [ $locale->available_formats() ],
        [ sort keys %formats ],
        "Available formats for " . $locale->id() . " match what is expected"
    );
}

sub check_es_ES {
    my $locale = DateTime::Locale->load('es_ES');

    is( $locale->name(),            'Spanish Spain',    'name()' );
    is( $locale->native_name(),     'español España', 'native_name()' );
    is( $locale->language(),        'Spanish',          'language()' );
    is( $locale->native_language(), 'español',         'native_language()' );
    is( $locale->territory(),       'Spain',            'territory()' );
    is( $locale->native_territory(), 'España', 'native_territory()' );
    is( $locale->variant(),          undef,     'variant()' );
    is( $locale->native_variant(),   undef,     'native_variant()' );

    is( $locale->language_id(),  'es',  'language_id()' );
    is( $locale->territory_id(), 'ES',  'territory_id()' );
    is( $locale->variant_id(),   undef, 'variant_id()' );
}

sub check_af {
    my $locale = DateTime::Locale->load('af');

    is_deeply(
        $locale->month_format_abbreviated(),
        [qw( Jan Feb Mar Apr Mei Jun Jul Aug Sep Okt Nov Des )],
        'month abbreviations for af use non-draft form'
    );

    is_deeply(
        $locale->month_format_narrow(),
        [ 1 .. 12 ],
        'month narrows for af use draft form because that is the only form available'
    );
}

sub check_en_US_POSIX {
    my $locale = DateTime::Locale->load('en_US_POSIX');

    is( $locale->variant(),        'Computer', 'variant()' );
    is( $locale->native_variant(), 'Computer', 'native_variant()' );

    is( $locale->language_id(),  'en',    'language_id()' );
    is( $locale->territory_id(), 'US',    'territory_id()' );
    is( $locale->variant_id(),   'POSIX', 'variant_id()' );
}

sub check_C_locales {
    for my $id (qw( C C.ISO-8859-1 C.UTF-8 )) {
        my $locale = DateTime::Locale->load($id);
        is( $locale->id(), 'C', "$id is accepted as a locale id" );
    }
}

sub check_DT_Lang {
    foreach my $old (
        qw ( Austrian TigrinyaEthiopian TigrinyaEritrean
        Brazilian Portuguese
        Afar Sidama Tigre )
        ) {
        ok( DateTime::Locale->load($old),
            "backwards compatibility for $old" );
    }

    foreach my $old (qw ( Gedeo )) {
    SKIP:
        {
            skip
                'No CLDR XML data for some African languages included in DT::Language',
                1
                unless $locale_names{$old};

            ok( DateTime::Locale->load($old),
                "backwards compatibility for $old" );
        }
    }
}