1 package PLP::Functions;
6 use Exporter qw(import);
10 our @EXPORT = qw/Entity DecodeURI EncodeURI Include include PLP_END
11 AddCookie ReadFile WriteFile AutoURL Counter exit/;
19 eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
21 PLP::Functions::exit() if $@ =~ /\cS\cT\cO\cP/;
35 push @PLP::END, shift;
39 my $ref = defined wantarray ? [@_] : \@_;
47 s/\t/ /g;
51 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
55 my $ref = defined wantarray ? [@_] : \@_;
58 tr/+/ /; # Browsers do tr/ /+/ - I don't care about RFCs, but
59 # I do care about real-life situations.
60 s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
63 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
67 my $ref = defined wantarray ? [@_] : \@_;
70 s{([^A-Za-z0-9\-_.!~*'()/?:@\$,])}{sprintf("%%%02x", ord $1)}ge;
73 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
77 if ($PLP::Script::header{'Set-Cookie'}) {
78 $PLP::Script::header{'Set-Cookie'} .= "\n" . $_[0];
80 $PLP::Script::header{'Set-Cookie'} = $_[0];
86 open (my $fh, '<', $_[0]) or do {
87 PLP::error("Cannot open $_[0] for reading ($!)", 1);
96 open (my $fh, '>', $_[0]) or do {
97 PLP::error("Cannot open $_[0] for writing ($!)", 1);
101 print $fh $_[1] or do {
102 PLP::error("Cannot write to $_[0] ($!)");
106 PLP::error("Cannot close $_[0] ($!)");
115 open $fh, '+<', $_[0] or
116 open $fh, '>', $_[0] or return undef;
122 print $fh ++$counter or return undef;
123 close $fh or return undef;
128 # This sub assumes your string does not match /(["<>])\cC\1/
129 my $ref = defined wantarray ? \(my $copy = $_[0]) : \$_[0];
131 $$ref =~ s/"/"\cC"/g; # Single characters are easier to match :)
132 $$ref =~ s/>/>\cC>/g; # so we can just use a character class []
133 $$ref =~ s/</<\cC</g;
135 # Now this is a big, ugly regex! But hey - it works :)
136 $$ref =~ s{((\w+://|www\.|WWW\.)[a-zA-Z0-9\.\@:-]+[^\"\'>< \r\t\n]*)}{
139 s/// if (my $trailing) = /([\.,!\?\(\)\[\]]+$)/;
140 s/&(?!\x23?\w+;)/&/g;
142 my $href = ($scheme =~ /www\./i ? "http://$_" : $_);
143 qq{<a href="$href" target="_blank">$_</a>$trailing};
146 $$ref =~ s/"\cC"/"/g;
147 $$ref =~ s/>\cC>/>/g;
148 $$ref =~ s/<\cC</</g;
150 if ($@){ return defined wantarray ? @_ : undef } # return original on error
151 return defined wantarray ? $$ref : undef;
158 PLP::Functions - Functions that are available in PLP documents
162 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.
164 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>.
166 Some context examples:
168 print foo(); # foo is in list context (print LIST)
169 foo(); # foo is in void context
170 $bar = foo(); # foo is in scalar context
171 @bar = foo(); # foo is in list context
172 length foo(); # foo is in scalar context (length EXPR)
178 =item Include FILENAME
180 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).
182 Include can be used recursively, and there is no depth limit:
184 <!-- This is crash.plp -->
187 # This example will loop forever,
188 # and dies with an out of memory error.
189 # Do not try this at home.
192 =item include FILENAME
194 An alias for C<Include>.
198 Adds a piece of code that is executed when at the end of the PLP document. This is useful when creating a template file:
200 <html><body> <!-- this is template.plp -->
205 <(template.plp)> <!-- this is index.plp -->
208 You should use this function instead of Perl's built-in C<END> blocks, because those do not work properly with mod_perl.
212 Replaces HTML syntax characters by HTML entities, so they can be displayed literally. You should always use this when displaying user input (or database output), to avoid cross-site-scripting vurnerabilities.
214 In void context, B<changes> the values of the given variables. In other contexts, returns the changed versions.
216 <: print Entity($user_input); :>
218 Be warned that this function also HTMLizes consecutive whitespace and newlines (using and <br> respectively).
219 For simple escaping, use L<XML::Quote|XML::Quote>.
220 To escape high-bit characters as well, use L<HTML::Entities|HTML::Entities>.
224 Encodes URI strings according to RFC 3986. All disallowed characters are replaced by their %-encoded values.
226 In void context, B<changes> the values of the given variables. In other contexts, returns the changed versions.
228 <a href="/foo.plp?name=<:= EncodeURI($name) :>">Link</a>
230 Note that the following reserved characters are I<not> percent-encoded, even though they may have a special meaning in URIs:
234 This should be safe for escaping query values (as in the example above),
235 but it may be a better idea to use L<URI::Escape|URI::Escape> instead.
239 Decodes %-encoded strings. Unlike L<URI::Escape|URI::Escape>,
240 it also translates + characters to spaces (as browsers use those).
242 In void context, B<changes> the values of the given variables. In other contexts, returns the changed versions.
244 =item ReadFile FILENAME
246 Returns the contents of FILENAME in one large string. Returns undef on failure.
248 =item WriteFile FILENAME, STRING
250 Writes STRING to FILENAME (overwrites FILENAME if it already exists). Returns true on success, false on failure.
252 =item Counter FILENAME
254 Increases the contents of FILENAME by one and returns the new value. Returns undef on failure. Fails silently.
256 You are visitor number <:= Counter('counter.txt') :>.
260 Replaces URLs (actually, replace things that look like URLs) by links.
262 In void context, B<changes> the value of the given variable. In other contexts, returns the changed version.
264 <: print AutoURL(Entity($user_input)); :>
266 =item AddCookie STRING
268 Adds a Set-Cookie header. STRING must be a valid Set-Cookie header value.
274 Juerd Waalboer <juerd@cpan.org>
276 Current maintainer: Mischa POSLAWSKY <shiar@cpan.org>