--- /dev/null
+use strict;
+
+use Module::Build;
+
+my $build = Module::Build->new(
+ module_name => 'URI::Template',
+ dist_author => 'Brian Cassidy <brian.cassidy@nald.ca>',
+ license => 'perl',
+ create_readme => 1,
+ create_makefile_pl => 'traditional',
+ requires => {
+ 'URI' => 0,
+ },
+ build_requres => {
+ 'Test::More' => 0,
+ }
+);
+
+$build->create_build_script;
--- /dev/null
+Revision history for Perl extension URI::Template
+
+0.04 Mon Jan 22 2007
+ - fix undef values when processing
+
+0.03 Tue Jan 16 2007
+ - added a simple deparse() method
+
+0.02 Tue Jan 16 2007
+ - added process_to_string() method
+
+0.01 Mon Jan 15 2007
+ - original version
+
--- /dev/null
+Build.PL
+Changes
+lib/URI/Template.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/01-use.t
+t/10-basic.t
+t/20-deparse.t
+t/98-pod.t
+t/99-podcoverage.t
--- /dev/null
+---
+name: URI-Template
+version: 0.04
+author:
+ - 'Brian Cassidy <brian.cassidy@nald.ca>'
+abstract: Object for handling URI templates
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ URI: 0
+provides:
+ URI::Template:
+ file: lib/URI/Template.pm
+ version: 0.04
+generated_by: Module::Build version 0.2805
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
--- /dev/null
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'URI::Template',
+ 'EXE_FILES' => [],
+ 'VERSION_FROM' => 'lib/URI/Template.pm',
+ 'PREREQ_PM' => {
+ 'URI' => 0
+ }
+ )
+;
--- /dev/null
+NAME
+ URI::Template - Object for handling URI templates
+
+SYNOPSIS
+ use URI::Template;
+ my $template = URI::Template->new( 'http://example.com/{x}' );
+ my $uri = $template->process( x => 'y' );
+ # uri is a URI object with value 'http://example.com/y'
+
+ my %result = $template->deparse( $uri );
+ # %result is ( x => 'y' )
+
+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
+
+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
+
+METHODS
+ new( $template )
+ Creates a new URI::Template instance with the template passed in as the
+ first parameter.
+
+ as_string( )
+ Returns the original template string. Also used when the object is
+ stringified.
+
+ variables( )
+ Returns an array of variable names found in the template.
+
+ process( %vars )
+ Given a list of key-value pairs, it will URI escape the values and
+ substitute them in to the template. Returns a URI object.
+
+ process_to_string( %vars )
+ Processes key-values pairs like the "process" method, but doesn't
+ inflate the result to a URI object.
+
+ deparse( $uri )
+ Does some rudimentary deparsing of a uri based on the current template.
+ Returns a hash with the extracted values.
+
+AUTHOR
+ * Brian Cassidy <bricas@cpan.org>
+
+COPYRIGHT AND LICENSE
+ Copyright 2007 by Brian Cassidy
+
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
--- /dev/null
+package URI::Template;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.04';
+
+use URI;
+use URI::Escape ();
+use overload '""' => \&as_string;
+
+=head1 NAME
+
+URI::Template - Object for handling URI templates
+
+=head1 SYNOPSIS
+
+ use URI::Template;
+ my $template = URI::Template->new( 'http://example.com/{x}' );
+ my $uri = $template->process( x => 'y' );
+ # uri is a URI object with value 'http://example.com/y'
+
+ my %result = $template->deparse( $uri );
+ # %result is ( x => 'y' )
+
+=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
+
+=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
+
+=head1 METHODS
+
+=head2 new( $template )
+
+Creates a new L<URI::Template> instance with the template passed in
+as the first parameter.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $templ = shift || die 'No template provided';
+ my $self = bless { template => $templ }, $class;
+
+ return $self;
+}
+
+=head2 as_string( )
+
+Returns the original template string. Also used when the object is
+stringified.
+
+=cut
+
+sub as_string {
+ return $_[ 0 ]->{ template };
+}
+
+=head2 variables( )
+
+Returns an array of variable names found in the template.
+
+=cut
+
+sub variables {
+ my $self = shift;
+ my %vars = map { $_ => 1 } $self->as_string =~ /{(.+?)}/g;
+ return keys %vars;
+}
+
+=head2 process( %vars )
+
+Given a list of key-value pairs, it will URI escape the values and
+substitute them in to the template. Returns a URI object.
+
+=cut
+
+sub process {
+ my $self = shift;
+ return URI->new( $self->process_to_string( @_ ) );
+}
+
+=head2 process_to_string( %vars )
+
+Processes key-values pairs like the C<process> method, but doesn't
+inflate the result to a URI object.
+
+=cut
+
+sub process_to_string {
+ my $self = shift;
+ my @vars = $self->variables;
+ my %params = @_;
+ my $uri = $self->as_string;
+
+ # fix undef vals
+ for my $var ( @vars ) {
+ $params{ $var } = '' unless defined $params{ $var };
+ }
+
+ my $regex = '\{(' . join( '|', map quotemeta, @vars ) . ')\}';
+ $uri =~ s/$regex/URI::Escape::uri_escape($params{$1})/eg;
+
+ return $uri;
+}
+
+=head2 deparse( $uri )
+
+Does some rudimentary deparsing of a uri based on the current template.
+Returns a hash with the extracted values.
+
+=cut
+
+sub deparse {
+ my $self = shift;
+ my $uri = shift;
+
+ my $templ = $self->as_string;
+ my @vars = $templ =~ /{(.+?)}/g;
+ $templ =~ s/{.+?}/(.+?)/g;
+ my @matches = $uri =~ /$templ/;
+
+ my %results;
+ @results{ @vars } = @matches;
+ return %results;
+}
+
+=head1 AUTHOR
+
+=over 4
+
+=item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Brian Cassidy
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
--- /dev/null
+use Test::More tests => 1;
+
+use strict;
+use warnings;
+
+use_ok( 'URI::Template' );
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 13;
+
+use_ok( 'URI::Template' );
+
+{
+ my $text = 'http://foo.com/{bar}/{baz}?q=%7B';
+ my $template = URI::Template->new( $text );
+ isa_ok( $template, 'URI::Template' );
+ is_deeply( [ $template->variables ], [ qw( bar baz ) ], 'variables()' );
+ is( "$template", $text, 'as_string()' );
+
+ {
+ my $result = $template->process( bar => 'x', baz => 'y' );
+ is( $result, 'http://foo.com/x/y?q=%7B', 'process()' );
+ isa_ok( $result, 'URI', 'return value from process() isa URI' );
+ }
+ {
+ my $result = $template->process_to_string( bar => 'x', baz => 'y' );
+ is( $result, 'http://foo.com/x/y?q=%7B', 'process_to_string()' );
+ ok( !ref $result, 'result is not a ref' );
+ }
+}
+
+{
+ my $template = URI::Template->new( 'http://foo.com/{z(}/' );
+ my $result = $template->process( 'z(' => 'x' );
+ is( $result, 'http://foo.com/x/', 'potential regex issue escaped' );
+}
+
+{
+ my $template = URI::Template->new( 'http://foo.com/{z}/' );
+ {
+ my $result = $template->process( 'z' => '{x}' );
+ is( $result, 'http://foo.com/%7Bx%7D/', 'values are uri escaped' );
+ }
+ {
+ my $result = $template->process( );
+ is( $result, 'http://foo.com//', 'no value sent' );
+ }
+}
+
+{
+ my $template = URI::Template->new( 'http://foo.com/{z}/{z}/' );
+ is_deeply( [ $template->variables ], [ 'z' ], 'unique vars' );
+ my $result = $template->process( 'z' => 'x' );
+ is( $result, 'http://foo.com/x/x/', 'multiple replaces' );
+}
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use_ok( 'URI::Template' );
+
+{
+ my $template = URI::Template->new( 'http://{domain}.com/{dir}/{file}.html' );
+ isa_ok( $template, 'URI::Template' );
+ my %result = $template->deparse( 'http://example.com/test/1.html' );
+ is_deeply( \%result, { domain => 'example', dir => 'test', file => '1' }, 'deparse()' );
+}
+
+{
+ my $template = URI::Template->new( 'http://test.com/{x}/{y}/{x}/{y}' );
+ isa_ok( $template, 'URI::Template' );
+ my %result = $template->deparse( 'http://test.com/1/2/1/2' );
+ is_deeply( \%result, { x => 1, y => 2 }, 'deparse() with multiple values' );
+}
+
+{
+ my $template = URI::Template->new( 'http://ex.com/{x}' );
+ isa_ok( $template, 'URI::Template' );
+ my %input = ( x => 'y' );
+ my $uri = $template->process( x => 'y' );
+ is( $uri, 'http://ex.com/y' );
+ my %result = $template->deparse( $uri );
+ is_deeply( \%result, \%input, 'process => deparse' );
+}
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
projects / liburi-template-perl.git / commitdiff