
package Mojolicious::Plugin::CountryDropDown;

# ABSTRACT: Provide a localizable dropdown where users can select a country

use strict;
use warnings;

use Mojo::Base 'Mojolicious::Plugin';
use Locale::Country::Multilingual { use_io_layer => 1 };
use Unicode::Collate;
use List::MoreUtils qw( zip pairwise );
use Carp qw(confess);

our $VERSION = 0.05_04;
$VERSION = eval $VERSION;

sub register {
    my ( $plugin, $app, $opts ) = @_;

    my $collate = Unicode::Collate->new()
        or confess 'Unsatisfied dependency: Unicode::Collate';
    my $lcm = Locale::Country::Multilingual->new()
        or confess 'Unsatisfied dependency: Locale::Country::Multilingual';

    $plugin->{_collate} = $collate;
    $plugin->{_lcm}     = $lcm;

    $plugin->_build_conf( $app, $opts );

    $app->helper(
        'country_select_field' => sub {
            my ( $app, $opts ) = @_;

            my $selected = $opts->{select} || $plugin->{_conf}->{select} || '';
            my %countries = %{ $plugin->_build_country_list( $app, $opts ) };

            my @preferred = ();
            if ( exists $opts->{prefer} and ( ref $opts->{prefer} eq ref [] ) ) {
                @preferred = map { uc($_) } @{ $opts->{prefer} };
            }
            else {
                @preferred = @{ $plugin->{_conf}->{prefer} || [] };
            }

            my @vals              = values(%countries);
            my @keys              = keys(%countries);
            my %countries_by_name = zip @vals, @keys;

            # simply using "sort" isn't appropriate...
            my @sorted_names = $plugin->{_collate}->sort( keys %countries_by_name );
            my @sorted_codes = @countries_by_name{@sorted_names};

            my @preferred_options = ();
            if (@preferred) {
                foreach my $code (@preferred) {
                    my @opt = ( $countries{$code}, $code );
                    if ( $code eq $selected ) {
                        push @opt, selected => 'selected';
                        $selected = '';
                    }
                    push @preferred_options, [@opt];
                }
                push @preferred_options, [ '-----', '', disabled => 'disabled' ];
            }

            my @options = (
                @preferred_options,
                pairwise {

                    # $a = $names->[$n], $b = $codes->[$n]
                    my $option = [ $a, $b ];
                    push @$option, selected => "selected" if $b eq $selected;
                    $option;
                }
                @sorted_names,
                @sorted_codes
            );

            # html code gets generated by Mojolicious
            my %attr = %{ $opts->{html_attr} || $plugin->{_conf}->{html_attr} || {} };
            my $name = delete( $attr{name} ) || 'country';

            if ( !exists $attr{id} ) {
                $attr{id} = $name;
            }
            elsif ( exists $attr{id} and not defined $attr{id} ) {
                delete $attr{id};
            }

            return $app->select_field( $name, \@options, %attr );
        }
    );

    $app->helper( 'country_drop_down' => sub { return shift->country_select_field(@_) } );

    $app->helper(
        'csf_country_list' => sub {
            my $app = shift;
            my $opts = shift // {};
            return $plugin->_build_country_list( $app, $opts );
        }
    );

    $app->helper(
        'csf_conf' => sub {
            my ( $app, $new ) = @_;

            unless ( defined $new ) {
                return $plugin->{_conf};
            }

            if ( ref $new eq ref {} and !%{$new} ) {
                delete $plugin->{_conf};
            }

            $plugin->_build_conf( $app, $new );
            return $plugin->{_conf};
        }
    );

    $app->helper(
        'code2country' => sub {
            my ( $app, $code ) = ( shift, shift );

            unless ( defined $code and $code ) {
                $app->log->warn('code2country() called without a code');
                return;
            }

            my $lang = $plugin->_get_language( $app, shift );

            return $plugin->{_lcm}->code2country( $code, $lang );
        }
    );

    $app->helper(
        'country2code' => sub {
            my ( $app, $country, $lang, $codeset ) = @_;

            return unless defined $country and $country;

            $lang = $plugin->_get_language( $app, $lang );

            $codeset = $plugin->_check_codeset( $app, $codeset ) // $plugin->{_conf}->{codeset};

            return $plugin->{_lcm}->country2code( $country, $codeset, $lang );
        }
    );
    return;
} ## end sub register

# Determine the most appropriate language to use using a fallback hierarchy

sub _get_language {
    my ( $self, $app, $param ) = @_;

    # param considered first
    if ( defined $param ) {
        if ( $self->_check_lng_avail($param) ) {
            return $param;
        }
    }

    # explicitly configured languages considered next
    if ( exists $self->{_conf}->{language} ) {
        my $l = $self->{_conf}->{language};
        if ( $self->_check_lng_avail($l) ) {
            return $l;
        }
        $app->log->warn('The configured language is not available');
    }

    # fallback: language determined by I18N plugin
    if ( defined $app->stash->{i18n}
         && ( my $l = $app->stash->{i18n}->languages() ) )
    {
        if ( $self->_check_lng_avail($l) ) {
            return $l;
        }

        $app->log->debug( 'The language determined by the I18N plugin is not available; using fallback "en"' );
    }

    # fallback: default = en
    if ( $self->_check_lng_avail('en') ) {
        return 'en';
    }

    # 'en' not available? something´s borken...
    $app->log->error( "Loading language 'en' failed! Broken installation of Locale::Country::Multilingual?" );
    confess "Default language 'en' not available!";
} ## end sub _get_language

sub _check_lng_avail {
    my ( $self, $l ) = @_;

    my %lng_avail = %{ $self->{_lng_avail} || {} };
    return 1 if defined $lng_avail{$l} and $lng_avail{$l};
    return 0 if defined $lng_avail{$l};

    # check if L::C::M supports this language
    # results are cached
    my $loaded = $self->{_lcm}->assert_lang($l);

    if ( defined $loaded and lc($loaded) eq lc($l) ) {
        $self->{_lng_avail}->{$l} = 1;
        return 1;
    }
    else {
        $self->{_lng_avail}->{$l} = 0;
        return 0;
    }
}

sub _build_conf {
    my ( $self, $app, $opts ) = @_;

    unless ( defined $self->{_conf} ) {
        $self->{_conf} = { html_attr => { name => 'country' }, codeset => 'LOCALE_CODE_ALPHA_2', };
    }

    my %conf = %{ $opts || {} };
    foreach my $p (qw/ select language names prefer exclude html_attr codeset /) {
        if ( exists $conf{$p} ) {
            my $method = '_' . $p;
            $self->$method( $app, $conf{$p} );
        }
    }

    return;
}

sub _build_country_list {
    my ( $self, $app ) = ( shift, shift );
    my %opts = %{ shift || {} };

    $self->{_lcm}->set_lang( $self->_get_language( $app, $opts{language} ) );

    # get the codes from the right codeset and the country names in the language set above
    my $codeset = $self->_check_codeset( $app, $opts{codeset} )
        || $self->{_conf}->{codeset};
    my $list = {};
    if ( $codeset eq 'LOCALE_CODE_ALPHA_2' ) {
        my @codes = $self->{_lcm}->all_country_codes($codeset);
        my @names = $self->{_lcm}->all_country_names();
        %{$list} = zip @codes, @names;
    }
    else {
        foreach my $c ( $self->{_lcm}->all_country_codes($codeset) ) {
            $list->{$c} = $self->{_lcm}->code2country($c);
        }
    }

    # remove excluded countries
    my @excl = ();
    if ( defined $opts{exclude} ) {
        @excl = @{ $opts{exclude} };
    }
    elsif ( defined $self->{_conf}->{exclude} ) {
        @excl = @{ $self->{_conf}->{exclude} };
    }
    for my $code (@excl) {
        $code = uc($code);
        delete $list->{$code};
    }

    # replace official country names with app-specific names
    if ( defined $opts{names} and ( ref $opts{names} eq ref {} ) ) {
        while ( my ( $k, $v ) = each %{ $opts{names} } ) {
            $k = uc($k);
            $list->{$k} = $v;
        }
    }
    elsif ( exists $self->{_conf}->{names} ) {
        while ( my ( $k, $v ) = each %{ $self->{_conf}->{names} } ) {
            $k = uc($k);
            $list->{$k} = $v;
        }
    }

    # return a hash of country names indexed by code
    return $list;
} ## end sub _build_country_list

sub _check_codeset {
    my ( $self, $app, $candidate ) = @_;

    return unless defined $candidate and $candidate;
    $candidate = uc($candidate);

    unless ( index( $candidate, "LOCALE_CODE_" ) == 0 ) {
        $candidate = "LOCALE_CODE_" . $candidate;
    }

    if ( $candidate =~ /\ALOCALE_CODE_(?:ALPHA_[23]|NUMERIC)\Z/ ) {
        return $candidate;
    }

    $app->log->warn('Invalid value specified for codeset');

    return;
}

# Following here are helper functions for (re-)setting various config elements

sub _select {
    my ( $self, $app, $s ) = @_;

    if ( defined $s ) {
        if ( ref $s ) {
            $app->log->warn('Please provide a scalar value');
        }
        else {
            $self->{_conf}->{select} = uc($s);
        }
    }
    else {
        delete $self->{_conf}->{select};
    }

    return;
}

sub _codeset {
    my ( $self, $app, $c ) = @_;

    if ( defined $c ) {
        if ( my $val = $self->_check_codeset( $app, $c ) ) {
            $self->{_conf}->{codeset} = $val;
        }
    }
    else {
        $self->{_conf}->{codeset} = 'LOCALE_CODE_ALPHA_2';
    }

    return;
}

sub _language {
    my ( $self, $app, $l ) = @_;

    if ( defined $l and $l ) {
        $self->{_conf}->{language} = $l;
    }
    else {
        delete $self->{_conf}->{language};
    }

    return;
}

sub _prefer {
    my ( $self, $app, $c ) = @_;

    if ( defined $c and $c ) {
        if ( ref $c and not( ref $c eq ref [] ) ) {
            $app->log->warn( 'Either provide scalar value or array ref with name(s) of preferred countries' );
        }
        else {
            $c = [$c] unless ref $c;
            $_ = uc($_) foreach ( @{$c} );
            $self->{_conf}->{prefer} = $c;
        }
    }
    else {
        delete $self->{_conf}->{prefer};
    }

    return;
}

sub _exclude {
    my ( $self, $app, $c ) = @_;

    if ( defined $c and $c ) {
        if ( ref $c and not( ref $c eq ref [] ) ) {
            $app->log->warn( 'Either provide scalar value or array ref with name(s) of excluded countries' );
        }
        else {
            $c = [$c] unless ref $c;
            $_ = uc($_) foreach ( @{$c} );
            $self->{_conf}->{exclude} = $c;
        }
    }
    else {
        delete $self->{_conf}->{exclude};
    }

    return;
}

sub _names {
    my ( $self, $app, $n ) = @_;

    if ( defined $n and $n ) {
        if ( not ref $n eq ref {} ) {
            $app->log->warn( 'Please provide a hash ref with a mapping of country ids to names!' );
        }
        else {
            foreach ( keys %{$n} ) {
                $n->{ uc($_) } = delete $n->{$_};
            }
            $self->{_conf}->{names} = $n;
        }
    }
    else {
        delete $self->{_conf}->{names};
    }

    return;
}

sub _html_attr {
    my ( $self, $app, $a ) = @_;

    if ( defined $a and $a ) {
        if ( not ref $a eq ref {} ) {
            $app->log->warn('Please provide a hash ref with attribute names and values!');
        }
        else {
            $self->{_conf}->{html_attr} = $a;
            unless ( defined $self->{_conf}->{html_attr}->{name}
                     and $self->{_conf}->{html_attr}->{name} ne '' )
            {
                $self->{_conf}->{html_attr}->{name} = 'country';
            }
        }
    }
    else {
        delete $self->{_conf}->{html_attr};

        # form field with no name makes no sense
        # set default name "country"
        $self->{_conf}->{html_attr} = { name => 'country' };
    }

    return;
} ## end sub _html_attr

1;



=pod

=head1 NAME

Mojolicious::Plugin::CountryDropDown - Provide a localizable dropdown where users can select a country

=head1 VERSION

version 0.0504

=head1 SYNOPSIS

    use Mojolicious::Plugin::CountryDropDown;

    sub startup {
        my $self = shift;

        $self->plugin('CountryDropDown');
        ...

In your controller:

    get '/' => sub {
        my $self = shift;

        $self->csf_conf({ language => 'de' }); # this sets the default language 
        ...

In your template (this time with TemplateToolkit syntax):

    [% h.country_select_field({ html_attr => { class => 'shiny', } }) %]

=encoding utf-8

=head1 NAME

Mojolicious::Plugin::CountryDropDown - Provide a dropdown where users can select a country

=head1 VERSION

version 0.0504

=head1 NAME

Mojolicious::Plugin::CountryDrowDown - use a dropdown ("select" field) to select countries 
in your form.

=head1 WARNINGS

Version 0.04 was the first public release and considered a beta release!
Version 0.05_0x include some extensive API changes and there may be some more coming
before version 0.06 is released - so please watch out when updating!

=head1 CONFIGURATION

You may pass a hash ref on plugin registration. The following keys are currently 
recognized: 

=over 4

=item language

Language code (string). The language used for the country names.

Valid values are those known to L<Locale::Country::Multilingual|Locale::Country::Multilingual>.
Invalid values will be silently ignored. See section "LANGUAGE FALLBACKS" below.

=item select

Country code (string). Sets the country to be selected by default.

Valid values are those known to L<Locale::Country::Multilingual|Locale::Country::Multilingual>.
Invalid values will be silently ignored. See section "CODESETS" below.

=item prefer

Array reference with a list of country codes which are put to the
top of the select field in the order in which they appear in this list.
A spacer option is added after them and before the following list of countries.
The countries specified here aren´t currently removed from the following list
so that they will appear twice within the select form field.
If one of these preferred countries is also "select"ed, the pre-selection will
happen in the prepended section of preferred countries.

Valid values are country codes known to L<Locale::Country::Multilingual|Locale::Country::Multilingual>.
Invalid values will be silently ignored. See section "CODESETS" below.

=item exclude 

Array reference with a list of country codes which are removed from the
list. 

Valid values are country codes known to L<Locale::Country::Multilingual|Locale::Country::Multilingual>.
Invalid values will be silently ignored. See section "CODESETS" below.

=item html_attr

Hash reference whose pairs will be used as HTML attributes within the opening
"select" tag. No validation is performed with regard to any HTML doctype!

The attribute "name" will always be set for the "select" element. By default it's 
value will be "country".

The attribute "id" will also be set for the "select" element by default. The
default value is the currently configured value for the "name" attribute. 
Unlike with the "name" attribute you can remove the "id" attribute by setting 
the configured value to "undef".

=item names

Hash reference with pairs of country codes and associated names.
The names specified here will be used instead of the "official" names as provided by
L<Locale::Country::Multilingual|Locale::Country::Multilingual>. The replacement happens
without taking the currently used language into account!

The hash keys have to be country codes from the appropriate codeset! 
See section "CODESETS" below.

On the other hand you can use this to inject extra "countries" but it's up to you to
provide unique codes and translate the names appropriately to the currently used
language.

=item codeset

Codeset id as used by L<Locale::Country::Multilingual|Locale::Country::Multilingual>.
Either C<LOCALE_CODE_ALPHA_2>, C<LOCALE_CODE_ALPHA_3> or C<LOCALE_CODE_NUMERIC>.
By default, 2-letter country codes (C<LOCALE_CODE_ALPHA_2>) are used.

=back

=head1 LANGUAGE FALLBACKS

This module will use a fallback hierarchy to determine which language it has to use 
for the country names.

=over 4

=item *

Highest precedence lies with a parameter to the current function call.

=item *

Next the value from the configuration is used, if set.

=item *

If in use in the application the Mojolicious plugin C<I18N> is used next and asked for
the language it chose.

=item *

Finally, if none of the previous methods provided us with a value (or if none of them
represented a language that is supported by 
L<Locale::Country::Multilingual|Locale::Country::Multilingual>) the last fallback will
be the english language ("en").

=back

Especially if you're using the C<I18N> plugin it's ususally your best option to not 
explicitly set a language.

=head1 CODESETS

Any of the three codesets used by L<Locale::Country::Multilingual|Locale::Country::Multilingual> 
(i.e. C<ALPHA_2>, C<ALPHA_3> and C<NUMERIC>) are accepted - but you have to make sure that you
consistenly use the same codeset across function calls and config values.

=head1 METHODS/HELPERS

=head2 country_select_field ( [ $hashref ] )

Helper method that creates the html fragment with the select field.

Optionally takes a hash reference with configuration values.
See section "CONFIGURATION" above for values which are currently allowed / recognized.
These values override the current configuration but are used only for the current method
call.

=head2 code2country ( $code [, $language ] )

Returns the name for the given country code.
The code can be from any of the three supported codesets.

    my $code = 'DE'; # ALPHA_2 code
    my $name = $app->code2country($code); # returns "Germany" unless a
                                          # different language was set

From which language the name is taken is determined by following the fallback
hierarchy described above.

Optionally you may specifiy the language to use as second param.

    my $lang = 'fr';
    my $name = $app->code2country( $code, $lang ); # returns "Allemange"

The value of the language parameter is used only for the current method call.

=head2 country2code ( $name [, $language [, $codeset ] ] )

Returns the code for the given country name:

    my $code = $self->country2code( 'Allemange', 'fr' ); # returns "DE"

    my $code = $self->country2code( 'Deutschland', 'de', 'NUMERIC' ); # returns "276"

Make sure that the name is given in the currently configured default language
or specifiy the language as second param!

If you want to get a code from a different codeset than the default ALPHA_2 you
can specifiy the codeset as third param. If you want to specifiy a codeset but no 
language please pass "undef" as second parameter.

The values given for the language and codeset parameters are used only for the 
current method call.

=head2 csf_country_list ( [ $hashref ] )

Returns a hash ref indexed by the codes with the country names as values.

Optionally takes a hash reference with configuration values.
See section "CONFIGURATION" above for values which are currently allowed / recognized.
These values override the current configuration but are used only for the current method
call.

Please remember that hashes are unsorted. Therefore, the configuration entries for 
preferred countries are also ignored.

=head2 csf_conf ( [ $hashref ] )

Returns a hash ref with the current configuration if no param is given.
Otherwise resets or updates configuration values, depending on the contents of the hash ref.
See section "CONFIGURATION" above for the hash keys which are currently allowed / recognized.

    $c->csf_conf( {
        language => 'en',
        select   => 'DE',
        prefer   => [ 'DE', 'AT', 'CH', ],
        attr     => { class => 'shinycss', id => 'myId', }
    })

The actions taken depend on the content of the hash:

=over 4

=item *
If there's no key for a configuration entry the currently configured value is retained.

=item *
If there is a key for a configuration entry but the value is undef the respective
configuration entry is removed (or reset to it's default value).

=item *
If there is a key for a configuration entry and it carries a non-undef value that 
value replaces the configured value.

There is no way to "modify" a configuration entry (e.g. append additional html attributes).

=item *
If the hash is empty (i.e. if you call C<$c->csf_conf({})>), the whole configuration is
reset.

=back

=head1 AUTHORS AND CONTRIBUTORS

=over 4

=item *

Heiko Jansen <jansen [at] hbz-nrw.de>

=item *

Skye Shaw <shaw [at] cpan.org>

=item *

Renee Baecker <module [at] renee-baecker.de>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2012 by Hochschulbibliothekszentrum NRW (hbz).

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=head1 AUTHORS

=over 4

=item *

Heiko Jansen <jansen@hbz-nrw.de>

=item *

Skye Shaw <sshaw AT lucas.cis.temple.edu>

=item *

Renee Baecker <module@renee-baecker.de>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2012 by Hochschulbibliothekszentrum NRW (hbz).

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=cut


__END__


