diff options
Diffstat (limited to 'lib/Template/Plugin/URL.pm')
| -rw-r--r-- | lib/Template/Plugin/URL.pm | 236 |
1 files changed, 236 insertions, 0 deletions
diff --git a/lib/Template/Plugin/URL.pm b/lib/Template/Plugin/URL.pm new file mode 100644 index 0000000..c2246b7 --- /dev/null +++ b/lib/Template/Plugin/URL.pm @@ -0,0 +1,236 @@ +#============================================================= -*-Perl-*- +# +# Template::Plugin::URL +# +# DESCRIPTION +# +# Template Toolkit Plugin for constructing URL's from a base stem +# and adaptable parameters. +# +# AUTHOR +# Andy Wardley <abw@kfs.org> +# +# COPYRIGHT +# Copyright (C) 2000 Andy Wardley. All Rights Reserved. +# +# This module is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +#---------------------------------------------------------------------------- +# +# $Id: URL.pm,v 2.64 2004/01/13 16:20:39 abw Exp $ +# +#============================================================================ + +package Template::Plugin::URL; + +require 5.004; + +use strict; +use vars qw( @ISA $VERSION ); +use Template::Plugin; + +@ISA = qw( Template::Plugin ); +$VERSION = sprintf("%d.%02d", q$Revision: 2.64 $ =~ /(\d+)\.(\d+)/); + + +#------------------------------------------------------------------------ +# new($context, $baseurl, \%url_params) +# +# Constructor method which returns a sub-routine closure for constructing +# complex URL's from a base part and hash of additional parameters. +#------------------------------------------------------------------------ + +sub new { + my ($class, $context, $base, $args) = @_; + $args ||= { }; + + return sub { + my $newbase = shift unless ref $_[0] eq 'HASH'; + my $newargs = shift || { }; + my $combo = { %$args, %$newargs }; + my $urlargs = join('&', +# map { "$_=" . escape($combo->{ $_ }) } + map { args($_, $combo->{ $_ }) } + grep { defined $combo->{ $_ } } + sort keys %$combo); + + my $query = $newbase || $base || ''; + $query .= '?' if length $query && length $urlargs; + $query .= $urlargs if length $urlargs; + + return $query + } +} + + +sub args { + my ($key, $val) = @_; + $key = escape($key); + return map { + "$key=" . escape($_); + } ref $val eq 'ARRAY' ? @$val : $val; + +} + +#------------------------------------------------------------------------ +# escape($url) +# +# URL-encode data. Borrowed with minor modifications from CGI.pm. +# Kudos to Lincold Stein. +#------------------------------------------------------------------------ + +sub escape { + my $toencode = shift; + return undef unless defined($toencode); + $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; + return $toencode; +} + +1; + +__END__ + + +#------------------------------------------------------------------------ +# IMPORTANT NOTE +# This documentation is generated automatically from source +# templates. Any changes you make here may be lost. +# +# The 'docsrc' documentation source bundle is available for download +# from http://www.template-toolkit.org/docs.html and contains all +# the source templates, XML files, scripts, etc., from which the +# documentation for the Template Toolkit is built. +#------------------------------------------------------------------------ + +=head1 NAME + +Template::Plugin::URL - Plugin to construct complex URLs + +=head1 SYNOPSIS + + [% USE url('/cgi-bin/foo.pl') %] + + [% url(debug = 1, id = 123) %] + # ==> /cgi/bin/foo.pl?debug=1&id=123 + + + [% USE mycgi = url('/cgi-bin/bar.pl', mode='browse', debug=1) %] + + [% mycgi %] + # ==> /cgi/bin/bar.pl?mode=browse&debug=1 + + [% mycgi(mode='submit') %] + # ==> /cgi/bin/bar.pl?mode=submit&debug=1 + + [% mycgi(debug='d2 p0', id='D4-2k[4]') %] + # ==> /cgi-bin/bar.pl?mode=browse&debug=d2%20p0&id=D4-2k%5B4%5D + + +=head1 DESCRIPTION + +The URL plugin can be used to construct complex URLs from a base stem +and a hash array of additional query parameters. + +The constructor should be passed a base URL and optionally, a hash array +reference of default parameters and values. Used from with a Template +Documents, this would look something like the following: + + [% USE url('http://www.somewhere.com/cgi-bin/foo.pl') %] + [% USE url('/cgi-bin/bar.pl', mode='browse') %] + [% USE url('/cgi-bin/baz.pl', mode='browse', debug=1) %] + +When the plugin is then called without any arguments, the default base +and parameters are returned as a formatted query string. + + [% url %] + +For the above three examples, these will produce the following outputs: + + http://www.somewhere.com/cgi-bin/foo.pl + /cgi-bin/bar.pl?mode=browse + /cgi-bin/baz.pl?mode=browse&debug=1 + +Additional parameters may be also be specified: + + [% url(mode='submit', id='wiz') %] + +Which, for the same three examples, produces: + + http://www.somewhere.com/cgi-bin/foo.pl?mode=submit&id=wiz + /cgi-bin/bar.pl?mode=browse&id=wiz + /cgi-bin/baz.pl?mode=browse&debug=1&id=wiz + +A new base URL may also be specified as the first option: + + [% url('/cgi-bin/waz.pl', test=1) %] + +producing + + /cgi-bin/waz.pl?test=1 + /cgi-bin/waz.pl?mode=browse&test=1 + /cgi-bin/waz.pl?mode=browse&debug=1&test=1 + + +The ordering of the parameters is non-deterministic due to fact that +Perl's hashes themselves are unordered. This isn't a problem as the +ordering of CGI parameters is insignificant (to the best of my knowledge). +All values will be properly escaped thanks to some code borrowed from +Lincoln Stein's CGI.pm. e.g. + + [% USE url('/cgi-bin/woz.pl') %] + [% url(name="Elrich von Benjy d'Weiro") %] + +Here the spaces and "'" character are escaped in the output: + + /cgi-bin/woz.pl?name=Elrich%20von%20Benjy%20d%27Weiro + +Alternate name may be provided for the plugin at construction time +as per regular Template Toolkit syntax. + + [% USE mycgi = url('cgi-bin/min.pl') %] + + [% mycgi(debug=1) %] + +Note that in the following line, additional parameters are seperated +by '&', while common usage on the Web is to just use '&'. '&' +is actually the Right Way to do it. See this URL for more information: +http://ppewww.ph.gla.ac.uk/~flavell/www/formgetbyurl.html + + /cgi-bin/waz.pl?mode=browse&debug=1&test=1 + +=head1 AUTHOR + +Andy Wardley E<lt>abw@andywardley.comE<gt> + +L<http://www.andywardley.com/|http://www.andywardley.com/> + + + + +=head1 VERSION + +2.64, distributed as part of the +Template Toolkit version 2.13, released on 30 January 2004. + +=head1 COPYRIGHT + + Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved. + Copyright (C) 1998-2002 Canon Research Centre Europe Ltd. + +This module is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SEE ALSO + +L<Template::Plugin|Template::Plugin> + +=cut + +# Local Variables: +# mode: perl +# perl-indent-level: 4 +# indent-tabs-mode: nil +# End: +# +# vim: expandtab shiftwidth=4: |