X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/6b971262dcda8586066379c1b3fcea9c457ce575..720e78a4f8351eedac26b196aa9f3922fd5bd0ee:/plpfunc.pm
diff --git a/plpfunc.pm b/plpfunc.pm
index ae3dd4f..a113c76 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/ /g;
+ 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,50 @@ 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($){
+ # This sub assumes your string does not match /(["<>])\cC\1/
+ my $ref;
+ if (defined wantarray){
+ $ref = \(my $copy = $_[0]);
+ }else{
+ $ref = \$_[0];
+ }
+ eval {
+ $$ref =~ s/"/"\cC"/g; # Single characters are easier to match :)
+ $$ref =~ s/>/>\cC>/g; # so we can just use a character class []
+ $$ref =~ s/</<\cC< \r\t\n]*)}{
+ local $_ = $1;
+ my $scheme = $2;
+ s/// if (my $trailing) = /([\.,!\?\(\)\[\]]+$)/;
+ s/&(?!\x23?\w+;)/&/g;
+ s/\"/"/g;
+ my $href = ($scheme =~ /www\./i ? "http://$_" : $_);
+ qq{$_$trailing};
+ }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