From: Ian Beckwith Date: Sat, 1 Mar 2008 00:28:17 +0000 (+0000) Subject: Imported upstream version 0.04 X-Git-Tag: upstream/0.04^0 X-Git-Url: http://erislabs.net/gitweb/?p=liburi-template-perl.git;a=commitdiff_plain;h=3f3d56e5fb9a55ee113ccf2bc03f3a453f80baa0 Imported upstream version 0.04 --- 3f3d56e5fb9a55ee113ccf2bc03f3a453f80baa0 diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..64f730e --- /dev/null +++ b/Build.PL @@ -0,0 +1,19 @@ +use strict; + +use Module::Build; + +my $build = Module::Build->new( + module_name => 'URI::Template', + dist_author => 'Brian Cassidy ', + license => 'perl', + create_readme => 1, + create_makefile_pl => 'traditional', + requires => { + 'URI' => 0, + }, + build_requres => { + 'Test::More' => 0, + } +); + +$build->create_build_script; diff --git a/Changes b/Changes new file mode 100644 index 0000000..5bc9507 --- /dev/null +++ b/Changes @@ -0,0 +1,14 @@ +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 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..dd9981e --- /dev/null +++ b/MANIFEST @@ -0,0 +1,12 @@ +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 diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..512e107 --- /dev/null +++ b/META.yml @@ -0,0 +1,19 @@ +--- +name: URI-Template +version: 0.04 +author: + - 'Brian Cassidy ' +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 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..e9124c2 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,14 @@ +# 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 + } + ) +; diff --git a/README b/README new file mode 100644 index 0000000..75f354a --- /dev/null +++ b/README @@ -0,0 +1,65 @@ +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 + +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. + diff --git a/lib/URI/Template.pm b/lib/URI/Template.pm new file mode 100644 index 0000000..54ea7d2 --- /dev/null +++ b/lib/URI/Template.pm @@ -0,0 +1,161 @@ +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 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 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 Ebricas@cpan.orgE + +=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; diff --git a/t/01-use.t b/t/01-use.t new file mode 100644 index 0000000..ac9ebf8 --- /dev/null +++ b/t/01-use.t @@ -0,0 +1,7 @@ +use Test::More tests => 1; + +use strict; +use warnings; + +use_ok( 'URI::Template' ); + diff --git a/t/10-basic.t b/t/10-basic.t new file mode 100644 index 0000000..29c19aa --- /dev/null +++ b/t/10-basic.t @@ -0,0 +1,51 @@ +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' ); +} + diff --git a/t/20-deparse.t b/t/20-deparse.t new file mode 100644 index 0000000..fd112e0 --- /dev/null +++ b/t/20-deparse.t @@ -0,0 +1,30 @@ +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' ); +} diff --git a/t/98-pod.t b/t/98-pod.t new file mode 100644 index 0000000..251640d --- /dev/null +++ b/t/98-pod.t @@ -0,0 +1,9 @@ +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(); diff --git a/t/99-podcoverage.t b/t/99-podcoverage.t new file mode 100644 index 0000000..ae59d4c --- /dev/null +++ b/t/99-podcoverage.t @@ -0,0 +1,9 @@ +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();