lib/URI/Template.pm

   1 package URI::Template;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.04';
   7
   8 use URI;
   9 use URI::Escape ();
  10 use overload '""' => \&as_string;
  11
  12 =head1 NAME
  13
  14 URI::Template - Object for handling URI templates
  15
  16 =head1 SYNOPSIS
  17
  18     use URI::Template;
  19     my $template = URI::Template->new( 'http://example.com/{x}' );
  20     my $uri      = $template->process( x => 'y' );
  21     # uri is a URI object with value 'http://example.com/y'
  22
  23     my %result = $template->deparse( $uri );
  24     # %result is ( x => 'y' )
  25
  26 =head1 DESCRIPTION
  27
  28 This is an initial attempt to provide a wrapper around URI templates
  29 as described at http://www.ietf.org/internet-drafts/draft-gregorio-uritemplate-00.txt
  30
  31 =head1 INSTALLATION
  32
  33 To install this module via Module::Build:
  34
  35         perl Build.PL
  36         ./Build         # or `perl Build`
  37         ./Build test    # or `perl Build test`
  38         ./Build install # or `perl Build install`
  39
  40 To install this module via ExtUtils::MakeMaker:
  41
  42         perl Makefile.PL
  43         make
  44         make test
  45         make install
  46
  47 =head1 METHODS
  48
  49 =head2 new( $template )
  50
  51 Creates a new L<URI::Template> instance with the template passed in
  52 as the first parameter.
  53
  54 =cut
  55
  56 sub new {
  57     my $class = shift;
  58     my $templ = shift || die 'No template provided';
  59     my $self  = bless { template => $templ }, $class;
  60
  61     return $self;
  62 }
  63
  64 =head2 as_string( )
  65
  66 Returns the original template string. Also used when the object is
  67 stringified.
  68
  69 =cut
  70
  71 sub as_string {
  72     return $_[ 0 ]->{ template };
  73 }
  74
  75 =head2 variables( )
  76
  77 Returns an array of variable names found in the template.
  78
  79 =cut
  80
  81 sub variables {
  82     my $self = shift;
  83     my %vars = map { $_ => 1 } $self->as_string =~ /{(.+?)}/g;
  84     return keys %vars;
  85 }
  86
  87 =head2 process( %vars )
  88
  89 Given a list of key-value pairs, it will URI escape the values and
  90 substitute them in to the template. Returns a URI object.
  91
  92 =cut
  93
  94 sub process {
  95     my $self = shift;
  96     return URI->new( $self->process_to_string( @_ ) );
  97 }
  98
  99 =head2 process_to_string( %vars )
 100
 101 Processes key-values pairs like the C<process> method, but doesn't
 102 inflate the result to a URI object.
 103
 104 =cut
 105
 106 sub process_to_string {
 107     my $self   = shift;
 108     my @vars   = $self->variables;
 109     my %params = @_;
 110     my $uri    = $self->as_string;
 111
 112     # fix undef vals
 113     for my $var ( @vars ) {
 114         $params{ $var } = '' unless defined $params{ $var };
 115     }
 116
 117     my $regex = '\{(' . join( '|', map quotemeta, @vars ) . ')\}';
 118     $uri =~ s/$regex/URI::Escape::uri_escape($params{$1})/eg;
 119
 120     return $uri;
 121 }
 122
 123 =head2 deparse( $uri )
 124
 125 Does some rudimentary deparsing of a uri based on the current template.
 126 Returns a hash with the extracted values.
 127
 128 =cut
 129
 130 sub deparse {
 131     my $self = shift;
 132     my $uri  = shift;
 133
 134     my $templ = $self->as_string;
 135     my @vars  = $templ =~ /{(.+?)}/g;
 136     $templ =~ s/{.+?}/(.+?)/g;
 137     my @matches = $uri =~ /$templ/;
 138
 139     my %results;
 140     @results{ @vars } = @matches;
 141     return %results;
 142 }
 143
 144 =head1 AUTHOR
 145
 146 =over 4
 147
 148 =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 149
 150 =back
 151
 152 =head1 COPYRIGHT AND LICENSE
 153
 154 Copyright 2007 by Brian Cassidy
 155
 156 This library is free software; you can redistribute it and/or modify
 157 it under the same terms as Perl itself.
 158
 159 =cut
 160
 161 1;