X-Git-Url: http://git.shiar.net/gitweb.cgi/perl/plp/.git/blobdiff_plain/6b971262dcda8586066379c1b3fcea9c457ce575..b5eadb0c810558015cd4dc943e2c25b4acbfec58:/plpfunc.pm
diff --git a/plpfunc.pm b/plpfunc.pm
index ae3dd4f..49bb63c 100644
--- a/plpfunc.pm
+++ b/plpfunc.pm
@@ -1,51 +1,72 @@
+#!/usr/bin/perl
+# The shebang is only there for mcedit syntax highlights, as I'm too lazy to
+# change the configfile. It won't hurt performance
+use URI::Escape;
+use strict;
+use vars qw(%header);
+
sub HiddenFields($@){
- $INTERNAL{hash} = shift;
- $INTERNAL{saves} = $INTERNAL{q} . (join $INTERNAL{q}, @_) . $INTERNAL{q};
-# $INTERNAL{human} = join ',', @_;
-# print "";
- for (keys %{$INTERNAL{hash}}){
- print qq{}
- unless $INTERNAL{saves} =~ /$INTERNAL{q}$_$INTERNAL{q}/;
+ my $hash = shift;
+ my %saves;
+ $saves{@_} = ();
+ for (keys %$hash){
+ print qq{}
+ unless exists $saves{$_};
}
}
-sub NoHeaders($){
- $_[0] =~ s/^.*?\n\n//;
- return $_[0]
-}
-
-sub Entity($;$$$$){
- $_[4] ||= 4;
- $_[0] =~ s/&/&/g;
- $_[0] =~ s/\"/"/g;
- $_[0] =~ s/</g;
- $_[0] =~ s/>/>/g;
- if ($_[1]){
- $_[0] =~ s/\n/
\n/g;
- }
- if ($_[2]){
- $_[0] =~ s/\t/' ' x $_[4]/eg;
+sub Entity(@){
+ my $ref;
+ my @copy;
+ if (defined wantarray){
+ @copy = @_;
+ $ref = \@copy;
+ }else{
+ $ref = \@_;
}
- if ($_[3]){
- $_[0] =~ s/ / /g;
+ for (@$ref){
+ eval {
+ s/&/&/g;
+ s/\"/"/g;
+ s/</g;
+ s/>/>/g;
+ s/\n/
\n/g;
+ s/\t/ /eg;
+ s/ / /g;
+ };
+ if ($@){ return defined wantarray ? @_ : undef }
}
- return $_[0]
+ return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
}
-sub DecodeURI($;$){
- my $t = $_[0];
- $t =~ tr{+} { } unless ($_[1] == 1);
- $t =~ s{%([0-9A-Fa-f]{2})}
- {pack('c',hex($1))}ge;
- return $t;
+# Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
+# situations.
+sub DecodeURI(@){
+ my @r;
+ for (@_){
+ s/\+/%20/g;
+ my $dec = uri_unescape($_);
+ if (defined wantarray){
+ push @r, $dec;
+ }else{
+ eval {$_ = $dec};
+ return undef if $@; # ;DecodeURI("foo");
+ }
+ }
+ return defined wantarray ? (wantarray ? @r : "@r") : undef;
}
-
-sub EncodeURI($;$){
- my $t = $_[0];
- $t =~ s{([^a-zA-Z0-9_\-.])}
- {uc sprintf("%%%02x",ord($1))}ge;
- $t =~ s{%20}{+}g if ($_[1] == 1);
- return $t;
+sub EncodeURI(@){
+ my @r;
+ for (@_){
+ my $esc = uri_escape($_, '^;\/?:@&=\$,A-Za-z0-9\-_.!~*\'()');
+ if (defined wantarray){
+ push @r, $esc;
+ }else{
+ eval {$_ = $esc};
+ return undef if $@; # ;EncodeURI("foo");
+ }
+ }
+ return defined wantarray ? (wantarray ? @r : "@r") : undef;
}
sub AddCookie($){
@@ -71,4 +92,47 @@ sub WriteFile($$){
print WRITEFILE $_[1];
close WRITEFILE;
}
+
+sub Counter($){
+ my $o = $/; undef $/;
+ open COUNTER, "+<$_[0]";
+ flock COUNTER, 2;
+ seek COUNTER, 0, 0;
+ my $counter = ;
+ seek COUNTER, 0, 0;
+ truncate COUNTER, 0;
+ print COUNTER ++$counter;
+ close COUNTER;
+ $/ = $o;
+ return $counter;
+}
+
+sub AutoURL($){
+ my $ref;
+ if (defined wantarray){
+ $ref = \(my $copy = $_[0]);
+ }else{
+ $ref = \$_[0];
+ }
+ eval {
+ my ($p, $b, $c);
+ $$ref =~ s/"/"\cC"/g;
+ $$ref =~ s/>/>\cC>/g;
+ $$ref =~ s/</<\cC< \r\t\n]*)}{
+ local $_ = $1, $p = $2, ((($b) = /([\.,!\?\(\)\[\]]+$)/) ? s/// :
+ undef), s/&(?!\x23?\w+;)/&/g, s/\"/"/g, $c =
+ ($p eq 'www.' || $p eq 'WWW.' ? "http://$_" : $_),
+ qq{$_$b}
+ }eg;
+
+
+ $$ref =~ s/"\cC"/"/g;
+ $$ref =~ s/>\cC>/>/g;
+ $$ref =~ s/<\cC</g;
+ };
+ if ($@){ return defined wantarray ? @_ : undef }
+ return defined wantarray ? $$ref : undef;
+}
1;
\ No newline at end of file