Catalyst::Plugin::I18N::Request - A plugin for localizing/delocalizing

    


    package My::App;

    use Catalyst qw( ConfigLoader Static::Simple I18N I18N::Request );

    1;

    


    ...

    


    package My::App::Controller::Root;

    use base qw( Catalyst::Controller );

    sub search : Private {
        my ($self, $c) = @_;
        my $searchTerms = $c->req->param('searchTerms');
        # yadda, yadda, yadda...
    }

    


    


    ...

    


    


    French:

        Requested as:
            GET /recherche?terms_de_recherche=Pirates HTTP/1.0
            Accept-Language: fr

        Dispatched as:
            GET /search?searchTerms=Pirates HTTP/1.0
            Accept-Language: fr

        $c->uri_for('/search'):
            http://localhost/recherche

    German:

        Requested as:
            GET /suche?searchTerms=Pirates HTTP/1.0
            Accept-Language: de

        Dispatched as:
            GET /search?searchTerms=Pirates HTTP/1.0
            Accept-Language: de    

        $c->uri_for('/search'):
            http://localhost/suche

    


    

    'recherche' (French requests)
    'suche'     (German requests)
     etc... 

    Key                       | Localized text  | Language
    ==========================================================
    PATH_delocalize_recherche | search          | French
    PATH_delocalize_suche     | search          | German

    Key                  | Localized text  | Language
    ==========================================================
    PATH_localize_search | recherche       | French
    PATH_localize_search | suche           | German

package Catalyst::Plugin::I18N::Request;

use strict;
use warnings;

use MRO::Compat;
use URI;
use URI::QueryParam;
use utf8;
use Scalar::Util ();

our $VERSION = '0.05';

sub setup {
    my $self = shift;
    $self->next::method( @_ );
    
    no strict 'refs';
    no warnings 'redefine';
    
    my $uri_with = \&Catalyst::Request::uri_with;
    
    *Catalyst::Request::uri_with = sub {
        my ($request) = @_;
        my $uri = $uri_with->( @_ );
        
        return $request->{_context}->localize_uri( $uri );
    };
}

sub uri_for {
    my $c = shift;
    $c->localize_uri( $c->next::method( @_ ) );
}

sub localize_uri {
    my ($c, $uri) = @_;
    return undef unless defined $uri;
    
    $uri = URI->new( $uri ) unless Scalar::Util::blessed( $uri );
    
    # parameters
    my $query_form = $uri->query_form_hash;
    
    # decode all strings for character logic rather than byte logic
    for my $value ( values %$query_form ) {
        for ( ref $value eq 'ARRAY' ? @$value : $value ) {
            $_ = "$_";
            utf8::decode( $_ );
        }
    }
    
    # localize the parameters
    my $parameters = $c->localize_parameters( $query_form );
    
    # encode all strings for byte logic rather than character logic
    for my $value ( values %$parameters ) {
        for ( ref $value eq 'ARRAY' ? @$value : $value ) {
            $_ = "$_";
            utf8::encode( $_ );
        }
    }
    
    $uri->query_form_hash( $parameters );
    
    # path
    $uri->path( $c->localize_path( $uri->path ) );
    
    return $uri;
}

sub localize_path {
    my ($c, $path) = @_;
    return undef unless defined $path;
    return join '/', map { $c->localize_path_component( $_ ) } split m!/!, $path;
}

sub delocalize_path {
    my ($c, $path) = @_;
    return undef unless defined $path;
    return join '/', map { $c->delocalize_path_component( $_ ) } split m!/!, $path;
}

sub transform_parameters {
    my ($c, $parameters, $transformer) = @_;
    my %parameters = ref $parameters eq 'HASH' ? %$parameters : ();
    
    my %transformed;
    for ( keys %parameters ) {
        my $name  = ref $transformer eq 'CODE' ? $transformer->( $c, $_ )
                  : $c->can($transformer)      ? $c->$transformer( $_ )
                  : $_;
        
        my $value = $parameters{ $_ };
        
        if ( exists $transformed{$name} ) {
            if ( ref $transformed{$name} eq 'ARRAY' ) {
                push @{ $transformed{$name} }, ref $value eq 'ARRAY' ? @$value : $value;
            }
            else {
                $transformed{$name} = [ $transformed{$name}, ref $value eq 'ARRAY' ? @$value : $value ];
            }
        }
        else {
            $transformed{$name} = $value;
        }
    }
    
    return wantarray ? %transformed : \%transformed;
}

sub localize_parameters {
    my $c = shift;
    my %parameters = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    $c->transform_parameters( \%parameters, 'localize_parameter_name' );
}

sub delocalize_parameters {
    my $c = shift;
    my %parameters = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    $c->transform_parameters( \%parameters, 'delocalize_parameter_name' );
}

sub prepare_path {
    my $c = shift;
    $c->next::method( @_ );
    $c->req->path( $c->delocalize_path( $c->req->path ) );
}

sub prepare_parameters {
    my $c = shift;
    $c->next::method( @_ );
    
    my %parameters = $c->delocalize_parameters( $c->request->params );
    
    $c->request->uri->query_form( \%parameters );
    $c->request->params( \%parameters );
}

sub localize_path_component {
    my ($c, $delocalized) = @_;
    return undef unless defined $delocalized;
    
    if ( $c->can('localize') ) {
        my $key = "PATH_localize_$delocalized";
        my $localized = $c->localize($key);
        return $localized unless $localized eq $key;
    }
    
    return $delocalized;
}

sub delocalize_path_component {
    my ($c, $localized) = @_;
    return undef unless defined $localized;
    
    if ( $c->can('localize') ) {
        my $key = "PATH_delocalize_$localized";
        my $delocalized = $c->localize($key);
        return $delocalized unless $delocalized eq $key;
    }
    
    return $localized;
}

sub localize_parameter_name {
    my ($c, $delocalized) = @_;
    return undef unless defined $delocalized;
    
    if ( $c->can('localize') ) {
        my $key = "PARAMETER_localize_$delocalized";
        my $localized = $c->localize($key);
        return $localized unless $localized eq $key;
    }
    
    return $delocalized;
}

sub delocalize_parameter_name {
    my ($c, $localized) = @_;
    return undef unless defined $localized;
    
    if ( $c->can('localize') ) {
        my $key = "PARAMETER_delocalize_$localized";
        my $delocalized = $c->localize($key);
        return $delocalized unless $delocalized eq $key;
    }
    
    return $localized;
}

1;