X-Git-Url: http://git.shiar.net/perl/plp/.git/blobdiff_plain/1c9bcb5777f62179abe0a23fd5f075a382dfdc64..359c6d5ee92803be76df630b5040f5087b4e0e3e:/PLP/Functions.pm 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/\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 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.