X-Git-Url: http://git.shiar.nl/gitweb.cgi/perl/plp/.git/blobdiff_plain/1c9bcb5777f62179abe0a23fd5f075a382dfdc64..96959bff080392067524996e6edbf95445ba66da:/PLP/Functions.pm?ds=sidebyside
diff --git a/PLP/Functions.pm b/PLP/Functions.pm
index 25022b5..3eb07ca 100644
--- a/PLP/Functions.pm
+++ b/PLP/Functions.pm
@@ -4,8 +4,8 @@ use base 'Exporter';
use Fcntl qw(:flock);
use strict;
-our @EXPORT = qw/Entity DecodeURI EncodeURI include PLP_END
- AddCookie ReadFile WriteFile AutoURL Counter Include exit/;
+our @EXPORT = qw/Entity DecodeURI EncodeURI Include include PLP_END
+ AddCookie ReadFile WriteFile AutoURL Counter exit/;
sub Include ($) {
no strict;
@@ -33,67 +33,41 @@ sub PLP_END (&) {
}
sub Entity (@) {
- my $ref;
- my @copy;
- if (defined wantarray) {
- @copy = @_;
- $ref = \@copy;
- } else {
- $ref = \@_;
- }
+ my $ref = defined wantarray ? [@_] : \@_;
for (@$ref) {
eval {
s/&/&/g;
- s/\"/"/g;
+ s/"/"/g;
s/</g;
s/>/>/g;
s/\n/
\n/g;
s/\t/ /g;
s/ / /g;
};
-# if ($@){ return defined wantarray ? @_ : undef }
}
return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
}
sub DecodeURI (@) {
- # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
- # situations.
- my @r;
- local $_;
- for (@_) {
- s/\+/%20/g;
- my $dec = $_;
- $dec =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
- if (defined wantarray) {
- push @r, $dec;
- } else {
- eval {$_ = $dec};
-# return undef if $@; # ;DecodeURI("foo");
- }
+ my $ref = defined wantarray ? [@_] : \@_;
+ for (@$ref) {
+ eval {
+ tr/+/ /; # Browsers do tr/ /+/ - I don't care about RFCs, but
+ # I do care about real-life situations.
+ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
+ };
}
- return defined wantarray ? (wantarray ? @r : "@r") : undef;
+ return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
}
sub EncodeURI (@) {
- my @r;
- local $_;
- for (@_) {
- my $esc = $_;
- $esc =~
- s{
- ([^\/?:@\$,A-Za-z0-9\-_.!~*\'()])
- }{
- sprintf("%%%02x", ord($1))
- }xge;
- if (defined wantarray) {
- push @r, $esc;
- } else {
- eval {$_ = $esc};
-# return undef if $@; # ;EncodeURI("foo");
- }
+ my $ref = defined wantarray ? [@_] : \@_;
+ for (@$ref) {
+ eval {
+ s{([^A-Za-z0-9\-_.!~*'()/?:@\$,])}{sprintf("%%%02x", ord $1)}ge;
+ };
}
- return defined wantarray ? (wantarray ? @r : "@r") : undef;
+ return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
}
sub AddCookie ($) {
@@ -149,12 +123,7 @@ sub Counter ($) {
sub AutoURL ($) {
# This sub assumes your string does not match /(["<>])\cC\1/
- my $ref;
- if (defined wantarray){
- $ref = \(my $copy = $_[0]);
- }else{
- $ref = \$_[0];
- }
+ my $ref = defined wantarray ? \(my $copy = $_[0]) : \$_[0];
eval {
$$ref =~ s/"/"\cC"/g; # Single characters are easier to match :)
$$ref =~ s/>/>\cC>/g; # so we can just use a character class []
@@ -175,7 +144,7 @@ sub AutoURL ($) {
$$ref =~ s/>\cC>/>/g;
$$ref =~ s/<\cC</g;
};
- if ($@){ return defined wantarray ? @_ : undef }
+ if ($@){ return defined wantarray ? @_ : undef } # return original on error
return defined wantarray ? $$ref : undef;
}
@@ -237,7 +206,7 @@ You should use this function instead of Perl's built-in C blocks, because t
=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.
+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.
In void context, B the values of the given variables. In other contexts, returns the changed versions.