view release on metacpan or  search on metacpan

lib/URI/Template.pm  view on Meta::CPAN

package URI::Template;

use strict;
use warnings;

our $VERSION = '0.24';

use URI;
use URI::Escape        ();
use Unicode::Normalize ();
use overload '""' => \&template;

use Exporter 'import';

our @EXPORT = qw ( );

our @EXPORT_OK = qw (
    template_process
    template_process_to_string
);

our %EXPORT_TAGS = (
    'all' => \@EXPORT_OK,
);

my $RESERVED = q(:/?#\[\]\@!\$\&'\(\)\*\+,;=);
my %TOSTRING = (
    ''  => \&_tostring,
    '+' => \&_tostring,
    '#' => \&_tostring,
    ';' => \&_tostring_semi,
    '?' => \&_tostring_query,
    '&' => \&_tostring_query,
    '/' => \&_tostring_path,
    '.' => \&_tostring_path,
);

sub new {
    my $class = shift;
    my $templ = shift;
    $templ = '' unless defined $templ;
    my $self  = bless { template => $templ, _vars => {} } => $class;

    $self->_study;

    return $self;
}

sub _quote {
    my ( $val, $safe ) = @_;
    $safe ||= '';
    my $unsafe = '^A-Za-z0-9\-\._' . $safe;

    ## Where RESERVED are allowed to pass-through, so are
    ## already-pct-encoded values
    if( $safe ) {
        my (@chunks) = split(/(%[0-9A-Fa-f]{2})/, $val);

        # even chunks are not %xx, odd chunks are
        return join '',
            map { $_ % 2
                  ? $chunks[$_]
                  : URI::Escape::uri_escape_utf8( Unicode::Normalize::NFKC($chunks[$_]), $unsafe ) } 0..$#chunks;

    }

    # try to mirror python's urllib quote
    return URI::Escape::uri_escape_utf8( Unicode::Normalize::NFKC( $val ),
        $unsafe );
}

sub _tostring {
    my ( $var, $value, $exp ) = @_;
    my $safe = $exp->{ safe };

    if ( ref $value eq 'ARRAY' ) {
        return join( ',', map { _quote( $_, $safe ) } @$value );
    }
    elsif ( ref $value eq 'HASH' ) {
        return join(
            ',',
            map {
                _quote( $_, $safe )
                    . ( $var->{ explode } ? '=' : ',' )
                    . _quote( $value->{ $_ }, $safe )
                } sort keys %$value
        );
    }
    elsif ( defined $value ) {
        return _quote(
            substr( $value, 0, $var->{ prefix } || length( $value ) ),
            $safe );
    }

    return;
}

sub _tostring_semi {
    my ( $var, $value, $exp ) = @_;
    my $safe = $exp->{ safe };
    my $join = $exp->{ op };
    $join = '&' if $exp->{ op } eq '?';