File Coverage

blib/lib/Tenjin/Util.pm
Criterion Covered Total %
statement 18 68 26.4
branch 0 16 0.0
condition 0 2 0.0
subroutine 8 20 40.0
pod 13 13 100.0
total 39 119 32.7


line stmt bran cond sub pod time code
1             package Tenjin::Util;
2              
3 8     8   27 use strict;
  8         7  
  8         166  
4 8     8   21 use warnings;
  8         7  
  8         133  
5 8     8   3436 use HTML::Entities;
  8         31897  
  8         5874  
6              
7             our $VERSION = "1.000001";
8             $VERSION = eval $VERSION;
9              
10             =head1 NAME
11              
12             Tenjin::Util - Utility methods for Tenjin.
13              
14             =head1 SYNOPSIS
15              
16             # in your templates:
17              
18             # encode a URL
19             [== encode_url('http://www.google.com/search?q=tenjin&ie=utf-8&oe=utf-8&aq=t') =]
20             # returns http%3A//www.google.com/search%3Fq%3Dtenjin%26ie%3Dutf-8%26oe%3Dutf-8%26aq%3Dt
21              
22             # escape a string of lines of HTML code
23             You & Me\n

Me & You

'; ?>
24             [== text2html($string) =]
25             # returns <h1>You & Me</h1>
\n<h2>Me & You</h2>
26              
27             =head1 DESCRIPTION
28              
29             This module provides a few utility functions which can be used in your
30             templates for your convenience. These include functions to (un)escape
31             and (en/de)code URLs.
32              
33             =head1 METHODS
34              
35             =head2 expand_tabs( $str, [$tabwidth] )
36              
37             Receives a string that might contain tabs in it, and replaces those
38             tabs with spaces, each tab with the number of spaces defined by C<$tabwidth>,
39             or, if C<$tabwidth> was not passed, with 8 spaces.
40              
41             =cut
42              
43             sub expand_tabs {
44 0     0 1 0 my ($str, $tabwidth) = @_;
45              
46 0   0     0 $tabwidth ||= 8;
47 0         0 my $s = '';
48 0         0 my $pos = 0;
49 0         0 while ($str =~ /.*?\t/sg) { # /(.*?)\t/ may be slow
50 0         0 my $end = $+[0];
51 0         0 my $text = substr($str, $pos, $end - 1 - $pos);
52 0         0 my $n = rindex($text, "\n");
53 0 0       0 my $col = $n >= 0 ? length($text) - $n - 1 : length($text);
54 0         0 $s .= $text;
55 0         0 $s .= ' ' x ($tabwidth - $col % $tabwidth);
56 0         0 $pos = $end;
57             }
58 0         0 my $rest = substr($str, $pos);
59 0         0 return $s;
60             }
61              
62             =head2 escape_xml( $str )
63              
64             Receives a string of XML (or (x)HTML) code and converts the characters
65             <>&\' to HTML entities. This is the method that is invoked when you use
66             [= $expression =] in your templates.
67              
68             =cut
69              
70             sub escape_xml {
71 1     1 1 10 encode_entities($_[0], '<>&"\'');
72             }
73              
74             =head2 unescape_xml( $str )
75              
76             Receives a string of escaped XML (or (x)HTML) code (for example, a string
77             that was escaped with the L function,
78             and 'unescapes' all HTML entities back to their actual characters.
79              
80             =cut
81              
82             sub unescape_xml {
83 1     1 1 166 decode_entities($_[0]);
84             }
85              
86             =head2 encode_url( $url )
87              
88             Receives a URL and encodes it by escaping 'non-standard' characters.
89              
90             =cut
91              
92             sub encode_url {
93 1     1 1 7 my $url = shift;
94              
95 1         5 $url =~ s/([^-A-Za-z0-9_.\/])/sprintf("%%%02X", ord($1))/sge;
  9         21  
96 1         3 $url =~ tr/ /+/;
97 1         3 return $url;
98             }
99              
100             =head2 decode_url( $url )
101              
102             Does the opposite of L.
103              
104             =cut
105              
106             sub decode_url {
107 0     0 1 0 my $url = shift;
108              
109 0         0 $url =~ s/\%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/sge;
  0         0  
110 0         0 return $url;
111             }
112              
113             =head2 checked( $val )
114              
115             Receives a value of some sort, and if it is a true value, returns the string
116             ' checked="checked"' which can be appended to HTML checkboxes.
117              
118             =cut
119              
120             sub checked {
121 0 0   0 1 0 $_[0] ? ' checked="checked"' : '';
122             }
123              
124             =head2 selected( $val )
125              
126             Receives a value of some sort, and if it is a true value, returns the string
127             ' selected="selected"' which can be used in an option in an HTML select box.
128              
129             =cut
130              
131             sub selected {
132 0 0   0 1 0 $_[0] ? ' selected="selected"' : '';
133             }
134              
135             =head2 disabled( $val )
136              
137             Receives a value of some sort, and if it is a true value, returns the string
138             ' disabled="disabled"' which can be used in an HTML input.
139              
140             =cut
141              
142             sub disabled {
143 0 0   0 1 0 $_[0] ? ' disabled="disabled"' : '';
144             }
145              
146             =head2 nl2br( $text )
147              
148             Receives a string of text containing lines delimited by newline characters
149             (\n, or possibly \r\n) and appends an HTML line break (
) to every
150             line (the newline character is left untouched).
151              
152             =cut
153              
154             sub nl2br {
155 0     0 1 0 my $text = shift;
156              
157 0         0 $text =~ s/(\r?\n)/
$1/g;
158 0         0 return $text;
159             }
160              
161             =head2 text2html( $text )
162              
163             Receives a string of text containing lines delimited by newline characters,
164             and possibly some XML (or (x)HTML) code, escapes that code with
165             L and then appends an HTML line break
166             to every line with L.
167              
168             =cut
169              
170             sub text2html {
171 0     0 1 0 nl2br(escape_xml($_[0]));
172             }
173              
174             =head2 tagattr( $name, $expr, [$value] )
175              
176             =cut
177              
178             sub tagattr {
179 0     0 1 0 my ($name, $expr, $value) = @_;
180              
181 0 0       0 return '' unless $expr;
182 0 0       0 $value = $expr unless defined $value;
183 0         0 return " $name=\"$value\"";
184             }
185              
186             =head2 tagattrs( %attrs )
187              
188             =cut
189              
190             sub tagattrs {
191 0     0 1 0 my (%attrs) = @_;
192              
193 0         0 my $s = '';
194 0         0 while (my ($k, $v) = each %attrs) {
195 0 0       0 $s .= " $k=\"".escape_xml($v)."\"" if defined $v;
196             }
197 0         0 return $s;
198             }
199              
200             =head2 new_cycle( @items )
201              
202             Creates a subroutine reference that can be used for cycling through the
203             items of the C<@items> array. So, for example, you can:
204              
205             my $cycle = new_cycle(qw/red green blue/);
206             print $cycle->(); # prints 'red'
207             print $cycle->(); # prints 'green'
208             print $cycle->(); # prints 'blue'
209             print $cycle->(); # prints 'red' again
210              
211             =cut
212              
213             sub new_cycle {
214 0     0 1 0 my $i = 0;
215 0     0   0 sub { $_[$i++ % scalar @_] }; # returns
  0         0  
216             }
217              
218             =head1 INTERNAL(?) METHODS
219              
220             =head2 _p( $expression )
221              
222             Wraps a Perl expression in a customized wrapper which will be processed
223             by the Tenjin preprocessor and replaced with the standard [== $expression =].
224              
225             =cut
226              
227             sub _p {
228 1     1   44 "<`\#$_[0]\#`>";
229             }
230              
231             =head2 _P( $expression )
232              
233             Wrap a Perl expression in a customized wrapper which will be processed
234             by the Tenjin preprocessor and replaced with the standard [= $expression =],
235             which means the expression will be escaped.
236              
237             =cut
238              
239             sub _P {
240 1     1   4 "<`\$$_[0]\$`>";
241             }
242              
243             =head2 _decode_params( $s )
244              
245             =cut
246              
247             sub _decode_params {
248 0     0     my $s = shift;
249              
250 0 0         return '' unless $s;
251              
252 0           $s =~ s/%3C%60%23(.*?)%23%60%3E/'[=='.decode_url($1).'=]'/ge;
  0            
253 0           $s =~ s/%3C%60%24(.*?)%24%60%3E/'[='.decode_url($1).'=]'/ge;
  0            
254 0           $s =~ s/<`\#(.*?)\#`>/'[=='.unescape_xml($1).'=]'/ge;
  0            
255 0           $s =~ s/<`\$(.*?)\$`>/'[='.unescape_xml($1).'=]'/ge;
  0            
256 0           $s =~ s/<`\#(.*?)\#`>/[==$1=]/g;
257 0           $s =~ s/<`\$(.*?)\$`>/[=$1=]/g;
258              
259 0           return $s;
260             }
261              
262             1;
263              
264             =head1 SEE ALSO
265              
266             L, L, L.
267              
268             =head1 AUTHOR, LICENSE AND COPYRIGHT
269              
270             See L.
271              
272             =cut