1 package PLP::Functions;
10 our $VERSION = '1.01';
11 our @EXPORT = qw/Entity DecodeURI EncodeURI Include include PLP_END
13 AddCookie ReadFile WriteFile AutoURL Counter exit/;
21 eval 'package PLP::Script; no warnings; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
23 PLP::Functions::exit() if $@ =~ /\cS\cT\cO\cP/;
37 push @PLP::END, shift;
41 @_ == 1 or croak "Unsupported parameters given to EscapeHTML";
42 unshift @_, shift if defined wantarray; # dereference if not void
54 my $ref = defined wantarray ? [@_] : \@_;
63 s/\t/ /g;
67 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
71 my $ref = defined wantarray ? [@_] : \@_;
75 tr/+/ /; # Browsers do tr/ /+/ - I don't care about RFCs, but
76 # I do care about real-life situations.
77 s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
80 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
84 my $ref = defined wantarray ? [@_] : \@_;
88 s{([^A-Za-z0-9\-_.!~*'()/?:@\$,])}{sprintf("%%%02x", ord $1)}ge;
91 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
95 if ($PLP::Script::header{'Set-Cookie'}) {
96 $PLP::Script::header{'Set-Cookie'} .= "\n" . $_[0];
98 $PLP::Script::header{'Set-Cookie'} = $_[0];
104 open (my $fh, '<', $_[0]) or do {
105 PLP::error("Cannot open $_[0] for reading ($!)", 1);
108 my $r = readline $fh;
114 open (my $fh, '>', $_[0]) or do {
115 PLP::error("Cannot open $_[0] for writing ($!)", 1);
119 print $fh $_[1] or do {
120 PLP::error("Cannot write to $_[0] ($!)");
124 PLP::error("Cannot close $_[0] ($!)");
133 open $fh, '+<', $_[0] or
134 open $fh, '>', $_[0] or return undef;
140 print $fh ++$counter or return undef;
141 close $fh or return undef;
146 # This sub assumes your string does not match /(["<>])\cC\1/
147 my $ref = defined wantarray ? \(my $copy = $_[0]) : \$_[0];
149 $$ref =~ s/"/"\cC"/g; # Single characters are easier to match :)
150 $$ref =~ s/>/>\cC>/g; # so we can just use a character class []
151 $$ref =~ s/</<\cC</g;
153 # Now this is a big, ugly regex! But hey - it works :)
154 $$ref =~ s{((\w+://|www\.|WWW\.)[a-zA-Z0-9\.\@:-]+[^\"\'>< \r\t\n]*)}{
157 s/// if (my $trailing) = /([\.,!\?\(\)\[\]]+$)/;
158 s/&(?!\x23?\w+;)/&/g;
160 my $href = ($scheme =~ /www\./i ? "http://$_" : $_);
161 qq{<a href="$href" target="_blank">$_</a>$trailing};
164 $$ref =~ s/"\cC"/"/g;
165 $$ref =~ s/>\cC>/>/g;
166 $$ref =~ s/<\cC</</g;
168 if ($@){ return defined wantarray ? @_ : undef } # return original on error
169 return defined wantarray ? $$ref : undef;
176 PLP::Functions - Functions that are available in PLP documents
180 The functions are exported into the PLP::Script package that is used by PLP documents. Although uppercased letters are unusual in Perl, they were chosen to stand out.
182 Most of these functions are context-hybird. Before using them, one should know about contexts in Perl. The three major contexts are: B<void>, B<scalar> and B<list> context. You'll find more about context in L<perlfunc>.
184 Some context examples:
186 print foo(); # foo is in list context (print LIST)
187 foo(); # foo is in void context
188 $bar = foo(); # foo is in scalar context
189 @bar = foo(); # foo is in list context
190 length foo(); # foo is in scalar context (length EXPR)
196 =item Include FILENAME
198 Executes another PLP file, that will be parsed (i.e. code must be in C<< <: :> >>). As with Perl's C<do>, the file is evaluated in its own lexical file scope, so lexical variables (C<my> variables) are not shared. PLP's C<< <(filename)> >> includes at compile-time, is faster and is doesn't create a lexical scope (it shares lexical variables).
200 Include can be used recursively, and there is no depth limit:
202 <!-- This is crash.plp -->
205 # This example will loop forever,
206 # and dies with an out of memory error.
207 # Do not try this at home.
210 =item include FILENAME
212 An alias for C<Include>.
216 Adds a piece of code that is executed when at the end of the PLP document. This is useful when creating a template file:
218 <html><body> <!-- this is template.plp -->
223 <(template.plp)> <!-- this is index.plp -->
226 You should use this function instead of Perl's built-in C<END> blocks, because those do not work properly with mod_perl.
228 =item EscapeHTML STRING
230 Replaces HTML syntax characters by HTML entities, so the text can be output safely.
231 You should always use this when displaying user input (or database output),
232 to avoid cross-site-scripting vurnerabilities.
234 In void context, B<changes> the value of the given variable.
236 <: EscapeHTML($user_input); print "<pre>$user_input</pre>"; :>
238 In other contexts, returns the changed version.
240 <a href="<:= EscapeHTML($ENV{REQUEST_URI}) :>">
242 Be warned that single quotes are not substituted, so always use double quotes for attributes.
243 Also does not convert whitespace for formatted output; use Entity() for that.
245 To escape high-bit characters as well, refer to L<HTML::Entities|HTML::Entities>.
249 Formats given arguments for literal display in HTML documents.
250 Similar to EscapeHTML(), but also preserves newlines and consecutive spaces
251 using corresponding C<< <br> >> and C< > respectively.
253 In void context, B<changes> the values of the given variables. In other contexts, returns the changed versions.
255 <: print '<p>' . Entity($user_input) . '</p>'; :>
257 Inside attributes, always use EscapeHTML() instead.
261 Encodes URI strings according to RFC 3986. All disallowed characters are replaced by their %-encoded values.
263 In void context, B<changes> the values of the given variables. In other contexts, returns the changed versions.
265 <a href="/foo.plp?name=<:= EncodeURI($name) :>">Link</a>
267 Note that the following reserved characters are I<not> percent-encoded, even though they may have a special meaning in URIs:
271 This should be safe for escaping query values (as in the example above),
272 but otherwise it may be a better idea to use L<URI::Escape|URI::Escape> instead.
276 Decodes %-encoded strings. Unlike L<URI::Escape|URI::Escape>,
277 it also translates + characters to spaces (as browsers use those).
279 In void context, B<changes> the values of the given variables. In other contexts, returns the changed versions.
281 =item ReadFile FILENAME
283 Returns the contents of FILENAME in one large string. Returns undef on failure.
285 =item WriteFile FILENAME, STRING
287 Writes STRING to FILENAME (overwrites FILENAME if it already exists). Returns true on success, false on failure.
289 =item Counter FILENAME
291 Increases the contents of FILENAME by one and returns the new value. Returns undef on failure. Fails silently.
293 You are visitor number <:= Counter('counter.txt') :>.
297 Replaces URLs (actually, replace things that look like URLs) by links.
299 In void context, B<changes> the value of the given variable. In other contexts, returns the changed version.
301 <: print AutoURL(Entity($user_input)); :>
303 =item AddCookie STRING
305 Adds a Set-Cookie header. STRING must be a valid Set-Cookie header value.
311 Juerd Waalboer <juerd@cpan.org>
313 Current maintainer: Mischa POSLAWSKY <shiar@cpan.org>