lib/URI/Template.pm

   1 package URI::Template;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.06';
   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. NB: they
  78 are returned in random order.
  79
  80 =cut
  81
  82 sub variables {
  83     my $self = shift;
  84     my %vars = map { $_ => 1 } $self->as_string =~ /{(.+?)}/g;
  85     return keys %vars;
  86 }
  87
  88 =head2 process( %vars )
  89
  90 Given a list of key-value pairs, it will URI escape the values and
  91 substitute them in to the template. Returns a URI object.
  92
  93 =cut
  94
  95 sub process {
  96     my $self = shift;
  97     return URI->new( $self->process_to_string( @_ ) );
  98 }
  99
 100 =head2 process_to_string( %vars )
 101
 102 Processes key-values pairs like the C<process> method, but doesn't
 103 inflate the result to a URI object.
 104
 105 =cut
 106
 107 sub process_to_string {
 108     my $self   = shift;
 109     my @vars   = $self->variables;
 110     my %params = @_;
 111     my $uri    = $self->as_string;
 112
 113     # fix undef vals
 114     for my $var ( @vars ) {
 115         $params{ $var } = '' unless defined $params{ $var };
 116     }
 117
 118     my $regex = '\{(' . join( '|', map quotemeta, @vars ) . ')\}';
 119     $uri =~ s/$regex/URI::Escape::uri_escape($params{$1})/eg;
 120
 121     return $uri;
 122 }
 123
 124 =head2 deparse( $uri )
 125
 126 Does some rudimentary deparsing of a uri based on the current template.
 127 Returns a hash with the extracted values.
 128
 129 =cut
 130
 131 sub deparse {
 132     my $self = shift;
 133     my $uri  = shift;
 134
 135     if( !$self->{ deparse_re } ) {
 136        my $templ = $self->as_string;
 137        $self->{ vars_list } = [ $templ =~ /{(.+?)}/g ];
 138        $templ =~ s/{.+?}/(.+?)/g;
 139        $self->{ deparse_re } = qr/$templ/;
 140     }
 141
 142     my @matches = $uri =~ $self->{ deparse_re };
 143
 144     my %results;
 145     @results{ @{ $self->{ vars_list } } } = @matches;
 146     return %results;
 147 }
 148
 149 =head1 AUTHOR
 150
 151 =over 4
 152
 153 =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
 154
 155 =back
 156
 157 =head1 COPYRIGHT AND LICENSE
 158
 159 Copyright 2007 by Brian Cassidy
 160
 161 This library is free software; you can redistribute it and/or modify
 162 it under the same terms as Perl itself.
 163
 164 =cut
 165
 166 1;