view release on metacpan or  search on metacpan

lib/Catalyst/Plugin/I18N/Request.pm  view on Meta::CPAN

and query values.

=cut

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

=head2 localize_uri ( $uri )

Localizes a URI using the current context.

=cut

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

=head2 localize_path ( $path )

Localizes all components of the provided path. 

=cut

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

=head2 delocalize_path ( $path )

Delocalizes all components of the provided path.

=cut

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

=head2 transform_parameters ( \%parameters, $transformer )

Transforms the given parameter names using the given transformer. The 
transformer may be one of the following:

=over 4

=item * A CODE reference which accepts the context object as the first 
        argument and a parameter name as the second argument. 

=item * The name of a particular accessor that can be called on the 
        context object, accepting a parameter name as the argument. 

=back

=cut

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

=head2 localize_parameters ( \%parameters )

Localizes the keys within a hash of parameters. 

=cut

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