1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
package HTML::Template::Compiled::Utils;
# $Id: Utils.pm 1132 2011-11-12 14:26:03Z tinita $
$VERSION = "0.07";
use strict;
use warnings;
use Data::Dumper qw(Dumper);
use Digest::MD5;
use base 'Exporter';
use vars qw/@EXPORT_OK %EXPORT_TAGS/;
my @paths = qw(PATH_METHOD PATH_DEREF PATH_FORMATTER PATH_ARRAY);
@EXPORT_OK = (
@paths, qw(
&log &stack
&escape_html &escape_html_all &escape_uri &escape_js
&md5
)
);
%EXPORT_TAGS = (
walkpath => \@paths,
log => [qw(&log &stack)],
escape => [qw(&escape_html &escape_uri &escape_js)],
);
# These should be better documented
# these might be obsolete soon =)
use constant PATH_METHOD => 1;
use constant PATH_DEREF => 2;
use constant PATH_FORMATTER => 3;
use constant PATH_ARRAY => 4;
=pod
=head1 NAME
HTML::Template::Compiled::Utils - Utility functions for HTML::Template::Compiled
=head1 SYNOPSIS
# import log() and stack()
use HTML::Template::Compiled::Utils qw(:log);
# import the escapign functions
use HTML::Template::Compiled::Utils qw(:escape);
=head1 DEBUGGING FUNCTIONS
=cut
=head2 stack
$self->stack;
For HTML::Template:Compiled developers, prints a stack trace to STDERR.
=cut
=head2 md5
md5($text)
If L<Digest::MD5> is installed, returns the md5_base64 for C<$text>,
otherwise returns the empty string.
=cut
eval { require Encode };
my $encode = $@ ? 0 : 1;
sub md5 {
my ($text) = @_;
$encode and Encode::_utf8_off($text);
return Digest::MD5::md5_base64($text);
}
sub stack {
my ( $self, $force ) = @_;
return if !HTML::Template::Compiled::D() and !$force;
my $i = 0;
my $out;
while ( my @c = caller($i) ) {
$out .= "$i\t$c[0] l. $c[2] $c[3]\n";
$i++;
}
print STDERR $out;
}
=head2 log
$self->log(@msg)
For HTML::Template::Compiled developers, print log from C<@msg> to STDERR.
=cut
sub log {
#return unless D;
my ( $self, @msg ) = @_;
my @c = caller();
my @c2 = caller(1);
print STDERR "----------- ($c[0] line $c[2] $c2[3])\n";
for (@msg) {
if ( !defined $_ ) {
print STDERR "--- UNDEF\n";
}
elsif ( !ref $_ ) {
print STDERR "--- $_\n";
}
else {
if ( ref $_ eq __PACKAGE__ ) {
print STDERR "DUMP HTC\n";
for my $m (qw(file perl)) {
my $s = "get" . ucfirst $m;
print STDERR "\t$m:\t", $_->$s || "UNDEF", "\n";
}
}
else {
print STDERR "--- DUMP ---: " . Dumper $_;
}
}
}
}
=head1 ESCAPING FUNCTIONS
=head2 escape_html
my $escaped_html = escape_html($raw_html);
HTML-escapes the input string (only &, ", single quotes, C<<> and C<>> and returns it;
=cut
sub escape_html {
my ($str) = @_;
return $str unless defined $str;
$str =~ s/&/&/g;
$str =~ s/"/"/g;
$str =~ s/'/'/g;
$str =~ s/>/>/g;
$str =~ s/</</g;
return $str;
}
=head2 escape_html_all
my $escaped_html = escape_html_all($raw_html);
HTML-escapes the input string (with HTML::Entities) and returns it;
=cut
sub escape_html_all {
return $_[0] unless defined $_[0];
# hopefully encode_entities() works correct
# and doesn't change its arg when called in scalar context
require HTML::Entities;
return HTML::Entities::encode_entities($_[0]);
}
=head2 escape_uri
my $escaped_uri = escape_uri($raw_uri);
URI-escapes the input string and returns it;
=cut
sub escape_uri {
# if we want to use utf8 we require Encode.pm to be installed
my $x = ($encode and Encode::is_utf8($_[0]))
? URI::Escape::uri_escape_utf8( $_[0] )
: URI::Escape::uri_escape( $_[0] );
return $x;
}
=head2 escape_js
my $escaped_js = escape_js($raw_js);
JavaScript-escapes the input string and returns it;
=cut
sub escape_js {
my ($var) = @_;
return $var unless defined $var;
$var =~ s/(["'\\])/\\$1/g;
$var =~ s/\r/\\r/g;
$var =~ s/\n/\\n/g;
return $var;
}
=head2 escape_ijson
my $escaped_js = escape_ijson($raw_js);
JavaScript-escapes the input string except for the apostrophe and returns it,
so it can be used within a JSON element.
=cut
sub escape_ijson {
my ($var) = @_;
return $var unless defined $var;
$var =~ s/([\\"])/\\$1/g;
$var =~ s/\r/\\r/g;
$var =~ s/\n/\\n/g;
return $var;
}
1;
__END__
|
