File Coverage

blib/lib/Rose/HTML/Util.pm
Criterion Covered Total %
statement 17 22 77.2
branch 4 12 33.3
condition 1 6 16.6
subroutine 5 7 71.4
pod 2 4 50.0
total 29 51 56.8


line stmt bran cond sub pod time code
1              
2             use strict;
3 43     43   248  
  43         75  
  43         3139  
4             require Exporter;
5             our @ISA = qw(Exporter);
6              
7             our @EXPORT_OK =
8             qw(escape_html unescape_html escape_uri escape_uri_component
9             encode_entities strip_html html_attrs_string);
10              
11             our %EXPORT_TAGS =
12             (
13             all =>
14             [
15             qw(escape_html unescape_html escape_uri escape_uri_component
16             encode_entities)
17             ]
18             );
19              
20             use HTML::Entities();
21 43     43   17971 use URI::Escape;
  43         213566  
  43         1247  
22 43     43   14023  
  43         43038  
  43         17038  
23             if(exists $ENV{'MOD_PERL'} && require mod_perl && $mod_perl::VERSION < 1.99)
24             {
25             require Apache::Util;
26              
27             #*escape_html = \&HTML::Entities::encode;
28             *escape_html = \&encode_entities;
29             *unescape_html = \&HTML::Entities::decode;
30             *escape_uri_component = \&Apache::Util::escape_uri;
31             }
32             else
33             {
34             #*escape_html = \&HTML::Entities::encode;
35             *escape_html = \&encode_entities;
36             *unescape_html = \&HTML::Entities::decode;
37             *escape_uri_component = \&URI::Escape::uri_escape;
38             }
39              
40             our $VERSION = '0.011';
41              
42              
43 1093 50   1093 1 3689 {
44             URI::Escape::uri_escape($_[0],
45             (@_ > 1) ? (defined $_[1] ? $_[1] : ()) : q(^A-Za-z0-9\-_.,'!~*#?&()/?@\:\[\]=));
46             }
47 0 0   0 1 0  
    0          
48             {
49             my %attrs;
50              
51             if(@_ == 1 && ref $_[0] eq 'HASH')
52             {
53 61     61 0 467 %attrs = %{$_[0]};
54             }
55 61 50 33     210 elsif(@_ && @_ % 2 == 0)
    0 0        
56             {
57 61         75 %attrs = @_;
  61         149  
58             }
59              
60             return '' unless(keys %attrs);
61 0         0  
62             return ' ' . join(' ', map { $_ . q(=") . escape_html($attrs{$_}) . q(") }
63             sort keys(%attrs));
64 61 100       171 }
65              
66 43         93 {
  55         488  
67             my($text) = shift;
68              
69             # XXX: dumb for now...
70             $text =~ s{<[^>]*?/?>}{}g;
71              
72 0     0 0   return $text;
73             }
74              
75 0           1;
76              
77 0            
78              
79             =head1 NAME
80              
81             Rose::HTML::Util - Utility functions for manipulating HTML.
82              
83             =head1 SYNOPSIS
84              
85             use Rose::HTML::Util qw(:all);
86              
87             $esc = escape_html($str);
88             $str = unescape_html($esc);
89              
90             $esc = escape_uri($str);
91             $str = unescape_uri($esc);
92              
93             $comp = escape_uri_component($str);
94              
95             $esc = encode_entities($str);
96              
97             =head1 DESCRIPTION
98              
99             L<Rose::HTML::Util> provides aliases and wrappers for common HTML manipulation functions. When running in a mod_perl 1.x web server environment, Apache's C-based functions are used in some cases.
100              
101             This all may seem silly, but I like to be able to pull these functions from a single location and get the fastest possible versions.
102              
103             =head1 EXPORTS
104              
105             L<Rose::HTML::Util> does not export any function names by default.
106              
107             The 'all' tag:
108              
109             use Rose::HTML::Util qw(:all);
110              
111             will cause the following function names to be imported:
112              
113             escape_html()
114             unescape_html()
115             escape_uri()
116             escape_uri_component()
117             encode_entities()
118              
119             =head1 FUNCTIONS
120              
121             =over 4
122              
123             =item B<escape_html STRING [, UNSAFE]>
124              
125             This method passes its arguments to L<HTML::Entities::encode_entities()|HTML::Entities/encode_entities>. If the list of unsafe characters is omitted, it defaults to C<E<lt>E<gt>&">
126              
127             =item B<unescape_html STRING>
128              
129             This method is an alias for L<HTML::Entities::decode()|HTML::Entities/decode>.
130              
131             =item B<escape_uri STRING>
132              
133             This is a wrapper for L<URI::Escape::uri_escape()|URI::Escapeuri_escape> that is intended to escape entire URIs. Example:
134              
135             $str = 'http://foo.com/bar?baz=1%&blay=foo bar'
136             $esc = escape_uri($str);
137              
138             print $esc; # http://foo.com/bar?baz=1%25&blay=foo%20bar
139              
140             In other words, it tries to escape all characters that need to be escaped in a URI I<except> those characters that are legitimately part of the URI: forward slashes, the question mark before the query, etc.
141              
142             The current implementation escapes all characters except those in this set:
143              
144             A-Za-z0-9\-_.,'!~*#?&()/?@:[]=
145              
146             Note that the URI-escaped string is not HTML-escaped. In order make a URI safe to include in an HTML page, call L<escape_html()|/escape_html> as well:
147              
148             $h = '<a href="' . escape_html(escape_uri($str)) . '">foo</a>';
149              
150             =item B<escape_uri_component STRING>
151              
152             When running under mod_perl 1.x, this is an alias for L<Apache::Util::escape_uri()|Apache::Util/escape_uri>. Otherwise, it's an alias for L<URI::Escape::uri_escape()|URI::Escapeuri_escape>.
153              
154             =item B<encode_entities STRING [, UNSAFE]>
155              
156             This method passes its arguments to L<HTML::Entities::encode_entities()|HTML::Entities/encode_entities>. If the list of unsafe characters is omitted, it defaults to C<E<lt>E<gt>&">
157              
158             =back
159              
160             =head1 AUTHOR
161              
162             John C. Siracusa (siracusa@gmail.com)
163              
164             =head1 LICENSE
165              
166             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.