1#============================================================= -*-Perl-*- 2# 3# Template::Plugin::URL 4# 5# DESCRIPTION 6# Template Toolkit Plugin for constructing URL's from a base stem 7# and adaptable parameters. 8# 9# AUTHOR 10# Andy Wardley <abw@wardley.org> 11# 12# COPYRIGHT 13# Copyright (C) 2000-2007 Andy Wardley. All Rights Reserved. 14# 15# This module is free software; you can redistribute it and/or 16# modify it under the same terms as Perl itself. 17# 18#============================================================================ 19 20package Template::Plugin::URL; 21 22use strict; 23use warnings; 24use base 'Template::Plugin'; 25 26our $VERSION = 2.74; 27our $JOINT = '&'; 28 29 30#------------------------------------------------------------------------ 31# new($context, $baseurl, \%url_params) 32# 33# Constructor method which returns a sub-routine closure for constructing 34# complex URL's from a base part and hash of additional parameters. 35#------------------------------------------------------------------------ 36 37sub new { 38 my ($class, $context, $base, $args) = @_; 39 $args ||= { }; 40 41 return sub { 42 my $newbase = shift unless ref $_[0] eq 'HASH'; 43 my $newargs = shift || { }; 44 my $combo = { %$args, %$newargs }; 45 my $urlargs = join($JOINT, 46 map { args($_, $combo->{ $_ }) } 47 grep { defined $combo->{ $_ } && length $combo->{ $_ } } 48 sort keys %$combo); 49 50 my $query = $newbase || $base || ''; 51 $query .= '?' if length $query && length $urlargs; 52 $query .= $urlargs if length $urlargs; 53 54 return $query 55 } 56} 57 58 59sub args { 60 my ($key, $val) = @_; 61 $key = escape($key); 62 63 return map { 64 "$key=" . escape($_); 65 } ref $val eq 'ARRAY' ? @$val : $val; 66 67} 68 69#------------------------------------------------------------------------ 70# escape($url) 71# 72# URL-encode data. Borrowed with minor modifications from CGI.pm. 73# Kudos to Lincold Stein. 74#------------------------------------------------------------------------ 75 76sub escape { 77 my $toencode = shift; 78 return undef unless defined($toencode); 79 $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; 80 return $toencode; 81} 82 831; 84 85__END__ 86 87=head1 NAME 88 89Template::Plugin::URL - Plugin to construct complex URLs 90 91=head1 SYNOPSIS 92 93 [% USE url('/cgi-bin/foo.pl') %] 94 95 [% url(debug = 1, id = 123) %] 96 # ==> /cgi/bin/foo.pl?debug=1&id=123 97 98 [% USE mycgi = url('/cgi-bin/bar.pl', mode='browse', debug=1) %] 99 100 [% mycgi %] 101 # ==> /cgi/bin/bar.pl?mode=browse&debug=1 102 103 [% mycgi(mode='submit') %] 104 # ==> /cgi/bin/bar.pl?mode=submit&debug=1 105 106 [% mycgi(debug='d2 p0', id='D4-2k[4]') %] 107 # ==> /cgi-bin/bar.pl?mode=browse&debug=d2%20p0&id=D4-2k%5B4%5D 108 109=head1 DESCRIPTION 110 111The C<URL> plugin can be used to construct complex URLs from a base stem 112and a hash array of additional query parameters. 113 114The constructor should be passed a base URL and optionally, a hash array 115reference of default parameters and values. Used from with a template, 116it would look something like the following: 117 118 [% USE url('http://www.somewhere.com/cgi-bin/foo.pl') %] 119 [% USE url('/cgi-bin/bar.pl', mode='browse') %] 120 [% USE url('/cgi-bin/baz.pl', mode='browse', debug=1) %] 121 122When the plugin is then called without any arguments, the default base 123and parameters are returned as a formatted query string. 124 125 [% url %] 126 127For the above three examples, these will produce the following outputs: 128 129 http://www.somewhere.com/cgi-bin/foo.pl 130 /cgi-bin/bar.pl?mode=browse 131 /cgi-bin/baz.pl?mode=browse&debug=1 132 133Note that additional parameters are separated by 'C<&>' rather than 134simply 'C<&>'. This is the correct behaviour for HTML pages but is, 135unfortunately, incorrect when creating URLs that do not need to be 136encoded safely for HTML. This is likely to be corrected in a future 137version of the plugin (most probably with TT3). In the mean time, you 138can set C<$Template::Plugin::URL::JOINT> to C<&> to get the correct 139behaviour. 140 141Additional parameters may be also be specified to the URL: 142 143 [% url(mode='submit', id='wiz') %] 144 145Which, for the same three examples, produces: 146 147 http://www.somewhere.com/cgi-bin/foo.pl?mode=submit&id=wiz 148 /cgi-bin/bar.pl?mode=browse&id=wiz 149 /cgi-bin/baz.pl?mode=browse&debug=1&id=wiz 150 151A new base URL may also be specified as the first option: 152 153 [% url('/cgi-bin/waz.pl', test=1) %] 154 155producing 156 157 /cgi-bin/waz.pl?test=1 158 /cgi-bin/waz.pl?mode=browse&test=1 159 /cgi-bin/waz.pl?mode=browse&debug=1&test=1 160 161The ordering of the parameters is non-deterministic due to fact that 162Perl's hashes themselves are unordered. This isn't a problem as the 163ordering of CGI parameters is insignificant (to the best of my knowledge). 164All values will be properly escaped thanks to some code borrowed from 165Lincoln Stein's C<CGI> module. e.g. 166 167 [% USE url('/cgi-bin/woz.pl') %] 168 [% url(name="Elrich von Benjy d'Weiro") %] 169 170Here the spaces and "C<'>" character are escaped in the output: 171 172 /cgi-bin/woz.pl?name=Elrich%20von%20Benjy%20d%27Weiro 173 174An alternate name may be provided for the plugin at construction time 175as per regular Template Toolkit syntax. 176 177 [% USE mycgi = url('cgi-bin/min.pl') %] 178 [% mycgi(debug=1) %] 179 180=head1 AUTHOR 181 182Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> 183 184=head1 COPYRIGHT 185 186Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. 187 188This module is free software; you can redistribute it and/or 189modify it under the same terms as Perl itself. 190 191=head1 SEE ALSO 192 193L<Template::Plugin> 194 195=cut 196 197# Local Variables: 198# mode: perl 199# perl-indent-level: 4 200# indent-tabs-mode: nil 201# End: 202# 203# vim: expandtab shiftwidth=4: 204