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   = '&amp;';
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&amp;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&amp;debug=1
102
103    [% mycgi(mode='submit') %]
104       # ==> /cgi/bin/bar.pl?mode=submit&amp;debug=1
105
106    [% mycgi(debug='d2 p0', id='D4-2k[4]') %]
107       # ==> /cgi-bin/bar.pl?mode=browse&amp;debug=d2%20p0&amp;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&amp;debug=1
132
133Note that additional parameters are separated by 'C<&amp;>' 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&amp;id=wiz
149    /cgi-bin/baz.pl?mode=browse&amp;debug=1&amp;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&amp;test=1
159    /cgi-bin/waz.pl?mode=browse&amp;debug=1&amp;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