File Coverage

blib/lib/HTML/MasonX/Free/Escape.pm
Criterion Covered Total %
statement 29 31 93.5
branch 3 4 75.0
condition 2 3 66.6
subroutine 10 11 90.9
pod 0 2 0.0
total 44 51 86.2


line stmt bran cond sub pod time code
1 1     1   352 use strict;
  1         1  
  1         21  
2 1     1   3 use warnings;
  1         1  
  1         40  
3             package HTML::MasonX::Free::Escape;
4             $HTML::MasonX::Free::Escape::VERSION = '0.006';
5             # ABSTRACT: default HTML escaping with an escape hatch
6              
7             #pod =head1 OVERVIEW
8             #pod
9             #pod First, when you set up your compiler, you pass:
10             #pod
11             #pod default_escape_flags => 'html'
12             #pod
13             #pod Then, when you set up your interpreter, you redefine the html handler(s):
14             #pod
15             #pod use HTML::MasonX::Free::Escape qw(html_escape);
16             #pod $interp->set_escape('h' => \&html_escape);
17             #pod $interp->set_escape('html' => \&html_escape);
18             #pod
19             #pod Finally, for good measure, get C<html_hunk> imported to your Commands package:
20             #pod
21             #pod package HTML::Mason::Commands { use HTML::MasonX::Free::Escape 'html_hunk' }
22             #pod
23             #pod Now, by default, when you do this in a template:
24             #pod
25             #pod The best jelly is <% $flavor %> jelly.
26             #pod
27             #pod ...the C<$flavor> will be HTML entity escaped. If you want to deal with
28             #pod variables that are I<not> going to be escaped, you use C<html_hunk>:
29             #pod
30             #pod Here's some math: <% html_hunk( $eqn->as_mathml ) %>
31             #pod
32             #pod Even though it's called C<html_hunk>, it just means "don't HTML escape this."
33             #pod If you put in some XML, you won't get in trouble. The result of calling
34             #pod C<html_hunk> is an object that will throw an exception if stringified. This
35             #pod prevents you from making mistakes like:
36             #pod
37             #pod my $target = html_hunk("world");
38             #pod my $greet = "Hello, $target";
39             #pod
40             #pod =cut
41              
42 1     1   2 use Exporter 'import';
  1         1  
  1         27  
43 1     1   3 use Scalar::Util qw(blessed);
  1         1  
  1         54  
44              
45             our @EXPORT_OK = qw(html_escape html_hunk);
46              
47             {
48             package
49             HTML::MasonX::Free::HTMLHunk;
50 1     1   3 use Carp ();
  1         1  
  1         85  
51 1     1   2 sub new { my ($class, $str) = @_; bless \$str, $class }
  1         2  
52 1     1   1 sub as_html { ${ $_[0] } }
  1         19  
53             use overload
54 0     0   0 '""' => sub { Carp::confess("HTML hunk stringified: <${$_[0]}>") },
  0         0  
55 1     1   3 fallback => 1;
  1         1  
  1         11  
56             }
57              
58             # mostly taken from HTML::Mason::Escapes except it adds "'"
59             my $HTML_ESCAPE = qr/([&<>"'])/;
60             my %HTML_ESCAPE = (
61             '&' => '&amp;',
62             '>' => '&gt;',
63             '<' => '&lt;',
64             '"' => '&quot;',
65             "'" => '&#39;'
66             );
67              
68             sub html_escape {
69 2     2 0 17 my $ref = $_[0];
70 2 50       5 return unless defined $$ref;
71              
72 2 100 66     16 if (blessed $$ref and $$ref->isa('HTML::MasonX::Free::HTMLHunk')) {
73 1         3 $$ref = $$ref->as_html;
74 1         2 return;
75             }
76              
77 1         8 $$ref =~ s/$HTML_ESCAPE/$HTML_ESCAPE{$1}/mg;
78             }
79              
80             sub html_hunk {
81 1     1 0 5 return HTML::MasonX::Free::HTMLHunk->new($_[0]);
82             }
83              
84             1;
85              
86             __END__
87              
88             =pod
89              
90             =encoding UTF-8
91              
92             =head1 NAME
93              
94             HTML::MasonX::Free::Escape - default HTML escaping with an escape hatch
95              
96             =head1 VERSION
97              
98             version 0.006
99              
100             =head1 OVERVIEW
101              
102             First, when you set up your compiler, you pass:
103              
104             default_escape_flags => 'html'
105              
106             Then, when you set up your interpreter, you redefine the html handler(s):
107              
108             use HTML::MasonX::Free::Escape qw(html_escape);
109             $interp->set_escape('h' => \&html_escape);
110             $interp->set_escape('html' => \&html_escape);
111              
112             Finally, for good measure, get C<html_hunk> imported to your Commands package:
113              
114             package HTML::Mason::Commands { use HTML::MasonX::Free::Escape 'html_hunk' }
115              
116             Now, by default, when you do this in a template:
117              
118             The best jelly is <% $flavor %> jelly.
119              
120             ...the C<$flavor> will be HTML entity escaped. If you want to deal with
121             variables that are I<not> going to be escaped, you use C<html_hunk>:
122              
123             Here's some math: <% html_hunk( $eqn->as_mathml ) %>
124              
125             Even though it's called C<html_hunk>, it just means "don't HTML escape this."
126             If you put in some XML, you won't get in trouble. The result of calling
127             C<html_hunk> is an object that will throw an exception if stringified. This
128             prevents you from making mistakes like:
129              
130             my $target = html_hunk("world");
131             my $greet = "Hello, $target";
132              
133             =head1 AUTHOR
134              
135             Ricardo Signes <rjbs@cpan.org>
136              
137             =head1 COPYRIGHT AND LICENSE
138              
139             This software is copyright (c) 2016 by Ricardo Signes.
140              
141             This is free software; you can redistribute it and/or modify it under
142             the same terms as the Perl 5 programming language system itself.
143              
144             =cut