10 use Unicode::Normalize ();
11 use overload '""' => \&template;
13 my $RESERVED = q(:/?#\[\]\@!\$\&'\(\)\*\+,;=);
18 ';' => \&_tostring_semi,
19 '?' => \&_tostring_query,
20 '&' => \&_tostring_query,
21 '/' => \&_tostring_path,
22 '.' => \&_tostring_path,
28 $templ = '' unless defined $templ;
29 my $self = bless { template => $templ, _vars => {} } => $class;
37 my ( $val, $safe ) = @_;
40 # try to mirror python's urllib quote
41 my $unsafe = '^A-Za-z0-9\-\._' . $safe;
42 return URI::Escape::uri_escape_utf8( Unicode::Normalize::NFKC( $val ),
47 my ( $var, $value, $exp ) = @_;
48 my $safe = $exp->{ safe };
50 if ( ref $value eq 'ARRAY' ) {
51 return join( ',', map { _quote( $_, $safe ) } @$value );
53 elsif ( ref $value eq 'HASH' ) {
58 . ( $var->{ explode } ? '=' : ',' )
59 . _quote( $value->{ $_ }, $safe )
63 elsif ( defined $value ) {
65 substr( $value, 0, $var->{ prefix } || length( $value ) ),
73 my ( $var, $value, $exp ) = @_;
74 my $safe = $exp->{ safe };
75 my $join = $exp->{ op };
76 $join = '&' if $exp->{ op } eq '?';
78 if ( ref $value eq 'ARRAY' ) {
79 if ( $var->{ explode } ) {
81 map { $var->{ name } . '=' . _quote( $_, $safe ) } @$value );
84 return $var->{ name } . '='
85 . join( ',', map { _quote( $_, $safe ) } @$value );
88 elsif ( ref $value eq 'HASH' ) {
89 if ( $var->{ explode } ) {
93 _quote( $_, $safe ) . '='
94 . _quote( $value->{ $_ }, $safe )
99 return $var->{ name } . '=' . join(
102 _quote( $_, $safe ) . ','
103 . _quote( $value->{ $_ }, $safe )
108 elsif ( defined $value ) {
109 return $var->{ name } unless length( $value );
113 substr( $value, 0, $var->{ prefix } || length( $value ) ),
120 sub _tostring_query {
121 my ( $var, $value, $exp ) = @_;
122 my $safe = $exp->{ safe };
123 my $join = $exp->{ op };
124 $join = '&' if $exp->{ op } =~ /[?&]/;
126 if ( ref $value eq 'ARRAY' ) {
128 if ( $var->{ explode } ) {
130 map { $var->{ name } . '=' . _quote( $_, $safe ) } @$value );
133 return $var->{ name } . '='
134 . join( ',', map { _quote( $_, $safe ) } @$value );
137 elsif ( ref $value eq 'HASH' ) {
138 return if !keys %$value;
139 if ( $var->{ explode } ) {
143 _quote( $_, $safe ) . '='
144 . _quote( $value->{ $_ }, $safe )
149 return $var->{ name } . '=' . join(
152 _quote( $_, $safe ) . ','
153 . _quote( $value->{ $_ }, $safe )
158 elsif ( defined $value ) {
159 return $var->{ name } . '=' unless length( $value );
163 substr( $value, 0, $var->{ prefix } || length( $value ) ),
169 my ( $var, $value, $exp ) = @_;
170 my $safe = $exp->{ safe };
171 my $join = $exp->{ op };
173 if ( ref $value eq 'ARRAY' ) {
174 return unless @$value;
176 ( $var->{ explode } ? $join : ',' ),
177 map { _quote( $_, $safe ) } @$value
180 elsif ( ref $value eq 'HASH' ) {
182 ( $var->{ explode } ? $join : ',' ),
185 . ( $var->{ explode } ? '=' : ',' )
186 . _quote( $value->{ $_ }, $safe )
190 elsif ( defined $value ) {
192 substr( $value, 0, $var->{ prefix } || length( $value ) ),
201 my @hunks = grep { defined && length } split /(\{.+?\})/, $self->template;
204 next unless /^\{(.+?)\}$/;
205 $_ = $self->_compile_expansion( $1, $pos++ );
207 $self->{ studied } = \@hunks;
210 sub _compile_expansion {
211 my ( $self, $str, $pos ) = @_;
213 my %exp = ( op => '', vars => [], str => $str );
214 if ( $str =~ /^([+#.\/;?&|!\@])(.+)/ ) {
219 $exp{ safe } = $RESERVED if $exp{ op } =~ m{[+#]};
221 for my $varspec ( split( ',', delete $exp{ str } ) ) {
222 my %var = ( name => $varspec );
223 if ( $varspec =~ /=/ ) {
224 @var{ 'name', 'default' } = split( /=/, $varspec, 2 );
226 if ( $var{ name } =~ s{\*$}{} ) {
229 elsif ( $var{ name } =~ /:/ ) {
230 @var{ 'name', 'prefix' } = split( /:/, $var{ name }, 2 );
231 if ( $var{ prefix } =~ m{[^0-9]} ) {
232 die 'Non-numeric prefix specified';
236 # remove "optional" flag (for opensearch compatibility)
237 $var{ name } =~ s{\?$}{};
238 $self->{ _vars }->{ $var{ name } } = $pos;
240 push @{ $exp{ vars } }, \%var;
243 my $join = $exp{ op };
244 my $start = $exp{ op };
246 if ( $exp{ op } eq '+' ) {
250 elsif ( $exp{ op } eq '#' ) {
253 elsif ( $exp{ op } eq '?' ) {
256 elsif ( $exp{ op } eq '&' ) {
259 elsif ( $exp{ op } eq '' ) {
263 if ( !exists $TOSTRING{ $exp{ op } } ) {
264 die 'Invalid operation "' . $exp{ op } . '"';
268 my $variables = shift;
271 for my $var ( @{ $exp{ vars } } ) {
273 if ( exists $variables->{ $var->{ name } } ) {
274 $value = $variables->{ $var->{ name } };
276 $value = $var->{ default } if !defined $value;
278 next unless defined $value;
280 my $expand = $TOSTRING{ $exp{ op } }->( $var, $value, \%exp );
282 push @return, $expand if defined $expand;
285 return $start . join( $join, @return ) if @return;
295 if ( defined $templ && $templ ne $self->{ template } ) {
296 $self->{ template } = $templ;
297 $self->{ _vars } = {};
302 return $self->{ template };
306 return sort {$_[ 0 ]->{ _vars }->{ $a } <=> $_[ 0 ]->{ _vars }->{ $b } } keys %{ $_[ 0 ]->{ _vars } };
311 return grep { ref } @{ $self->{ studied } };
316 return URI->new( $self->process_to_string( @_ ) );
319 sub process_to_string {
321 my $arg = @_ == 1 ? $_[ 0 ] : { @_ };
324 for my $hunk ( @{ $self->{ studied } } ) {
325 if ( !ref $hunk ) { $str .= $hunk; next; }
327 $str .= $hunk->( $arg );
339 URI::Template - Object for handling URI templates (RFC 6570)
345 my $template = URI::Template->new( 'http://example.com/{x}' );
346 my $uri = $template->process( x => 'y' );
350 my $template = URI::Template->new();
351 $template->template( 'http://example.com/{x}' );
352 my $uri = $template->process( x => 'y' );
354 # uri is a URI object with value 'http://example.com/y'
358 This module provides a wrapper around URI templates as described in RFC 6570:
359 L<< http://tools.ietf.org/html/rfc6570 >>.
370 =head2 new( $template )
372 Creates a new L<URI::Template> instance with the template passed in
373 as the first parameter (optional).
375 =head2 template( $template )
377 This method returns the original template string. If provided, it will also set and parse a
382 Returns an array of unique variable names found in the template (in the order of appearance).
386 This method returns an list of expansions found in the template. Currently,
387 these are just coderefs. In the future, they will be more interesting.
389 =head2 process( \%vars )
391 Given a list of key-value pairs or an array ref of values (for
392 positional substitution), it will URI escape the values and
393 substitute them in to the template. Returns a URI object.
395 =head2 process_to_string( \%vars )
397 Processes input like the C<process> method, but doesn't inflate the result to a
404 =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
406 =item * Ricardo SIGNES E<lt>rjbs@cpan.orgE<gt>
410 =head1 COPYRIGHT AND LICENSE
412 Copyright 2007-2015 by Brian Cassidy
414 This library is free software; you can redistribute it and/or modify
415 it under the same terms as Perl itself.