#!/usr/bin/perl

use strict;
use warnings;

use 5.006;

use lib './lib', 'tools/lib';

use Data::Dumper;
use File::Copy qw( copy );
use File::Find::Rule;
use Getopt::Long;
use LDML;
use Lingua::EN::Inflect qw( PL_N );
use Path::Class;

my $VERSION = '0.05';

my $ScriptName = file($0)->basename();

my %opts;
sub main
{
    GetOptions( 'dir:s'   => \$opts{dir},
                'file:s'  => \$opts{file},
                'clean'   => \$opts{clean},
                'quiet'   => \$opts{quiet},
                'verbose' => \$opts{verbose},
                'help'    => \$opts{help},
              );

    $opts{help} = 1
        unless defined $opts{dir} && -d $opts{dir};

    usage() if $opts{help};

    clean() if $opts{clean};

    binmode STDOUT, ':utf8' if $opts{verbose};
    $| = 1;

    generate_from_cldr_xml();
}

sub usage
{
    print <<'EOF';

This script parses the CLDR locale files and turns them into a set of
Perl modules.  It also generates the MANIFEST file.

It takes the following arguments:

  --dir      A directory containing CLDR XML files.  Required.

  --file     Parse just the file with the given name.  For debugging.

  --clean    Remove old generated modules (which may not be valid with
             the latest CLDR data).

  --quiet    Don't display any output while processing files.

  --verbose  Spew lots of output while processing.

  --help     What you are reading

If the --file or --name options are specified, the MANIFEST will not
be generated.

EOF

    exit;
}

sub clean
{
    for my $f ( File::Find::Rule
                ->file
                ->name('*.pm')
                ->grep('This file is auto-generated' )
                ->in('lib')
              )
    {
        unlink $f or die "Cannot unlink $f: $!";
    }
}

sub generate_from_cldr_xml
{
    my @ldml = read_all_files();
    generate_pm_files(@ldml);
    generate_catalog(@ldml);
    generate_pm_file_pod($_) for @ldml;

    print "\nAll done\n" unless $opts{quiet};
}

sub read_all_files
{
    my $dir = dir( $opts{dir} );

    my @ldml;
    while ( my $file = $dir->next() )
    {
        next unless -f $file;
        next unless $file->basename() =~ /\.xml$/;
        next if $opts{file} && $opts{file} ne $file->basename();

        print "Reading $file\n" if $opts{verbose};

        my $ldml = LDML->new_from_file($file);

        # Any locale without this cannot be registered by
        # DateTime::Locale.
        next unless defined $ldml->en_language();

        push @ldml, $ldml;
    }

    return sort { $a->id() cmp $b->id() } @ldml;
}

sub generate_pm_files
{
    my @ldml = @_;

    print "\nGenerating PM files\n" if $opts{verbose};

    for my $ldml ( sort @ldml )
    {
        if ( $opts{verbose} )
        {
            print sprintf( <<"EOF", $ldml->id(), $ldml->parent_id(), $ldml->version(), $ldml->generation_date() );
  %s
    parent_id:       %s
    version:         %s
    generation date: %s

EOF
        }

        generate_pm_file($ldml);
    }
}

sub generate_pm_file
{
    my $ldml = shift;

    my $pm_file = file( qw( lib DateTime Locale ), $ldml->id() . q{.pm} );
    write_to_manifest($pm_file);

    open my $fh, '>:utf8', $pm_file
        or die "Cannot write to $pm_file: $!";

    write_pm_header( $fh, $ldml );
    write_pm_inheritance( $fh, $ldml );
    write_pm_subs( $fh, $ldml );
    write_pm_footer( $fh, $ldml );
}

sub write_pm_header
{
    my $fh   = shift;
    my $ldml = shift;

    my $source_file = $ldml->source_file()->basename();
    my $version     = $ldml->version();
    my $date        = $ldml->generation_date();
    my $id          = $ldml->id();

    print {$fh} <<"EOF" or die "print failed: $!";
###########################################################################
#
# This file is auto-generated by the Perl DateTime Suite locale
# generator ($VERSION).  This code generator comes with the
# DateTime::Locale distribution in the tools/ directory, and is called
# $ScriptName.
#
# This file as generated from the CLDR XML locale data.  See the
# LICENSE.cldr file included in this distribution for license details.
#
# This file was generated from the source file $source_file
# The source file version number was $version, generated on
# $date.
#
# Do not edit this file directly.
#
###########################################################################

package DateTime::Locale::$id;

use strict;
use warnings;
use utf8;

EOF
}

sub write_pm_inheritance
{
    my $fh   = shift;
    my $ldml = shift;

    my $parent = $ldml->parent_id();

    print {$fh} "use base 'DateTime::Locale::$parent';\n\n";
}

sub write_pm_subs
{
    my $fh   = shift;
    my $ldml = shift;

    foreach my $attr ( sort { $a->name() cmp $b->name() }
                       LDML->meta()->compute_all_applicable_attributes() )
    {
        next unless $attr->name() =~
            /^(?:day_|month_|quarter_|am_pm|era_|date_|time_|datetime_|first_day_)/;

        next if make_alias( $fh, $ldml, $attr->name() );

        my $type = $attr->type_constraint();

        if ( $type->is_a_type_of('ArrayRef') )
        {
            write_arrayref_sub( $fh, $ldml, $attr->name() );
        }
        elsif ( $type->is_a_type_of('HashRef') )
        {
            write_hashref_sub( $fh, $ldml, $attr->name() );
        }
        elsif ( $type->is_a_type_of('Str') )
        {
            write_string_sub( $fh, $ldml, $attr->name() );
        }
        elsif ( $type->is_a_type_of('Int') )
        {
            write_int_sub( $fh, $ldml, $attr->name() );
        }
        else
        {
            die "Cannot handle type: " . $type->name();
        }
    }

    for my $attr ( qw( default_date_format_length default_time_format_length ) )
    {
        my $def = $ldml->$attr();
        next unless defined $def;

        print {$fh} string_sub( q{_} . $attr, , $def );
    }

    write_available_format_subs( $fh, $ldml );
}

sub make_alias
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    if ( $name =~ /stand_alone/ )
    {
        return make_stand_alone_alias( $fh, $ldml, $name );
    }
    elsif ( $name =~ /(?:abbreviated|narrow)/ )
    {
        return make_length_alias( $fh, $ldml, $name );
    }

}

sub make_stand_alone_alias
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    ( my $format = $name ) =~ s/stand_alone/format/;

    return maybe_make_alias( $fh, $ldml, $name, $format );
}

sub make_length_alias
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    # This isn't well documented (or really documented at all) in the
    # LDML spec, but the example seem to suggest that for the narrow
    # form, the format type should "inherit" from the stand-alone
    # type if possible, rather than the abbreviated type.
    #
    # See
    # http://www.unicode.org/cldr/data/charts/by_type/calendar-gregorian.day.html
    # for examples of the expected output. Note that the format narrow
    # days for English are inherited from its stand-alone narrow form,
    # not the root locale.
    if ( $name =~ /format_narrow/ )
    {
        ( my $to_name = $name ) =~ s/format/stand_alone/;

        return 1
            if maybe_make_alias( $fh, $ldml, $name, $to_name );
    }

    # It seems like the quarters should just inherit up the (Perl)
    # inheritance chain, rather than from the next biggest size. See
    # http://www.unicode.org/cldr/data/charts/by_type/calendar-gregorian.quarter.html
    # for an example. Note that the English format narrow quarter is
    # "1", not "Q1".
    if ( $name =~ /quarter_(\w+)_narrow/ )
    {
        return;
    }

    ( my $to_name = $name );
    $to_name =~ s/abbreviated/wide/;
    $to_name =~ s/narrow/abbreviated/;

    return maybe_make_alias( $fh, $ldml, $name, $to_name );
}

sub maybe_make_alias
{
    my $fh   = shift;
    my $ldml = shift;
    my $from = shift;
    my $to   = shift;

    my $val = $ldml->$from();

    return if @{ $val };

    return unless $ldml->can($to);

    my $to_val = $ldml->$to();

    return unless @{ $to_val };

    write_alias_sub( $fh, $from, $to );

    return 1;
}

sub write_alias_sub
{
    my $fh   = shift;
    my $from = shift;
    my $to   = shift;

    print {$fh} <<"EOF";

sub $from { \$_[0]->$to() }

EOF
}

sub write_arrayref_sub
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    my $arr = $ldml->$name();

    return unless @{ $arr };

    print {$fh} arrayref_sub( $name, $arr );
}

sub arrayref_sub
{
    my $name = shift;
    my $arr  = shift;

    my $val = join ', ', map { q{"} . quotemeta($_) . q{"} } @{ $arr };

    return <<"EOF";
{
    my \$$name = [ $val ];
    sub $name { return \$$name }
}
EOF
}

sub write_hashref_sub
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    my $hash = $ldml->$name();

    return unless keys %{ $hash };

    print {$fh} hashref_sub( $name, $hash );
}

sub hashref_sub
{
    my $name = shift;
    my $hash = shift;

    my $val = ( join ",\n",
                map { q{          "} . quotemeta($_) . q{" => "} . quotemeta( $hash->{$_} ). q{"} }
                sort keys %{ $hash }
              );

    return <<"EOF";
{
    my \$$name =
        {
$val
        };
    sub $name { return \$$name }
}

EOF
}

sub write_string_sub
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    my $str = $ldml->$name();

    return unless defined $str;

    print {$fh} string_sub( $name, $str );
}

sub string_sub
{
    my $name = shift;
    my $str  = shift;

    my $val = quotemeta $str;

    return <<"EOF";
{
    my \$$name = "$val";
    sub $name { return \$$name }
}

EOF
}

sub write_int_sub
{
    my $fh   = shift;
    my $ldml = shift;
    my $name = shift;

    my $int = $ldml->$name();

    return unless defined $int;

    print {$fh} int_sub( $name, $int );
}

sub int_sub
{
    my $name = shift;
    my $int  = shift;

    return <<"EOF";
{
    my \$$name = $int;
    sub $name { return \$$name }
}

EOF
}

sub write_available_format_subs
{
    my $fh   = shift;
    my $ldml = shift;

    my $formats = $ldml->available_formats();

    return unless keys %{ $formats };

    for my $format ( sort keys %{ $formats } )
    {
        my $sub_name = '_format_for_' . $format;

        print {$fh} string_sub( $sub_name, $formats->{$format} );
    }

    my $avail = join ', ', map { q{"} . quotemeta($_) . q{"} } keys %{ $formats };

    print {$fh} hashref_sub( '_available_formats', $formats );
}

sub write_pm_footer
{
    my $fh   = shift;
    my $ldml = shift;

    print {$fh} <<'EOF';
1;

__END__

EOF
}

sub generate_catalog
{
    my @ldml = @_;

    my $file = file( qw( lib DateTime Locale Catalog.pm ) );

    open my $fh, '>:utf8', $file
        or die "Cannot write to $file: $!";

    generate_catalog_code( $fh, \@ldml );
    generate_catalog_pod( $fh, \@ldml );
}

sub generate_catalog_code
{
    my $fh   = shift;
    my $ldml = shift;

    print {$fh} <<"EOF";
###########################################################################
#
# This file is auto-generated by the Perl DateTime Suite time locale
# generator ($VERSION).  This code generator comes with the
# DateTime::Locale distribution in the tools/ directory, and is called
# $ScriptName.
#
# This file as generated from the CLDR XML locale data.  See the
# LICENSE.cldr file included in this distribution for license details.
#
# Do not edit this file directly.
#
###########################################################################

package DateTime::Locale::Catalog;

use strict;
use warnings;
use utf8;

my \@Locales;
sub Locales { return \@Locales }

my \%Aliases;
sub Aliases { return \%Aliases }

EOF

    print {$fh} '@Locales = (', "\n";

    for my $l ( @{ $ldml } )
    {
        print {$fh} catalog_data_for_locale($l);
    }

    print {$fh} q{);};
    print {$fh} "\n\n";

    print {$fh} catalog_data_for_aliases($ldml);

    print {$fh} <<'EOF';

1;

__END__

EOF
}

sub catalog_data_for_locale
{
    my $ldml = shift;

    my $data = qq[    {\n];

    foreach my $k ( qw( id
                        en_language en_script en_territory en_variant
                        native_language native_script native_territory native_variant
                     )
                  )
    {
        my $val = $ldml->$k();
        next unless defined $val;

        $data .= sprintf ( q{      %-16s => "}, $k );
        $data .= quotemeta($val);
        $data .= q{",} . "\n";
    }

    $data .= qq[    },\n];

    return $data;
}

sub catalog_data_for_aliases
{
    my $ldml = shift;

    my %aliases = valid_aliases($ldml);

    my $code = '%Aliases = (' . "\n";

    for my $id ( sort keys %aliases )
    {
        $code .= qq{    $id => "} . quotemeta( $aliases{$id} ) . qq{",\n};
    }

    $code .= ");\n";

    return $code;
}

sub generate_catalog_pod
{
    my $fh   = shift;
    my $ldml = shift;

    my $locales_in_pod = '';

    for my $ldml ( @{ $ldml } )
    {
        my @pieces =
            join ' ', grep { defined } map { $ldml->$_() } qw( en_language en_territory en_variant );

        my $script = $ldml->en_script();
        push @pieces, "($script)" if defined $script;

        $locales_in_pod .= sprintf( " %-18s  %s\n", $ldml->id(), join ' ', @pieces );
    }

    my %aliases = valid_aliases($ldml);

    my $aliases_in_pod = '';
    foreach my $id ( sort keys %aliases )
    {
        $aliases_in_pod .= sprintf( " %-18s  %s\n", $id, $aliases{$id} );
    }

    print {$fh} <<"EOF";
=head1 NAME

DateTime::Locale::Catalog - Provides a list of all valid locale names

=head1 SYNOPSIS

See DateTime::Locale for usage details.

=head1 DESCRIPTION

This module contains a list of all known locales.

=head1 LOCALES

Any method taking locale id or name arguments should use one of the
values listed below. Ids and names are case sensitive.

Always select the closest matching locale - for example, French
Canadians would choose fr_CA over fr - and B<always> use locale ids in
preference to names; locale ids offer greater compatibility when using
localized third party modules.

The available locales are:

 Locale id           Locale name
 ==================================================
$locales_in_pod

There are also many aliases available, mostly for three-letter
language codes, these are:

 Locale id           Is an alias for
 ==================================================
$aliases_in_pod

=head1 SUPPORT

See L<DateTime::Locale>.

=head1 AUTHOR

Dave Rolsky <autarch\@urth.org>

=head1 COPYRIGHT

Copyright (c) 2008 David Rolsky. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

This module was generated from data provided by the CLDR project, see
the LICENSE.cldr in this distribution for details on the CLDR data's
license.

=cut
EOF
}

{
    my %aliases;

    sub valid_aliases
    {
        return %aliases if keys %aliases;

        my $ldml = shift;

        my %ids = map { $_->id() => 1 } @{ $ldml };

        %aliases = iso639_2_aliases();

        for my $k ( keys %aliases )
        {
            delete $aliases{$k}
                unless $ids{ $aliases{$k} };

            delete $aliases{$k}
                if $ids{$k};
        }

        return %aliases;
    }
}

sub iso639_2_aliases
{
    return ( 'afr'                  => 'af',
             'afr_ZA'               => 'af_ZA',
             'alb'                  => 'sq',
             'alb_AL'               => 'sq_AL',
             'amh'                  => 'am',
             'amh_ET'               => 'am_ET',
             'ara'                  => 'ar',
             'ara_AE'               => 'ar_AE',
             'ara_BH'               => 'ar_BH',
             'ara_DZ'               => 'ar_DZ',
             'ara_EG'               => 'ar_EG',
             'ara_IN'               => 'ar_IN',
             'ara_IQ'               => 'ar_IQ',
             'ara_JO'               => 'ar_JO',
             'ara_KW'               => 'ar_KW',
             'ara_LB'               => 'ar_LB',
             'ara_LY'               => 'ar_LY',
             'ara_MA'               => 'ar_MA',
             'ara_OM'               => 'ar_OM',
             'ara_QA'               => 'ar_QA',
             'ara_SA'               => 'ar_SA',
             'ara_SD'               => 'ar_SD',
             'ara_SY'               => 'ar_SY',
             'ara_TN'               => 'ar_TN',
             'ara_YE'               => 'ar_YE',
             'arm'                  => 'hy',
             'arm_AM'               => 'hy_AM',
             'arm_AM_REVISED'       => 'hy_AM_REVISED',
             'aze'                  => 'az',
             'aze_AZ'               => 'az_AZ',
             'baq'                  => 'eu',
             'baq_ES'               => 'eu_ES',
             'baq_ES_PREEURO'       => 'eu_ES',
             'bel'                  => 'be',
             'bel_BY'               => 'be_BY',
             'ben'                  => 'bn',
             'ben_IN'               => 'bn_IN',
             'bul'                  => 'bg',
             'bul_BG'               => 'bg_BG',
             'cat'                  => 'ca',
             'cat_ES'               => 'ca_ES',
             'cat_ES_PREEURO'       => 'ca_ES',
             'ces'                  => 'cs',
             'ces_CZ'               => 'cs_CZ',
             'chi'                  => 'zh',
             'chi_CN'               => 'zh_CN',
             'chi_HK'               => 'zh_HK',
             'chi_MO'               => 'zh_MO',
             'chi_SG'               => 'zh_SG',
             'chi_TW'               => 'zh_TW',
             'chi_TW_STROKE'        => 'zh_TW',
             'cor'                  => 'kw',
             'cor_GB'               => 'kw_GB',
             'cze'                  => 'cs',
             'cze_CZ'               => 'cs_CZ',
             'dan'                  => 'da',
             'dan_DK'               => 'da_DK',
             'deu'                  => 'de',
             'deu_AT'               => 'de_AT',
             'deu_AT_PREEURO'       => 'de_AT',
             'deu_BE'               => 'de_BE',
             'deu_CH'               => 'de_CH',
             'deu_DE'               => 'de_DE',
             'deu_DE_PREEURO'       => 'de_DE',
             'deu_LI'               => 'de_LI',
             'deu_LU'               => 'de_LU',
             'deu_LU_PREEURO'       => 'de_LU',
             'dut'                  => 'nl',
             'dut_BE'               => 'nl_BE',
             'dut_BE_PREEURO'       => 'nl_BE',
             'dut_NL'               => 'nl_NL',
             'dut_NL_PREEURO'       => 'nl_NL',
             'ell'                  => 'el',
             'ell_GR'               => 'el_GR',
             'ell_GR_PREEURO'       => 'el_GR',
             'eng'                  => 'en',
             'eng_AS'               => 'en_AS',
             'eng_AU'               => 'en_AU',
             'eng_BE'               => 'en_BE',
             'eng_BE_PREEURO'       => 'en_BE',
             'eng_BW'               => 'en_BW',
             'eng_BZ'               => 'en_BZ',
             'eng_CA'               => 'en_CA',
             'eng_GB'               => 'en_GB',
             'eng_GB_EURO'          => 'en_GB',
             'eng_GU'               => 'en_GU',
             'eng_HK'               => 'en_HK',
             'eng_IE'               => 'en_IE',
             'eng_IE_PREEURO'       => 'en_IE',
             'eng_IN'               => 'en_IN',
             'eng_JM'               => 'en_JM',
             'eng_MH'               => 'en_MH',
             'eng_MP'               => 'en_MP',
             'eng_MT'               => 'en_MT',
             'eng_NZ'               => 'en_NZ',
             'eng_PH'               => 'en_PH',
             'eng_SG'               => 'en_SG',
             'eng_TT'               => 'en_TT',
             'eng_UM'               => 'en_UM',
             'eng_US'               => 'en_US',
             'eng_US_POSIX'         => 'en_US_POSIX',
             'eng_VI'               => 'en_VI',
             'eng_ZA'               => 'en_ZA',
             'eng_ZW'               => 'en_ZW',
             'epo'                  => 'eo',
             'est'                  => 'et',
             'est_EE'               => 'et_EE',
             'eus'                  => 'eu',
             'eus_ES'               => 'eu_ES',
             'eus_ES_PREEURO'       => 'eu_ES',
             'fao'                  => 'fo',
             'fao_FO'               => 'fo_FO',
             'fas'                  => 'fa',
             'fas_IR'               => 'fa_IR',
             'fin'                  => 'fi',
             'fin_FI'               => 'fi_FI',
             'fin_FI_PREEURO'       => 'fi_FI',
             'fra'                  => 'fr',
             'fra_BE'               => 'fr_BE',
             'fra_BE_PREEURO'       => 'fr_BE',
             'fra_CA'               => 'fr_CA',
             'fra_CH'               => 'fr_CH',
             'fra_FR'               => 'fr_FR',
             'fra_FR_PREEURO'       => 'fr_FR',
             'fra_LU'               => 'fr_LU',
             'fra_LU_PREEURO'       => 'fr_LU',
             'fra_MC'               => 'fr_MC',
             'fre'                  => 'fr',
             'fre_BE'               => 'fr_BE',
             'fre_BE_PREEURO'       => 'fr_BE',
             'fre_CA'               => 'fr_CA',
             'fre_CH'               => 'fr_CH',
             'fre_FR'               => 'fr_FR',
             'fre_FR_PREEURO'       => 'fr_FR',
             'fre_LU'               => 'fr_LU',
             'fre_LU_PREEURO'       => 'fr_LU',
             'fre_MC'               => 'fr_MC',
             'geo'                  => 'ka',
             'geo_GE'               => 'ka_GE',
             'ger'                  => 'de',
             'ger_AT'               => 'de_AT',
             'ger_AT_PREEURO'       => 'de_AT',
             'ger_BE'               => 'de_BE',
             'ger_CH'               => 'de_CH',
             'ger_DE'               => 'de_DE',
             'ger_DE_PREEURO'       => 'de_DE',
             'ger_LI'               => 'de_LI',
             'ger_LU'               => 'de_LU',
             'ger_LU_PREEURO'       => 'de_LU',
             'gle'                  => 'ga',
             'gle_IE'               => 'ga_IE',
             'gle_IE_PREEURO'       => 'ga_IE',
             'glg'                  => 'gl',
             'glg_ES'               => 'gl_ES',
             'glg_ES_PREEURO'       => 'gl_ES',
             'glv'                  => 'gv',
             'glv_GB'               => 'gv_GB',
             'gre'                  => 'el',
             'gre_GR'               => 'el_GR',
             'gre_GR_PREEURO'       => 'el_GR',
             'guj'                  => 'gu',
             'guj_IN'               => 'gu_IN',
             'heb'                  => 'he',
             'heb_IL'               => 'he_IL',
             'hin'                  => 'hi',
             'hin_IN'               => 'hi_IN',
             'hrv'                  => 'hr',
             'hrv_HR'               => 'hr_HR',
             'hun'                  => 'hu',
             'hun_HU'               => 'hu_HU',
             'hye'                  => 'hy',
             'hye_AM'               => 'hy_AM',
             'hye_AM_REVISED'       => 'hy_AM_REVISED',
             'ice'                  => 'is',
             'ice_IS'               => 'is_IS',
             'ind'                  => 'id',
             'ind_ID'               => 'id_ID',
             'isl'                  => 'is',
             'isl_IS'               => 'is_IS',
             'ita'                  => 'it',
             'ita_CH'               => 'it_CH',
             'ita_IT'               => 'it_IT',
             'ita_IT_PREEURO'       => 'it_IT',
             'iw'                   => 'iw',
             'iw_IL'                => 'iw_IL',
             'jpn'                  => 'ja',
             'jpn_JP'               => 'ja_JP',
             'kal'                  => 'kl',
             'kal_GL'               => 'kl_GL',
             'kan'                  => 'kn',
             'kan_IN'               => 'kn_IN',
             'kat'                  => 'ka',
             'kat_GE'               => 'ka_GE',
             'kaz'                  => 'kk',
             'kaz_KZ'               => 'kk_KZ',
             'kir'                  => 'ky',
             'kir_KG'               => 'ky_KG',
             'kor'                  => 'ko',
             'kor_KR'               => 'ko_KR',
             'lav'                  => 'lv',
             'lav_LV'               => 'lv_LV',
             'lit'                  => 'lt',
             'lit_LT'               => 'lt_LT',
             'mac'                  => 'mk',
             'mac_MK'               => 'mk_MK',
             'mar'                  => 'mr',
             'mar_IN'               => 'mr_IN',
             'may'                  => 'ms',
             'may_BN'               => 'ms_BN',
             'may_MY'               => 'ms_MY',
             'mkd'                  => 'mk',
             'mkd_MK'               => 'mk_MK',
             'mlt'                  => 'mt',
             'mlt_MT'               => 'mt_MT',
             'mon'                  => 'mn',
             'mon_MN'               => 'mn_MN',
             'msa'                  => 'ms',
             'msa_BN'               => 'ms_BN',
             'msa_MY'               => 'ms_MY',
             'nld'                  => 'nl',
             'nld_BE'               => 'nl_BE',
             'nld_BE_PREEURO'       => 'nl_BE',
             'nld_NL'               => 'nl_NL',
             'nld_NL_PREEURO'       => 'nl_NL',
             'nno'                  => 'nn',
             'nno_NO'               => 'nn_NO',
             'nob'                  => 'nb',
             'nob_NO'               => 'nb_NO',
             'nor'                  => 'no',
             'nor_NO'               => 'no_NO',
             'nor_NO_NY'            => 'no_NO_NY',
             'orm'                  => 'om',
             'orm_ET'               => 'om_ET',
             'orm_KE'               => 'om_KE',
             'pan'                  => 'pa',
             'pan_IN'               => 'pa_IN',
             'per'                  => 'fa',
             'per_IR'               => 'fa_IR',
             'pol'                  => 'pl',
             'pol_PL'               => 'pl_PL',
             'por'                  => 'pt',
             'por_BR'               => 'pt_BR',
             'por_PT'               => 'pt_PT',
             'por_PT_PREEURO'       => 'pt_PT',
             'ron'                  => 'ro',
             'ron_RO'               => 'ro_RO',
             'rum'                  => 'ro',
             'rum_RO'               => 'ro_RO',
             'rus'                  => 'ru',
             'rus_RU'               => 'ru_RU',
             'rus_UA'               => 'ru_UA',
             'san'                  => 'sa',
             'san_IN'               => 'sa_IN',
             'scc'                  => 'sr',
             'scc_YU'               => 'sr_YU',
             'scr'                  => 'hr',
             'scr_HR'               => 'hr_HR',
             'slk'                  => 'sk',
             'slk_SK'               => 'sk_SK',
             'slo'                  => 'sk',
             'slo_SK'               => 'sk_SK',
             'slv'                  => 'sl',
             'slv_SI'               => 'sl_SI',
             'som'                  => 'so',
             'som_DJ'               => 'so_DJ',
             'som_ET'               => 'so_ET',
             'som_KE'               => 'so_KE',
             'som_SO'               => 'so_SO',
             'spa'                  => 'es',
             'spa_AR'               => 'es_AR',
             'spa_BO'               => 'es_BO',
             'spa_CL'               => 'es_CL',
             'spa_CO'               => 'es_CO',
             'spa_CR'               => 'es_CR',
             'spa_DO'               => 'es_DO',
             'spa_EC'               => 'es_EC',
             'spa_ES'               => 'es_ES',
             'spa_ES_PREEURO'       => 'es_ES',
             'spa_GT'               => 'es_GT',
             'spa_HN'               => 'es_HN',
             'spa_MX'               => 'es_MX',
             'spa_NI'               => 'es_NI',
             'spa_PA'               => 'es_PA',
             'spa_PE'               => 'es_PE',
             'spa_PR'               => 'es_PR',
             'spa_PY'               => 'es_PY',
             'spa_SV'               => 'es_SV',
             'spa_US'               => 'es_US',
             'spa_UY'               => 'es_UY',
             'spa_VE'               => 'es_VE',
             'sqi'                  => 'sq',
             'sqi_AL'               => 'sq_AL',
             'srp'                  => 'sr',
             'srp_YU'               => 'sr_YU',
             'swa'                  => 'sw',
             'swa_KE'               => 'sw_KE',
             'swa_TZ'               => 'sw_TZ',
             'swe'                  => 'sv',
             'swe_FI'               => 'sv_FI',
             'swe_SE'               => 'sv_SE',
             'tam'                  => 'ta',
             'tam_IN'               => 'ta_IN',
             'tat'                  => 'tt',
             'tat_RU'               => 'tt_RU',
             'tel'                  => 'te',
             'tel_IN'               => 'te_IN',
             'tha'                  => 'th',
             'tha_TH'               => 'th_TH',
             'tur'                  => 'tr',
             'tur_TR'               => 'tr_TR',
             'ukr'                  => 'uk',
             'ukr_UA'               => 'uk_UA',
             'urd'                  => 'ur',
             'urd_PK'               => 'ur_PK',
             'uzb'                  => 'uz',
             'uzb_UZ'               => 'uz_UZ',
             'vie'                  => 'vi',
             'vie_VN'               => 'vi_VN',
             'zho'                  => 'zh',
             'zho_CN'               => 'zh_CN',
             'zho_HK'               => 'zh_HK',
             'zho_MO'               => 'zh_MO',
             'zho_SG'               => 'zh_SG',
             'zho_TW'               => 'zh_TW',
             'zho_TW_STROKE'        => 'zh_TW',
           );
}

sub generate_pm_file_pod
{
    my $ldml = shift;

    my $pm_file = file( qw( lib DateTime Locale ), $ldml->id() . q{.pm} );

    require DateTime::Locale;

    my $locale = DateTime::Locale->load( $ldml->id() );

    open my $fh, '>>:utf8', $pm_file
        or die "Cannot append to $pm_file: $!";

    write_pm_file_pod_header( $fh, $locale, $ldml );

    print {$fh} pod_for_days( $locale );
    print {$fh} pod_for_months( $locale );
    print {$fh} pod_for_quarters( $locale );
    print {$fh} pod_for_eras( $locale );
    print {$fh} pod_for_formats( $locale );
    print {$fh} pod_for_misc( $locale );
    print {$fh} pod_footer( $locale );
}

sub write_pm_file_pod_header
{
    my $fh     = shift;
    my $locale = shift;
    my $ldml   = shift;

    my $class = ref $locale;
    my $id    = $locale->id();
    my $name  = $locale->name();

    print {$fh} <<"EOF";

=pod

=encoding utf8

=head1 NAME

$class

=head1 SYNOPSIS

  use DateTime;

  my \$dt = DateTime->now( locale => '$id' );
  print \$dt->month_name();

=head1 DESCRIPTION

This is the DateTime locale package for $name.

=head1 DATA

EOF

    if ( $id ne 'root' )
    {
        print {$fh}
            'This locale inherits from the L<DateTime::Locale::' . $ldml->parent_id() . "> locale.\n\n";
    }

    print {$fh} "It contains the following data.\n\n";
}

sub pod_for_days
{
    my $locale = shift;

    return pod_for_variations( $locale, 'day' );
}

sub pod_for_months
{
    my $locale = shift;

    return pod_for_variations( $locale, 'month' );
}

sub pod_for_quarters
{
    my $locale = shift;

    return pod_for_variations( $locale, 'quarter' );
}

sub pod_for_eras
{
    my $locale = shift;

    return pod_for_variations( $locale, 'era' );
}

sub pod_for_variations
{
    my $locale = shift;
    my $thing  = shift;

    my $pod = '';

    my $pl = PL_N( $thing );
    $pod .= "=head2 \u$pl\n\n";

    my @forms = $thing eq 'era' ? ('') : ( 'format', 'stand_alone' );

    for my $form (@forms)
    {
        for my $size ( qw( wide abbreviated narrow ) )
        {
            my $meth = $form ? $thing . q{_} . $form . q{_} . $size : $thing . q{_} . $size;

            next unless $locale->can($meth);

            my $head = ucfirst $size;

            if ($form)
            {
                ( my $f = $form ) =~ s/_/-/;
                $head .= " ($f)";
            }

            $pod .= "=head3 $head\n\n";

            for my $val ( @{ $locale->$meth() } )
            {
                $pod .= "  $val\n";
            }

            $pod .= "\n";
        }
    }

    return $pod;
}

sub pod_for_formats
{
    my $locale = shift;

    unless ( DateTime->can('new') )
    {
        eval "use DateTime 0.43";
        die $@ if $@;
    }

    my @dts =
        ( DateTime->new( year      => 2008,
                         month     => 2,
                         day       => 5,
                         hour      => 12,
                         minute    => 30,
                         second    => 30,
                         locale    => $locale,
                         time_zone => 'UTC',
                       ),
          DateTime->new( year      => 1995,
                         month     => 12,
                         day       => 22,
                         hour      => 9,
                         minute    => 5,
                         second    => 2,
                         locale    => $locale,
                         time_zone => 'UTC',
                       ),
          DateTime->new( year      => -10,
                         month     => 12,
                         day       => 22,
                         hour      => 23,
                         minute    => 5,
                         second    => 2,
                         locale    => $locale,
                         time_zone => 'UTC',
                       ),
        );

    return pod_for_standard_formats( $locale, \@dts )
           . pod_for_available_formats( $locale, \@dts )
}

sub pod_for_standard_formats
{
    my $locale = shift;
    my $dts    = shift;

    my $pod = '';

    for my $type ( qw( date time datetime ) )
    {
        $pod .= "=head2 \u$type Formats\n\n";

        for my $length ( qw( full long medium short default ) )
        {
            $pod .= "=head3 \u$length\n\n";

            my $meth = $type . q{_} . 'format' . q{_} . $length;

            for my $dt ( @{ $dts } )
            {
                $pod .=
                    sprintf( '  %20s = %s',
                             $dt->iso8601(),
                             $dt->format_cldr( $locale->$meth() ),
                           );
                $pod .= "\n";
            }

            $pod .= "\n";
        }
    }

    return $pod;
}

sub pod_for_available_formats
{
    my $locale = shift;
    my $dts    = shift;

    my $pod = '';

    $pod .= "=head2 Available Formats\n\n";

    for my $format ( $locale->available_formats() )
    {
        my $cldr = $locale->format_for($format);

        $pod .= "=head3 $format ($cldr)\n\n";

        for my $dt ( @{ $dts } )
        {
            $pod .=
                sprintf( '  %20s = %s',
                         $dt->iso8601(),
                         $dt->format_cldr($cldr),
                       );

            $pod .= "\n";
        }

        $pod .= "\n";
    }

    return $pod;
}

sub pod_for_misc
{
    my $locale = shift;

    my $pod = "=head2 Miscellaneous\n\n";

    $pod .= "=head3 Prefers 24 hour time?\n\n";

    $pod .= $locale->prefers_24_hour_time() ? 'Yes' : 'No';
    $pod .= "\n\n";

    $pod .= "=head3 Local first day of the week\n\n";

    $pod .= $locale->day_format_wide()->[ $locale->first_day_of_week() - 1 ];
    $pod .= "\n\n";

    return $pod;
}

sub pod_footer
{
    return <<'EOF';

=head1 SUPPORT

See L<DateTime::Locale>.

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 COPYRIGHT

Copyright (c) 2008 David Rolsky. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

This module was generated from data provided by the CLDR project, see
the LICENSE.cldr in this distribution for details on the CLDR data's
license.

=cut
EOF
}

sub write_to_manifest
{
    return if $opts{file};

    my $fh = _manifest_handle();

    print {$fh} $_, "\n"
        for @_;
}

{
    my $fh;

    sub _manifest_handle
    {
        return $fh if defined $fh;

        copy( 'MANIFEST.base', 'MANIFEST' );
        open $fh, '>>', 'MANIFEST' or die "Cannot write to MANIFEST: $!";

        return $fh;
    }
}

main();
