use strict;
use warnings;
-our $VERSION = '0.04';
+our $VERSION = '0.09';
use URI;
use URI::Escape ();
use overload '""' => \&as_string;
+my $unsafe = q(^A-Za-z0-9\-_.~!\$\&'()*+,;=:/?\[\]#@);
+
=head1 NAME
URI::Template - Object for handling URI templates
=head1 DESCRIPTION
This is an initial attempt to provide a wrapper around URI templates
-as described at http://www.ietf.org/internet-drafts/draft-gregorio-uritemplate-00.txt
+as described at http://www.ietf.org/internet-drafts/draft-gregorio-uritemplate-01.txt
=head1 INSTALLATION
-To install this module via Module::Build:
-
- perl Build.PL
- ./Build # or `perl Build`
- ./Build test # or `perl Build test`
- ./Build install # or `perl Build install`
-
-To install this module via ExtUtils::MakeMaker:
-
- perl Makefile.PL
- make
- make test
- make install
+ perl Makefile.PL
+ make
+ make test
+ make install
=head1 METHODS
=head2 variables( )
-Returns an array of variable names found in the template.
+Returns an array of unique variable names found in the template.
+NB: they are returned in random order.
=cut
sub variables {
my $self = shift;
- my %vars = map { $_ => 1 } $self->as_string =~ /{(.+?)}/g;
+ my %vars = map { $_ => 1 } $self->all_variables;
return keys %vars;
}
-=head2 process( %vars )
+=head2 all_variables( )
+
+Returns an array of variable names found as they appear in template --
+in order, duplicates included.
+
+=cut
+
+sub all_variables {
+ my $self = shift;
+ my @vars = $self->as_string =~ /{(.+?)}/g;
+ return @vars;
+}
+
+=head2 process( %vars|\@values )
-Given a list of key-value pairs, it will URI escape the values and
+Given a list of key-value pairs or an array ref of values (for
+positional substitution), it will URI escape the values and
substitute them in to the template. Returns a URI object.
=cut
return URI->new( $self->process_to_string( @_ ) );
}
-=head2 process_to_string( %vars )
+=head2 process_to_string( %vars|\@values )
-Processes key-values pairs like the C<process> method, but doesn't
+Processes input like the C<process> method, but doesn't
inflate the result to a URI object.
=cut
sub process_to_string {
+ my $self = shift;
+
+ if( ref $_[ 0 ] ) {
+ return $self->_process_by_position( @_ );
+ }
+ else {
+ return $self->_process_by_key( @_ );
+ }
+}
+
+sub _process_by_key {
my $self = shift;
my @vars = $self->variables;
my %params = @_;
# fix undef vals
for my $var ( @vars ) {
- $params{ $var } = '' unless defined $params{ $var };
+ $params{ $var } = defined $params{ $var }
+ ? URI::Escape::uri_escape( $params{ $var }, $unsafe )
+ : '';
}
my $regex = '\{(' . join( '|', map quotemeta, @vars ) . ')\}';
- $uri =~ s/$regex/URI::Escape::uri_escape($params{$1})/eg;
+ $uri =~ s/$regex/$params{$1}/eg;
+
+ return $uri;
+}
+
+sub _process_by_position {
+ my $self = shift;
+ my @params = @{ $_[ 0 ] };
+
+ my $uri = $self->as_string;
+
+ $uri =~ s/{(.+?)}/@params
+ ? defined $params[ 0 ]
+ ? URI::Escape::uri_escape( shift @params, $unsafe )
+ : ''
+ : ''/eg;
return $uri;
}
my $self = shift;
my $uri = shift;
- my $templ = $self->as_string;
- my @vars = $templ =~ /{(.+?)}/g;
- $templ =~ s/{.+?}/(.+?)/g;
- my @matches = $uri =~ /$templ/;
+ if( !$self->{ deparse_re } ) {
+ my $templ = $self->as_string;
+ $self->{ vars_list } = [ $templ =~ /{(.+?)}/g ];
+ $templ =~ s/{.+?}/(.+?)/g;
+ $self->{ deparse_re } = qr/$templ/;
+ }
+
+ my @matches = $uri =~ $self->{ deparse_re };
my %results;
- @results{ @vars } = @matches;
+ @results{ @{ $self->{ vars_list } } } = @matches;
return %results;
}
=head1 AUTHOR
-=over 4
-
-=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
-
-=back
+Brian Cassidy E<lt>bricas@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE