#!/usr/bin/perl -w

use strict;

use warnings;

use Cwd;

use IO::File;

################################################################################

our($YEAR,$VERSION);

get_vars();

# $type{TYPE} => TYPE_DESC

#

# TYPE_DESC = { label    => [TYPE_LABEL, ...]

#               modlabel => MOD_LABEL

#               default  => CODESET

#               codesets => { CODESET => CODESET_DESC }

#             }

#

# CODESET_DESC = { label => [CODESET_LABEL, ...]

#                  const => [CONST, ...]

#                  desc  => CODE_DESC

#                }

#

# TYPE          : the type of codes                      country

# TYPE_LABEL    : the label(s) for this type of          COUNTRY

#                 code (defaults to TYPE in all

#                 uppercase and with '-' replaced

#                 with '_')

# MOD_LABEL     : the label for the module name          Country

#                 (defaults to ucfirst(TYPE))

# CODESET       : the name of each codeset               alpha-2

# CODESET_LABEL : the label for this codeset             ALPHA_2

#                 (defaults to CODESET in all

#                 uppercase and with '-' replaced

#                 with '_')

# CONST         : the name of 1 or more constants        LOCALE_CODE_ALPHA_2

#                 that will be associated with this

#                 codeset (defaults to a single

#                 constant for each TYPE_LABEL and

#                 CODESET_LABEL combination of the

#                 form:

#                 LOCALE_<TYPE_LABEL>_<CODESET_LABEL>)

# CODE_DESC     : a listref describing the format        ['numeric',3]

#                 of the codes in this codeset;

#                 possible values are:

#                   uc        : uppercase code

#                   lc        : lowercase code

#                   ucfirst   : code with 1st character

#                               uppercase

#                   numeric,N : an N-digit numeric

#                               code

our %type =

  ('country' => {

                 'label'    => ['CODE','COUNTRY'],

                 'default'  => 'alpha-2',

                 'codesets' => { 'alpha-2'      => { 'desc'  => ['lc'], },

                                 'alpha-3'      => { 'desc'  => ['lc'], },

                                 'numeric'      => { 'desc'  => ['numeric',3], },

                                 'dom'          => { 'desc'  => ['lc'], },

                                 'un-alpha-3'   => { 'desc'  => ['uc'], },

                                 'un-numeric'   => { 'desc'  => ['numeric',3], },

                                 'genc-alpha-2' => { 'desc'  => ['uc'], },

                                 'genc-alpha-3' => { 'desc'  => ['uc'], },

                                 'genc-numeric' => { 'desc'  => ['numeric',3], },

                               },

                },

   'language' => {

                  'label'    => ['LANG','LANGUAGE'],

                  'default'  => 'alpha-2',

                  'codesets' => { 'alpha-2'  => { 'desc'   => ['lc'], },

                                  'alpha-3'  => { 'desc'   => ['lc'], },

                                  'term'     => { 'desc'   => ['lc'], },

                                },

                 },

   'currency' => {

                  'label'    => ['CURR','CURRENCY'],

                  'default'  => 'alpha',

                  'codesets' => { 'alpha'   => { 'desc'   => ['uc'], },

                                  'num'     => { 'label'  => ['NUMERIC'],

                                                 'desc'   => ['numeric',3], },

                                },

                 },

   'script' => {

                'default'  => 'alpha',

                'codesets' => { 'alpha'    => { 'desc'   => ['ucfirst'], },

                                'num'      => { 'label'  => ['NUMERIC'],

                                                'desc'   => ['numeric',3], },

                              },

               },

   'langext' => {

                 'default'  => 'alpha',

                 'modlabel' => 'LangExt',

                 'codesets' => { 'alpha'  => { 'desc'   => ['lc'], },

                               },

                },

   'langvar' => {

                 'default'  => 'alpha',

                 'modlabel' => 'LangVar',

                 'codesets' => { 'alpha'  => { 'desc'   => ['lc'], },

                               },

                },

   'langfam' => {

                 'default'  => 'alpha',

                 'modlabel' => 'LangFam',

                 'codesets' => { 'alpha'  => { 'desc'   => ['lc'], },

                               },

                },

  );

################################################################################

our ($max,$maxc);

gen_constants();

gen_mods();

################################################################################

sub gen_mods {

   foreach my $type (sort keys %type) {

      _gen_mod($type,'');

      _gen_mod($type,'pod');

   }

   foreach my $type (qw(country language currency script)) {

      _gen_mod($type,'',   'old');

      _gen_mod($type,'pod','old');

   }

}

sub _gen_mod {

   my($type,$pod,$old) = @_;

   my $mod   = (exists $type{$type}{'modlabel'}

                ? $type{$type}{'modlabel'}

                : _upcase_first($type) );

   my $dire  = ($old ? "lib/Locale" : "lib/Locale/Codes");

   my $f     = "$dire/$mod." . ($pod ? 'pod' : 'pm');

   my $o     = new IO::File;

   $o->open("> $f");

   if ($pod) {

      __gen_pod($o,$type,$mod,$old);

   } else {

      _header($o,$mod,$old);

      __gen_mod($o,$type,$mod);

   }

   $o->close();

}

sub __gen_pod {

   my($o,$type,$mod,$old) = @_;

   my $parent             = ($old ? "Locale" : "Locale::Codes");

   my $typelab            = ($type{$type}{'modlable'}

                             ? $type{$type}{'modlable'}

                             : ucfirst($type));

   print $o <<"EOS";

=pod

=head1 NAME

${parent}::${mod} - module for dealing with ${type} code sets

=head1 SYNOPSIS

   use ${parent}::${mod};

   \$name = code2${type}(CODE);

   \$code = ${type}2code(NAME);

   \@codes   = all_${type}_codes();

   \@names   = all_${type}_names();

=head1 DESCRIPTION

This module provides access to ${type} code sets.

Please refer to the L<Locale::Codes::Types> document for a description

of the code sets available.

Most of the routines take an optional additional argument which

specifies the code set to use. The code set can be specified using the

name of a code set, or the perl constant specified in the above

document.  If not specified, the default code set will be used.

=head1 ROUTINES

All routines in this module call the appropriate method in the

L<Locale::Codes> module, using an object of type: $type

Please refer to the documentation of the L<Locale::Codes> module

for details about each function.

The following functions are exported automatically:

=over 4

=item B<code2${type}(CODE [,CODESET] [,'retired'])>

See B<code2name> in L<Locale::Codes>

=item B<${type}2code(NAME [,CODESET] [,'retired'])>

See B<name2code> in L<Locale::Codes>

=item B<${type}_code2code(CODE ,CODESET ,CODESET2)>

See B<code2code> in L<Locale::Codes>

=item B<all_${type}_codes([CODESET] [,'retired'])>

See B<all_codes> in L<Locale::Codes>

=item B<all_${type}_names([CODESET] [,'retired'])>

See B<all_names> in L<Locale::Codes>

=back

The following functions are not exported and must be called fully

qualified with the package name:

=over 4

=item B<${parent}::${typelab}::show_errors(FLAG)>

By default, invalid input will produce empty results, but no errors.  By

passing in a non-zero value of FLAG, errors will be produced.

See B<show_errors> in L<Locale::Codes> but note that the default for

the non-OO modules are to NOT produce errors.

=item B<${parent}::${typelab}::rename_${type}(CODE ,NEW_NAME [,CODESET])>

See B<rename_code> in L<Locale::Codes>

=item B<${parent}::${typelab}::add_${type}(CODE ,NAME [,CODESET])>

See B<add_code> in L<Locale::Codes>

=item B<${parent}::${typelab}::delete_${type}(CODE [,CODESET])>

See B<delete_code> in L<Locale::Codes>

=item B<${parent}::${typelab}::add_${type}_alias(NAME ,NEW_NAME)>

See B<add_alias> in L<Locale::Codes>

=item B<${parent}::${typelab}::delete_${type}_alias(NAME)>

See B<delete_alias> in L<Locale::Codes>

=item B<${parent}::${typelab}::rename_${type}_code(CODE ,NEW_CODE [,CODESET])>

See B<replace_code> in L<Locale::Codes>

=item B<${parent}::${typelab}::add_${type}_code_alias(CODE ,NEW_CODE [,CODESET])>

See B<add_code_alias> in L<Locale::Codes>

=item B<${parent}::${typelab}::delete_${type}_code_alias(CODE [,CODESET])>

See B<delete_code_alias> in L<Locale::Codes>

=back

=head1 SEE ALSO

=over 4

=item L<Locale::Codes>

The Locale-Codes distribution.

=back

=head1 AUTHOR

See Locale::Codes for full author history.

Currently maintained by Sullivan Beck (sbeck\@cpan.org).

=head1 COPYRIGHT

   Copyright (c) 2011-2018 Sullivan Beck

This module is free software; you can redistribute it and/or

modify it under the same terms as Perl itself.

=cut

EOS

}

sub __gen_mod {

   my($o,$type,$mod) = @_;

   my($TYPE)         = uc($type);

   print $o <<"EOS";

use if \$] >= 5.027007, 'deprecate';

use Locale::Codes;

use Locale::Codes::Constants;

\@EXPORT    = qw(

                code2${type}

                ${type}2code

                all_${type}_codes

                all_${type}_names

                ${type}_code2code

               );

push(\@EXPORT,\@Locale::Codes::Constants::CONSTANTS_${TYPE});

our \$obj = new Locale::Codes('$type');

\$obj->show_errors(0);

sub show_errors {

   my(\$val) = \@_;

   \$obj->show_errors(\$val);

}

sub code2${type} {

   return \$obj->code2name(\@_);

}

sub ${type}2code {

   return \$obj->name2code(\@_);

}

sub ${type}_code2code {

   return \$obj->code2code(\@_);

}

sub all_${type}_codes {

   return \$obj->all_codes(\@_);

}

sub all_${type}_names {

   return \$obj->all_names(\@_);

}

sub rename_${type} {

   return \$obj->rename_code(\@_);

}

sub add_${type} {

   return \$obj->add_code(\@_);

}

sub delete_${type} {

   return \$obj->delete_code(\@_);

}

sub add_${type}_alias {

   return \$obj->add_alias(\@_);

}

sub delete_${type}_alias {

   return \$obj->delete_alias(\@_);

}

sub rename_${type}_code {

   return \$obj->replace_code(\@_);

}

sub add_${type}_code_alias {

   return \$obj->add_code_alias(\@_);

}

sub delete_${type}_code_alias {

   return \$obj->delete_code_alias(\@_);

}

1;

EOS

}

sub get_vars {

   my $dir  = getcwd;

   $dir     =~ /Locale\-Codes\-(\d+\.\d+)/;

   $VERSION = $1;

   $YEAR    = (localtime(time))[5] + 1900;

}

sub gen_constants {

   my $f    = "lib/Locale/Codes/Constants.pm";

   my $o    = new IO::File;

   $o->open("> $f");

   _header($o,"Constants");

   _constants_defs($o);

   $o->close();

}

sub _constants_defs {

   my($o) = @_;

   $max   = 0;

   $maxc  = 0;

   foreach my $type (sort keys %type) {

      my @lab = (exists $type{$type}{'label'}

                 ? @{ $type{$type}{'label'} }

                 : _upcase($type) );

      foreach my $codeset (sort keys %{ $type{$type}{'codesets'} }) {

         my @const;

         if (exists $type{$type}{'codesets'}{$codeset}{'const'} ) {

            @const = @{ $type{$type}{'codesets'}{$codeset}{'const'} };

         } else {

            my @clab = (exists $type{$type}{'codesets'}{$codeset}{'label'}

                        ? @{ $type{$type}{'codesets'}{$codeset}{'label'} }

                        : _upcase($codeset) );

            foreach my $lab (@lab) {

               foreach my $clab (@clab) {

                  push(@const,"LOCALE_${lab}_${clab}");

               }

            }

         }

         foreach my $const (@const) {

            $type{$type}{'const'}{$const} = $codeset;

            if (length($const) > $max) {

               $max = length($const);

            }

         }

         if (length($codeset) > $maxc) {

            $maxc = length($codeset);

         }

      }

   }

   print $o <<"EOS";

our(\@CONSTANTS,\%ALL_CODESETS);

EOS

   foreach my $type (sort keys %type) {

      print $o "our(\@CONSTANTS_" . uc($type) . ") = qw(\n";

      foreach my $const (sort keys %{ $type{$type}{'const'} }) {

         print $o "                $const\n";

      }

      print $o ");\n";

      print $o "push(\@CONSTANTS,\@CONSTANTS_" . uc($type) . ");\n";

      print $o "\n";

   }

   print $o <<"EOS";

\@EXPORT    = (\@CONSTANTS,

               qw(

                \%ALL_CODESETS

               ));

EOS

   foreach my $type (sort keys %type) {

      foreach my $const (sort keys %{ $type{$type}{'const'} }) {

         my $codeset = $type{$type}{'const'}{$const};

         my $spc     = ' 'x($max - length($const));

         print $o "use constant $const$spc => '$codeset';\n"

      }

      my $def = $type{$type}{'default'};

      my $mod = (exists $type{$type}{'modlabel'}

                 ? $type{$type}{'modlabel'}

                 : _upcase_first($type) );

      print $o <<"EOS";

\$ALL_CODESETS{'$type'} =

   {

      'default'  => '$def',

      'module'   => '$mod',

      'codesets' => {

EOS

      foreach my $codeset (sort keys %{ $type{$type}{'codesets'} }) {

         my @desc = @{ $type{$type}{'codesets'}{$codeset}{'desc'} };

         foreach my $d (@desc) {

            if ($d !~ /^\d+$/) {

               $d = "'$d'";

            }

         }

         my $desc = join(',',@desc);

         my $spc  = ' 'x($maxc-length($codeset));

         print $o <<"EOS";

                     '$codeset'$spc => [$desc],

EOS

      }

      print $o <<"EOS";

                    }

   };

EOS

   }

   print $o "\n1;\n";

}

sub _upcase {

   my($string) = @_;

   $string     = uc($string);

   $string     =~ s/\-/_/g;

   return $string;

}

sub _upcase_first {

   my($string) = @_;

   $string     = ucfirst($string);

   $string     =~ s/\-/_/g;

   return $string;

}

sub _header {

   my($o,$package,$old) = @_;

   my $timestamp   = `date`;

   chomp($timestamp);

   my $parent      = ($old ? "Locale" : "Locale::Codes");

   print $o <<"EOS";

package ${parent}::$package;

# Copyright (C) 2001      Canon Research Centre Europe (CRE).

# Copyright (C) 2002-2009 Neil Bowers

# Copyright (c) 2010-$YEAR Sullivan Beck

# This program is free software; you can redistribute it and/or modify it

# under the same terms as Perl itself.

# This file was automatically generated.  Any changes to this file will

# be lost the next time 'gen_mods' is run.

#    Generated on: $timestamp

use strict;

use warnings;

require 5.006;

use Exporter qw(import);

our(\$VERSION,\@EXPORT);

\$VERSION   = '$VERSION';

################################################################################

EOS

}

# Local Variables:

# mode: cperl

# indent-tabs-mode: nil

# cperl-indent-level: 3

# cperl-continued-statement-offset: 2

# cperl-continued-brace-offset: 0

# cperl-brace-offset: 0

# cperl-brace-imaginary-offset: 0

# cperl-label-offset: 0

# End: