X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/7685d1a41798147fed9cdeb4edee8920b8c39672..d7eecb5ca73d043897b6e49c14845bda97ba2202:/PLP/Functions.pm
diff --git a/PLP/Functions.pm b/PLP/Functions.pm
index 080c615..fa23270 100644
--- a/PLP/Functions.pm
+++ b/PLP/Functions.pm
@@ -1,11 +1,11 @@
-#-------------------------#
- package PLP::Functions;
-#-------------------------#
+package PLP::Functions;
+
use base 'Exporter';
+use Fcntl qw(:flock);
use strict;
-our @EXPORT = qw/HiddenFields Entity DecodeURI EncodeURI Entity include
- AddCookie ReadFile WriteFile AutoURL Counter Include/;
+our @EXPORT = qw/Entity DecodeURI EncodeURI include PLP_END
+ AddCookie ReadFile WriteFile AutoURL Counter Include exit/;
sub Include ($) {
no strict;
@@ -14,21 +14,22 @@ sub Include ($) {
$PLP::inB = 0;
local $@;
eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
- PLP::error($@, 1) if $@;
+ if ($@) {
+ PLP::Functions::exit() if $@ =~ /\cS\cT\cO\cP/;
+ PLP::error($@, 1);
+ }
}
sub include ($) {
goto &Include;
}
-sub HiddenFields ($@) {
- my $hash = shift;
- my %saves;
- @saves{@_} = ();
- for (keys %$hash) {
- print qq{}
- unless exists $saves{$_};
- }
+sub exit (;$) {
+ die "\cS\cT\cO\cP\n";
+}
+
+sub PLP_END (&) {
+ push @PLP::END, shift;
}
sub Entity (@) {
@@ -55,9 +56,9 @@ sub Entity (@) {
return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
}
-# Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
-# situations.
sub DecodeURI (@) {
+ # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
+ # situations.
my @r;
local $_;
for (@_) {
@@ -73,6 +74,7 @@ sub DecodeURI (@) {
}
return defined wantarray ? (wantarray ? @r : "@r") : undef;
}
+
sub EncodeURI (@) {
my @r;
local $_;
@@ -103,34 +105,45 @@ sub AddCookie ($) {
}
sub ReadFile ($) {
- local *READFILE;
local $/ = undef;
- open (READFILE, '<', $_[0]);
- my $r = ;
- close READFILE;
+ open (my $fh, '<', $_[0]) or do {
+ PLP::error("Cannot open $_[0] for reading ($!)", 1);
+ return undef;
+ };
+ my $r = readline $fh;
+ close $fh;
return $r;
}
sub WriteFile ($$) {
- local *WRITEFILE;
- open (WRITEFILE, '>', $_[0]);
- flock WRITEFILE, 2;
- print WRITEFILE $_[1];
- close WRITEFILE;
+ open (my $fh, '>', $_[0]) or do {
+ PLP::error("Cannot open $_[0] for writing ($!)", 1);
+ return undef;
+ };
+ flock $fh, LOCK_EX;
+ print $fh $_[1] or do {
+ PLP::error("Cannot write to $_[0] ($!)");
+ return undef;
+ };
+ close $fh or do {
+ PLP::error("Cannot close $_[0] ($!)");
+ return undef;
+ };
+ return 1;
}
sub Counter ($) {
- local *COUNTER;
local $/ = undef;
- open COUNTER, '+<', $_[0] or
- open COUNTER, '>', $_[0] or return undef;
- flock COUNTER, 2;
- seek COUNTER, 0, 0;
- my $counter = ;
- seek COUNTER, 0, 0;
- truncate COUNTER, 0;
- print COUNTER ++$counter;
- close COUNTER;
+ my $fh;
+ open $fh, '+<', $_[0] or
+ open $fh, '>', $_[0] or return undef;
+ flock $fh, 2;
+ seek $fh, 0, 0;
+ my $counter = <$fh>;
+ seek $fh, 0, 0;
+ truncate $fh, 0;
+ print $fh ++$counter or return undef;
+ close $fh or return undef;
return $counter;
}
@@ -166,5 +179,126 @@ sub AutoURL ($) {
return defined wantarray ? $$ref : undef;
}
-
1;
+
+=head1 NAME
+
+PLP::Functions - Functions that are available in PLP documents
+
+=head1 DESCRIPTION
+
+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.
+
+Most of these functions are context-hybird. Before using them, one should know about contexts in Perl. The three major contexts are: B, B and B context. You'll find more about context in L.
+
+Some context examples:
+
+ print foo(); # foo is in list context (print LIST)
+ foo(); # foo is in void context
+ $bar = foo(); # foo is in scalar context
+ @bar = foo(); # foo is in list context
+ length foo(); # foo is in scalar context (length EXPR)
+
+=head2 The functions
+
+=over 10
+
+=item Include FILENAME
+
+Executes another PLP file, that will be parsed (i.e. code must be in C<< <: :> >>). As with Perl's C, the file is evaluated in its own lexical file scope, so lexical variables (C 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).
+
+Include can be used recursively, and there is no depth limit:
+
+
+ <:
+ include 'crash.plp';
+ # This example will loop forever,
+ # and dies with an out of memory error.
+ # Do not try this at home.
+ :>
+
+=item include FILENAME
+
+An alias for C.
+
+=item PLP_END BLOCK
+
+Adds a piece of code that is executed when at the end of the PLP document. This is useful when creating a template file:
+
+
+ <: PLP_END { :>
+
+ <: } :>
+
+ <(template.plp)>
+ Hello, world!
+
+You should use this function instead of Perl's built-in C blocks, because those do not work properly with mod_perl.
+
+=item Entity LIST
+
+Replaces HTML syntax characters by HTML entities, so they can be displayed literally. You should always use this on user input (or database output), to avoid cross-site-scripting vurnerabilities. This function does not do everything the L does.
+
+In void context, B the values of the given variables. In other contexts, returns the changed versions.
+
+ <: print Entity($user_input); :>
+
+Be warned that this function also HTMLizes consecutive whitespace and newlines (using and respectively).
+For simple escaping, use L. To escape high-bit characters as well, use L.
+
+=item EncodeURI LIST
+
+Encodes URI strings according to RFC 3986. All disallowed characters are replaced by their %-encoded values.
+
+In void context, B the values of the given variables. In other contexts, returns the changed versions.
+
+ Link
+
+Note that the following reserved characters are I percent-encoded, even though they may have a special meaning in URIs:
+
+ / ? : @ $
+
+This should be safe for escaping query values (as in the example above), but it may be a better idea to use L instead.
+
+=item DecodeURI LIST
+
+Decodes %-encoded strings. Unlike L, it also translates + characters to spaces (as browsers use those).
+
+In void context, B the values of the given variables. In other contexts, returns the changed versions.
+
+=item ReadFile FILENAME
+
+Returns the contents of FILENAME in one large string. Returns undef on failure.
+
+=item WriteFile FILENAME, STRING
+
+Writes STRING to FILENAME (overwrites FILENAME if it already exists). Returns true on success, false on failure.
+
+=item Counter FILENAME
+
+Increases the contents of FILENAME by one and returns the new value. Returns undef on failure. Fails silently.
+
+ You are visitor number <:= Counter('counter.txt') :>.
+
+=item AutoURL STRING
+
+Replaces URLs (actually, replace things that look like URLs) by links.
+
+In void context, B the value of the given variable. In other contexts, returns the changed version.
+
+ <: print AutoURL(Entity($user_input)); :>
+
+=item AddCookie STRING
+
+Adds a Set-Cookie header. STRING must be a valid Set-Cookie header value.
+
+=back
+
+=head1 AUTHOR
+
+Juerd Waalboer
+
+Current maintainer: Mischa POSLAWSKY
+
+=cut
+