File Coverage

blib/lib/Mojolicious/Plugin/CountryDropDown.pm

Criterion	Covered	Total	%
statement	210	232	90.5
branch	82	106	77.3
condition	40	69	57.9
subroutine	26	26	100.0
pod	1	1	100.0
total	359	434	82.7

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.06;
$VERSION = eval $VERSION; ## no critic ProhibitStringyEval

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 ( $c, $opts ) = @_;

            my $selected = $opts->{select} || $plugin->{_conf}->{select} || '';
            my %countries = %{ $plugin->_build_country_list( $c, $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 $c->select_field( $name, \@options, %attr );
        }
    );

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

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

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

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

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

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

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

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

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

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

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

			unless ( defined $country and $country ) {
				$c->app->log->warn('country2code() called without a country name');
				return;
			}

            $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, $c, $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} ) {
        return $self->{_conf}->{language};
    }

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

        $c->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...
    $c->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, $c, $opts ) = @_;

    unless ( defined $self->{_conf} ) {
		# populate basic defaults
        $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( $c, $conf{$p} );
        }
    }

    return;
}

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

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

    # get the codes from the right codeset and the country names in the language set above
    my $codeset = $self->_check_codeset( $c, $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 {
		# performance killer, but I don´t see another solution
        foreach my $code ( $self->{_lcm}->all_country_codes($codeset) ) {
            $list->{$code} = $self->{_lcm}->code2country($code);
        }
    }

    # 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, $c, $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;
    }

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

    return;
}

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

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

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

    return;
}

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

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

    return;
}

sub _language {
    my ( $self, $c, $lang ) = @_;

    if ( defined $lang and $lang ) {
		if ( $self->_check_lng_avail($lang) ) {
	        $self->{_conf}->{language} = $lang;
		}
		else {
			$c->app->log->warn("Language '$lang' is not supported!");
			delete $self->{_conf}->{language};
		}
    }
    else {
        delete $self->{_conf}->{language};
    }

    return;
}

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

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

    return;
}

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

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

    return;
}

sub _names {
    my ( $self, $c, $names ) = @_;

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

    return;
}

sub _html_attr {
    my ( $self, $c, $attr ) = @_;

    if ( defined $attr and $attr ) {
        if ( not ref $attr eq ref {} ) {
            $c->app->log->warn('Please provide a hash ref with attribute names and values!');
        }
        else {
            $self->{_conf}->{html_attr} = $attr;
            unless ( defined $self->{_conf}->{html_attr}->{name}
                     and $self->{_conf}->{html_attr}->{name} =~ /\A\S+\Z/ )
            {
                $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.06

=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::CountryDrowDown - use a localized dropdown ("select" field) to let
your users select countries in your HTML forms.

=head1 VERSION

Version 0.06

=head1 WARNINGS

Version 0.04 was the first public release and considered a beta release!

Version 0.05_0x and later include some extensive API changes and are
generally incompatible with 0.04 - 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.
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.
Invalid values (i.e. unknown codes) will be accepted but of course have no effect when generating
the form (unless you add artificial country names for these codes using the C config key).
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.
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.
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. 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.
Either C, C or C.
By default, 2-letter country codes (C) 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 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) the last fallback will
be the english language ("en").

=back

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

=head1 CODESETS

Any of the three codesets used by L
(i.e. C, C and C) 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 you need to pass an undefined
value as second param.

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, then 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-Ecsf_conf({})>), the whole configuration is
reset.

=back

=head1 AUTHORS

=over 4

=item *

Renee Baecker

=item *

Heiko Jansen

=item *

Skye Shaw

=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__