File Coverage

blib/lib/HTML/Template/Filter/URIdecode.pm
Criterion Covered Total %
statement 22 22 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 28 29 96.5


line stmt bran cond sub pod time code
1             package HTML::Template::Filter::URIdecode;
2 2     2   24662 use strict;
  2         6  
  2         83  
3 2     2   10 use warnings;
  2         4  
  2         72  
4              
5             BEGIN {
6 2     2   10 use Exporter ();
  2         8  
  2         49  
7 2     2   10 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  2         5  
  2         283  
8 2     2   5 $VERSION = '1.00';
9 2         55 @ISA = qw(Exporter);
10             #Give a hoot don't pollute, do not export more than needed by default
11 2         6 @EXPORT = qw(&ht_uri_decode);
12 2         5 @EXPORT_OK = qw();
13 2         380 %EXPORT_TAGS = ();
14             }
15              
16             =head1 NAME
17              
18             HTML::Template::Filter::URIdecode - Allow tmpl_ tags to be URL-encoded.
19              
20             =head1 SYNOPSIS
21              
22             use HTML::Template::Filter::URIdecode 'ht_uri_decode';
23              
24             my $t = HTML::Template->new(
25             filename => 'zap.tmpl',
26             filter => \&ht_uri_decode
27             );
28              
29             =head1 DESCRIPTION
30              
31             This filter primarily does URI-decoding of HTML::Template tags. It was designed
32             for use Dreamweaver. Sometimes a tag is used in a way that would be invalid HTML:
33              
34            
35              
36             Dreamweaver fixes the invalid HTML in this case by URL encoding it. Rather than fight it,
37             I've used this filter for the last several years, and Dreamweavers practice of URL-encoding these
38             tags has never been a problem since.
39              
40             Dreamweaver may also automatically "fix" URLS like this by adding one or more "../" in front
41             of the tag. This filter strips those as well.
42              
43             =head1 AUTHOR
44              
45             Mark Stosberg
46             CPAN ID: MARKSTOS
47             mark@summersault.com
48              
49             =head1 COPYRIGHT
50              
51             This program is free software; you can redistribute
52             it and/or modify it under the same terms as Perl itself.
53              
54             The full text of the license can be found in the
55             LICENSE file included with this module.
56              
57              
58             =head1 SEE ALSO
59              
60             perl(1).
61              
62             L
63              
64             L - a elegant web framework which integrates with HTML::Template.
65              
66             =cut
67              
68             sub ht_uri_decode {
69 1     1 0 967 my $text_ref = shift;
70 1         865 require URI::Escape;
71 1         2090 import URI::Escape qw/uri_unescape/;
72             # We also remove extra "../" that DW may put before a tmpl_var tag
73 1         18 $$text_ref =~ s!(?:\.\./)*%3C(?:%21--)?\s*[Tt][Mm][Pp][Ll]_[Vv][Aa][Rr]([^>]*?)(?:--)?%3E!''!ge;
  1         4  
74             }
75              
76             1; # The preceding line will help the module return a true value
77