AnonymousFox

//usr/share/doc/perl-DateTime-Locale-0.45/tools/generate-from-cldr

#!/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 File::Slurp qw( read_file );
use Getopt::Long;
use LDML;
use Lingua::EN::Inflect qw( PL_N );
use List::AllUtils qw( first );
use Locale::Country
    qw( country_code2code LOCALE_CODE_ALPHA_2 LOCALE_CODE_ALPHA_3 );
use Path::Class;

my $VERSION = '0.05';

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

{
    no warnings 'once';
    $DateTime::Locale::InGenerator = 1;
}

my %opts;
my $glibc_dir;

sub main {
    GetOptions(
        'dir:s'     => \$opts{dir},
        'file:s'    => \$opts{file},
        'version:s' => \$opts{version},
        '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};

require_version();

clean() if $opts{clean};

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

( $glibc_dir = $opts{dir} ) =~ s{cldr/.+}{};
    $glibc_dir .= 'glibc';

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.

--version  The CLDR version. Required when not debugging a single file.

--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 require_version {
    return if $opts{version};

warn <<'EOF';

You must supply a CLDR version.

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_cldr_version($fh);
    write_pm_subs( $fh, $ldml );
    write_pm_glibc_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_cldr_version {
    my $fh = shift;

my $cldr_version = q{"} . quotemeta( $opts{version} ) . q{"};

print {$fh} "sub cldr_version { return $cldr_version }\n\n";
}

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

foreach my $attr ( sort { $a->name() cmp $b->name() }
        LDML->meta()->get_all_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 write_pm_glibc_subs {
    my $fh   = shift;
    my $ldml = shift;

my $file = _glibc_file_for_ldml($ldml);
    return unless -f $file;

my %formats = _read_glibc_data($file);

for my $key ( grep { defined $formats{$_} } sort keys %formats ) {
        print {$fh} string_sub( 'glibc_' . $key . '_format', $formats{$key} );
    }
}

sub _glibc_file_for_ldml
{
    my $ldml = shift;

my $glibc_id = join '_', grep { defined } $ldml->language(), $ldml->territory();
    if ( my $script = $ldml->en_script() ) {
        $glibc_id .= '@' . lc $script;
    }

# This ensures some sort of sanish fallback
    $glibc_id = 'POSIX' if $ldml->id() eq 'root';

return "$glibc_dir/$glibc_id";
}

sub _read_glibc_data {
    my $file = shift;

my $glibc = read_file($file);

return (
        datetime => _extract_glibc_value( 'd_t_fmt',    $glibc ),
        date     => _extract_glibc_value( 'd_fmt',      $glibc ),
        time     => _extract_glibc_value( 't_fmt',      $glibc ),
        time_12  => _extract_glibc_value( 't_fmt_ampm', $glibc ),
        date_1   => _extract_glibc_value( 'date_fmt',   $glibc ),
    );
}

sub _extract_glibc_value {
    my $key = shift;
    my $data = shift;

my ($val) = $data =~ /^\Q$key\E\s+"([^"]+?)"/m
        or return undef;

$val =~ s/[\\\/]\n//g;

$val =~ s/\<U([A-F\d]+)\>/chr(hex($1))/eg;

return $val;
}

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;

my $cldr_version = q{"} . quotemeta( $opts{version} ) . q{"};

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;

sub CLDRVersion { return $cldr_version }

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';

__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. The id starts
with the ISO639-1 language code, and may also include information
identifying any or all of territory, script, or variant.

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
(ISO639-2) 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};

for my $ldml ( @{$ldml} ) {
            my $three = iso639_2_to_3( $ldml->language() );

next unless defined $three;

my $three_id = (
                join '_',
                grep {defined}
                    $three, $ldml->territory(), $ldml->script(),
                $ldml->variant()
            );

next if $ids{$three_id};

$aliases{$three_id} = $ldml->id();
        }

%aliases = ( %aliases, %{ LDML->Aliases() } );

return %aliases;
    }
}

{
    my %iso639_map;

sub iso639_2_to_3 {
        my $two = shift;

_build_iso639_map() unless keys %iso639_map;

return $iso639_map{$two};
    }

sub _build_iso639_map {
        while ( defined( my $line = <DATA> ) ) {
            next unless $line =~ /\S/;
            next if $line =~ /^\#/;

my ( $three, undef, $two, undef, undef ) = split /\|/, $line;

next unless defined $two;

$iso639_map{$two} = $three;
        }
    }
}

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      => 18,
            minute    => 30,
            second    => 30,
            locale    => $locale,
            time_zone => 'UTC',
        ),
        DateTime->new(
            year       => 1995,
            month      => 12,
            day        => 22,
            hour       => 9,
            minute     => 5,
            second     => 2,
            nanosecond => 505_196,
            locale     => $locale,
            time_zone  => 'UTC',
        ),
        DateTime->new(
            year      => -10,
            month     => 9,
            day       => 15,
            hour      => 4,
            minute    => 44,
            second    => 23,
            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 ( sort { lc $a cmp lc $b or $a cmp $b }
        $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

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();

__DATA__
# This is the ISO-639 data downloaded from http://www.loc.gov/standards/iso639-2/ISO-639-2_utf-8.txt
# The version in the Locale::Codes distro is way out of date.
aar||aa|Afar|afar
abk||ab|Abkhazian|abkhaze
ace|||Achinese|aceh
ach|||Acoli|acoli
ada|||Adangme|adangme
ady|||Adyghe; Adygei|adyghé
afa|||Afro-Asiatic languages|afro-asiatiques, langues
afh|||Afrihili|afrihili
afr||af|Afrikaans|afrikaans
ain|||Ainu|aïnou
aka||ak|Akan|akan
akk|||Akkadian|akkadien
alb|sqi|sq|Albanian|albanais
ale|||Aleut|aléoute
alg|||Algonquian languages|algonquines, langues
alt|||Southern Altai|altai du Sud
amh||am|Amharic|amharique
ang|||English, Old (ca.450-1100)|anglo-saxon (ca.450-1100)
anp|||Angika|angika
apa|||Apache languages|apaches, langues
ara||ar|Arabic|arabe
arc|||Official Aramaic (700-300 BCE); Imperial Aramaic (700-300 BCE)|araméen d'empire (700-300 BCE)
arg||an|Aragonese|aragonais
arm|hye|hy|Armenian|arménien
arn|||Mapudungun; Mapuche|mapudungun; mapuche; mapuce
arp|||Arapaho|arapaho
art|||Artificial languages|artificielles, langues
arw|||Arawak|arawak
asm||as|Assamese|assamais
ast|||Asturian; Bable; Leonese; Asturleonese|asturien; bable; léonais; asturoléonais
ath|||Athapascan languages|athapascanes, langues
aus|||Australian languages|australiennes, langues
ava||av|Avaric|avar
ave||ae|Avestan|avestique
awa|||Awadhi|awadhi
aym||ay|Aymara|aymara
aze||az|Azerbaijani|azéri
bad|||Banda languages|banda, langues
bai|||Bamileke languages|bamiléké, langues
bak||ba|Bashkir|bachkir
bal|||Baluchi|baloutchi
bam||bm|Bambara|bambara
ban|||Balinese|balinais
baq|eus|eu|Basque|basque
bas|||Basa|basa
bat|||Baltic languages|baltes, langues
bej|||Beja; Bedawiyet|bedja
bel||be|Belarusian|biélorusse
bem|||Bemba|bemba
ben||bn|Bengali|bengali
ber|||Berber languages|berbères, langues
bho|||Bhojpuri|bhojpuri
bih||bh|Bihari|bihari
bik|||Bikol|bikol
bin|||Bini; Edo|bini; edo
bis||bi|Bislama|bichlamar
bla|||Siksika|blackfoot
bnt|||Bantu (Other)|bantoues, autres langues
bos||bs|Bosnian|bosniaque
bra|||Braj|braj
bre||br|Breton|breton
btk|||Batak languages|batak, langues
bua|||Buriat|bouriate
bug|||Buginese|bugi
bul||bg|Bulgarian|bulgare
bur|mya|my|Burmese|birman
byn|||Blin; Bilin|blin; bilen
cad|||Caddo|caddo
cai|||Central American Indian languages|amérindiennes de L'Amérique centrale, langues
car|||Galibi Carib|karib; galibi; carib
cat||ca|Catalan; Valencian|catalan; valencien
cau|||Caucasian languages|caucasiennes, langues
ceb|||Cebuano|cebuano
cel|||Celtic languages|celtiques, langues; celtes, langues
cha||ch|Chamorro|chamorro
chb|||Chibcha|chibcha
che||ce|Chechen|tchétchène
chg|||Chagatai|djaghataï
chi|zho|zh|Chinese|chinois
chk|||Chuukese|chuuk
chm|||Mari|mari
chn|||Chinook jargon|chinook, jargon
cho|||Choctaw|choctaw
chp|||Chipewyan; Dene Suline|chipewyan
chr|||Cherokee|cherokee
chu||cu|Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic|slavon d'église; vieux slave; slavon liturgique; vieux bulgare
chv||cv|Chuvash|tchouvache
chy|||Cheyenne|cheyenne
cmc|||Chamic languages|chames, langues
cop|||Coptic|copte
cor||kw|Cornish|cornique
cos||co|Corsican|corse
cpe|||Creoles and pidgins, English based|créoles et pidgins basés sur l'anglais
cpf|||Creoles and pidgins, French-based |créoles et pidgins basés sur le français
cpp|||Creoles and pidgins, Portuguese-based |créoles et pidgins basés sur le portugais
cre||cr|Cree|cree
crh|||Crimean Tatar; Crimean Turkish|tatar de Crimé
crp|||Creoles and pidgins |créoles et pidgins
csb|||Kashubian|kachoube
cus|||Cushitic languages|couchitiques, langues
cze|ces|cs|Czech|tchèque
dak|||Dakota|dakota
dan||da|Danish|danois
dar|||Dargwa|dargwa
day|||Land Dayak languages|dayak, langues
del|||Delaware|delaware
den|||Slave (Athapascan)|esclave (athapascan)
dgr|||Dogrib|dogrib
din|||Dinka|dinka
div||dv|Divehi; Dhivehi; Maldivian|maldivien
doi|||Dogri|dogri
dra|||Dravidian languages|dravidiennes, langues
dsb|||Lower Sorbian|bas-sorabe
dua|||Duala|douala
dum|||Dutch, Middle (ca.1050-1350)|néerlandais moyen (ca. 1050-1350)
dut|nld|nl|Dutch; Flemish|néerlandais; flamand
dyu|||Dyula|dioula
dzo||dz|Dzongkha|dzongkha
efi|||Efik|efik
egy|||Egyptian (Ancient)|égyptien
eka|||Ekajuk|ekajuk
elx|||Elamite|élamite
eng||en|English|anglais
enm|||English, Middle (1100-1500)|anglais moyen (1100-1500)
epo||eo|Esperanto|espéranto
est||et|Estonian|estonien
ewe||ee|Ewe|éwé
ewo|||Ewondo|éwondo
fan|||Fang|fang
fao||fo|Faroese|féroïen
fat|||Fanti|fanti
fij||fj|Fijian|fidjien
fil|||Filipino; Pilipino|filipino; pilipino
fin||fi|Finnish|finnois
fiu|||Finno-Ugrian languages|finno-ougriennes, langues
fon|||Fon|fon
fre|fra|fr|French|français
frm|||French, Middle (ca.1400-1600)|français moyen (1400-1600)
fro|||French, Old (842-ca.1400)|français ancien (842-ca.1400)
frr|||Northern Frisian|frison septentrional
frs|||Eastern Frisian|frison oriental
fry||fy|Western Frisian|frison occidental
ful||ff|Fulah|peul
fur|||Friulian|frioulan
gaa|||Ga|ga
gay|||Gayo|gayo
gba|||Gbaya|gbaya
gem|||Germanic languages|germaniques, langues
geo|kat|ka|Georgian|géorgien
ger|deu|de|German|allemand
gez|||Geez|guèze
gil|||Gilbertese|kiribati
gla||gd|Gaelic; Scottish Gaelic|gaélique; gaélique écossais
gle||ga|Irish|irlandais
glg||gl|Galician|galicien
glv||gv|Manx|manx; mannois
gmh|||German, Middle High (ca.1050-1500)|allemand, moyen haut (ca. 1050-1500)
goh|||German, Old High (ca.750-1050)|allemand, vieux haut (ca. 750-1050)
gon|||Gondi|gond
gor|||Gorontalo|gorontalo
got|||Gothic|gothique
grb|||Grebo|grebo
grc|||Greek, Ancient (to 1453)|grec ancien (jusqu'à 1453)
gre|ell|el|Greek, Modern (1453-)|grec moderne (après 1453)
grn||gn|Guarani|guarani
gsw|||Swiss German; Alemannic; Alsatian|suisse alémanique; alémanique; alsacien
guj||gu|Gujarati|goudjrati
gwi|||Gwich'in|gwich'in
hai|||Haida|haida
hat||ht|Haitian; Haitian Creole|haïtien; créole haïtien
hau||ha|Hausa|haoussa
haw|||Hawaiian|hawaïen
heb||he|Hebrew|hébreu
her||hz|Herero|herero
hil|||Hiligaynon|hiligaynon
him|||Himachali|himachali
hin||hi|Hindi|hindi
hit|||Hittite|hittite
hmn|||Hmong|hmong
hmo||ho|Hiri Motu|hiri motu
hrv||hr|Croatian|croate
hsb|||Upper Sorbian|haut-sorabe
hun||hu|Hungarian|hongrois
hup|||Hupa|hupa
iba|||Iban|iban
ibo||ig|Igbo|igbo
ice|isl|is|Icelandic|islandais
ido||io|Ido|ido
iii||ii|Sichuan Yi; Nuosu|yi de Sichuan
ijo|||Ijo languages|ijo, langues
iku||iu|Inuktitut|inuktitut
ile||ie|Interlingue; Occidental|interlingue
ilo|||Iloko|ilocano
ina||ia|Interlingua (International Auxiliary Language Association)|interlingua (langue auxiliaire internationale)
inc|||Indic languages|indo-aryennes, langues
ind||id|Indonesian|indonésien
ine|||Indo-European languages|indo-européennes, langues
inh|||Ingush|ingouche
ipk||ik|Inupiaq|inupiaq
ira|||Iranian languages|iraniennes, langues
iro|||Iroquoian languages|iroquoises, langues
ita||it|Italian|italien
jav||jv|Javanese|javanais
jbo|||Lojban|lojban
jpn||ja|Japanese|japonais
jpr|||Judeo-Persian|judéo-persan
jrb|||Judeo-Arabic|judéo-arabe
kaa|||Kara-Kalpak|karakalpak
kab|||Kabyle|kabyle
kac|||Kachin; Jingpho|kachin; jingpho
kal||kl|Kalaallisut; Greenlandic|groenlandais
kam|||Kamba|kamba
kan||kn|Kannada|kannada
kar|||Karen languages|karen, langues
kas||ks|Kashmiri|kashmiri
kau||kr|Kanuri|kanouri
kaw|||Kawi|kawi
kaz||kk|Kazakh|kazakh
kbd|||Kabardian|kabardien
kha|||Khasi|khasi
khi|||Khoisan languages|khoïsan, langues
khm||km|Central Khmer|khmer central
kho|||Khotanese; Sakan|khotanais; sakan
kik||ki|Kikuyu; Gikuyu|kikuyu
kin||rw|Kinyarwanda|rwanda
kir||ky|Kirghiz; Kyrgyz|kirghiz
kmb|||Kimbundu|kimbundu
kok|||Konkani|konkani
kom||kv|Komi|kom
kon||kg|Kongo|kongo
kor||ko|Korean|coréen
kos|||Kosraean|kosrae
kpe|||Kpelle|kpellé
krc|||Karachay-Balkar|karatchai balkar
krl|||Karelian|carélien
kro|||Kru languages|krou, langues
kru|||Kurukh|kurukh
kua||kj|Kuanyama; Kwanyama|kuanyama; kwanyama
kum|||Kumyk|koumyk
kur||ku|Kurdish|kurde
kut|||Kutenai|kutenai
lad|||Ladino|judéo-espagnol
lah|||Lahnda|lahnda
lam|||Lamba|lamba
lao||lo|Lao|lao
lat||la|Latin|latin
lav||lv|Latvian|letton
lez|||Lezghian|lezghien
lim||li|Limburgan; Limburger; Limburgish|limbourgeois
lin||ln|Lingala|lingala
lit||lt|Lithuanian|lituanien
lol|||Mongo|mongo
loz|||Lozi|lozi
ltz||lb|Luxembourgish; Letzeburgesch|luxembourgeois
lua|||Luba-Lulua|luba-lulua
lub||lu|Luba-Katanga|luba-katanga
lug||lg|Ganda|ganda
lui|||Luiseno|luiseno
lun|||Lunda|lunda
luo|||Luo (Kenya and Tanzania)|luo (Kenya et Tanzanie)
lus|||Lushai|lushai
mac|mkd|mk|Macedonian|macédonien
mad|||Madurese|madourais
mag|||Magahi|magahi
mah||mh|Marshallese|marshall
mai|||Maithili|maithili
mak|||Makasar|makassar
mal||ml|Malayalam|malayalam
man|||Mandingo|mandingue
mao|mri|mi|Maori|maori
map|||Austronesian languages|austronésiennes, langues
mar||mr|Marathi|marathe
mas|||Masai|massaï
may|msa|ms|Malay|malais
mdf|||Moksha|moksa
mdr|||Mandar|mandar
men|||Mende|mendé
mga|||Irish, Middle (900-1200)|irlandais moyen (900-1200)
mic|||Mi'kmaq; Micmac|mi'kmaq; micmac
min|||Minangkabau|minangkabau
mis|||Uncoded languages|langues non codées
mkh|||Mon-Khmer languages|môn-khmer, langues
mlg||mg|Malagasy|malgache
mlt||mt|Maltese|maltais
mnc|||Manchu|mandchou
mni|||Manipuri|manipuri
mno|||Manobo languages|manobo, langues
moh|||Mohawk|mohawk
mon||mn|Mongolian|mongol
mos|||Mossi|moré
mul|||Multiple languages|multilingue
mun|||Munda languages|mounda, langues
mus|||Creek|muskogee
mwl|||Mirandese|mirandais
mwr|||Marwari|marvari
myn|||Mayan languages|maya, langues
myv|||Erzya|erza
nah|||Nahuatl languages|nahuatl, langues
nai|||North American Indian languages|nord-amérindiennes, langues
nap|||Neapolitan|napolitain
nau||na|Nauru|nauruan
nav||nv|Navajo; Navaho|navaho
nbl||nr|Ndebele, South; South Ndebele|ndébélé du Sud
nde||nd|Ndebele, North; North Ndebele|ndébélé du Nord
ndo||ng|Ndonga|ndonga
nds|||Low German; Low Saxon; German, Low; Saxon, Low|bas allemand; bas saxon; allemand, bas; saxon, bas
nep||ne|Nepali|népalais
new|||Nepal Bhasa; Newari|nepal bhasa; newari
nia|||Nias|nias
nic|||Niger-Kordofanian languages|nigéro-kordofaniennes, langues
niu|||Niuean|niué
nno||nn|Norwegian Nynorsk; Nynorsk, Norwegian|norvégien nynorsk; nynorsk, norvégien
nob||nb|Bokmål, Norwegian; Norwegian Bokmål|norvégien bokmål
nog|||Nogai|nogaï; nogay
non|||Norse, Old|norrois, vieux
nor||no|Norwegian|norvégien
nqo|||N'Ko|n'ko
nso|||Pedi; Sepedi; Northern Sotho|pedi; sepedi; sotho du Nord
nub|||Nubian languages|nubiennes, langues
nwc|||Classical Newari; Old Newari; Classical Nepal Bhasa|newari classique
nya||ny|Chichewa; Chewa; Nyanja|chichewa; chewa; nyanja
nym|||Nyamwezi|nyamwezi
nyn|||Nyankole|nyankolé
nyo|||Nyoro|nyoro
nzi|||Nzima|nzema
oci||oc|Occitan (post 1500); Provençal|occitan (après 1500); provençal
oji||oj|Ojibwa|ojibwa
ori||or|Oriya|oriya
orm||om|Oromo|galla
osa|||Osage|osage
oss||os|Ossetian; Ossetic|ossète
ota|||Turkish, Ottoman (1500-1928)|turc ottoman (1500-1928)
oto|||Otomian languages|otomi, langues
paa|||Papuan languages|papoues, langues
pag|||Pangasinan|pangasinan
pal|||Pahlavi|pahlavi
pam|||Pampanga; Kapampangan|pampangan
pan||pa|Panjabi; Punjabi|pendjabi
pap|||Papiamento|papiamento
pau|||Palauan|palau
peo|||Persian, Old (ca.600-400 B.C.)|perse, vieux (ca. 600-400 av. J.-C.)
per|fas|fa|Persian|persan
phi|||Philippine languages|philippines, langues
phn|||Phoenician|phénicien
pli||pi|Pali|pali
pol||pl|Polish|polonais
pon|||Pohnpeian|pohnpei
por||pt|Portuguese|portugais
pra|||Prakrit languages|prâkrit, langues
pro|||Provençal, Old (to 1500)|provençal ancien (jusqu'à 1500)
pus||ps|Pushto; Pashto|pachto
qaa-qtz|||Reserved for local use|réservée à l'usage local
que||qu|Quechua|quechua
raj|||Rajasthani|rajasthani
rap|||Rapanui|rapanui
rar|||Rarotongan; Cook Islands Maori|rarotonga; maori des îles Cook
roa|||Romance languages|romanes, langues
roh||rm|Romansh|romanche
rom|||Romany|tsigane
rum|ron|ro|Romanian; Moldavian; Moldovan|roumain; moldave
run||rn|Rundi|rundi
rup|||Aromanian; Arumanian; Macedo-Romanian|aroumain; macédo-roumain
rus||ru|Russian|russe
sad|||Sandawe|sandawe
sag||sg|Sango|sango
sah|||Yakut|iakoute
sai|||South American Indian (Other)|indiennes d'Amérique du Sud, autres langues
sal|||Salishan languages|salishennes, langues
sam|||Samaritan Aramaic|samaritain
san||sa|Sanskrit|sanskrit
sas|||Sasak|sasak
sat|||Santali|santal
scn|||Sicilian|sicilien
sco|||Scots|écossais
sel|||Selkup|selkoupe
sem|||Semitic languages|sémitiques, langues
sga|||Irish, Old (to 900)|irlandais ancien (jusqu'à 900)
sgn|||Sign Languages|langues des signes
shn|||Shan|chan
sid|||Sidamo|sidamo
sin||si|Sinhala; Sinhalese|singhalais
sio|||Siouan languages|sioux, langues
sit|||Sino-Tibetan languages|sino-tibétaines, langues
sla|||Slavic languages|slaves, langues
slo|slk|sk|Slovak|slovaque
slv||sl|Slovenian|slovène
sma|||Southern Sami|sami du Sud
sme||se|Northern Sami|sami du Nord
smi|||Sami languages|sames, langues
smj|||Lule Sami|sami de Lule
smn|||Inari Sami|sami d'Inari
smo||sm|Samoan|samoan
sms|||Skolt Sami|sami skolt
sna||sn|Shona|shona
snd||sd|Sindhi|sindhi
snk|||Soninke|soninké
sog|||Sogdian|sogdien
som||so|Somali|somali
son|||Songhai languages|songhai, langues
sot||st|Sotho, Southern|sotho du Sud
spa||es|Spanish; Castilian|espagnol; castillan
srd||sc|Sardinian|sarde
srn|||Sranan Tongo|sranan tongo
srp||sr|Serbian|serbe
srr|||Serer|sérère
ssa|||Nilo-Saharan languages|nilo-sahariennes, langues
ssw||ss|Swati|swati
suk|||Sukuma|sukuma
sun||su|Sundanese|soundanais
sus|||Susu|soussou
sux|||Sumerian|sumérien
swa||sw|Swahili|swahili
swe||sv|Swedish|suédois
syc|||Classical Syriac|syriaque classique
syr|||Syriac|syriaque
tah||ty|Tahitian|tahitien
tai|||Tai languages|tai, langues
tam||ta|Tamil|tamoul
tat||tt|Tatar|tatar
tel||te|Telugu|télougou
tem|||Timne|temne
ter|||Tereno|tereno
tet|||Tetum|tetum
tgk||tg|Tajik|tadjik
tgl||tl|Tagalog|tagalog
tha||th|Thai|thaï
tib|bod|bo|Tibetan|tibétain
tig|||Tigre|tigré
tir||ti|Tigrinya|tigrigna
tiv|||Tiv|tiv
tkl|||Tokelau|tokelau
tlh|||Klingon; tlhIngan-Hol|klingon
tli|||Tlingit|tlingit
tmh|||Tamashek|tamacheq
tog|||Tonga (Nyasa)|tonga (Nyasa)
ton||to|Tonga (Tonga Islands)|tongan (Îles Tonga)
tpi|||Tok Pisin|tok pisin
tsi|||Tsimshian|tsimshian
tsn||tn|Tswana|tswana
tso||ts|Tsonga|tsonga
tuk||tk|Turkmen|turkmène
tum|||Tumbuka|tumbuka
tup|||Tupi languages|tupi, langues
tur||tr|Turkish|turc
tut|||Altaic languages|altaïques, langues
tvl|||Tuvalu|tuvalu
twi||tw|Twi|twi
tyv|||Tuvinian|touva
udm|||Udmurt|oudmourte
uga|||Ugaritic|ougaritique
uig||ug|Uighur; Uyghur|ouïgour
ukr||uk|Ukrainian|ukrainien
umb|||Umbundu|umbundu
und|||Undetermined|indéterminée
urd||ur|Urdu|ourdou
uzb||uz|Uzbek|ouszbek
vai|||Vai|vaï
ven||ve|Venda|venda
vie||vi|Vietnamese|vietnamien
vol||vo|Volapük|volapük
vot|||Votic|vote
wak|||Wakashan languages|wakashanes, langues
wal|||Walamo|walamo
war|||Waray|waray
was|||Washo|washo
wel|cym|cy|Welsh|gallois
wen|||Sorbian languages|sorabes, langues
wln||wa|Walloon|wallon
wol||wo|Wolof|wolof
xal|||Kalmyk; Oirat|kalmouk; oïrat
xho||xh|Xhosa|xhosa
yao|||Yao|yao
yap|||Yapese|yapois
yid||yi|Yiddish|yiddish
yor||yo|Yoruba|yoruba
ypk|||Yupik languages|yupik, langues
zap|||Zapotec|zapotèque
zbl|||Blissymbols; Blissymbolics; Bliss|symboles Bliss; Bliss
zen|||Zenaga|zenaga
zha||za|Zhuang; Chuang|zhuang; chuang
znd|||Zande languages|zandé, langues
zul||zu|Zulu|zoulou
zun|||Zuni|zuni
zxx|||No linguistic content; Not applicable|pas de contenu linguistique; non applicable
zza|||Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki|zaza; dimili; dimli; kirdki; kirmanjki; zazaki