v2.21 release

[perl/plp/.git] / plpfunc.pm

diff --git a/plpfunc.pm b/plpfunc.pm
index ae3dd4f728529baebeda152c0c9a4f7f9effd701..49bb63cd8922b5bb44ea7013059b304ee75e4e27 100644 (file)
--- 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 "<!-- $INTERNAL{hash}: $INTERNAL{human} -->";
-    for (keys %{$INTERNAL{hash}}){
-       print qq{<input type=hidden name="$_" value="${$INTERNAL{hash}}{$_}">}
-           unless $INTERNAL{saves} =~ /$INTERNAL{q}$_$INTERNAL{q}/;
+    my $hash = shift;
+    my %saves;
+    $saves{@_} = ();
+    for (keys %$hash){
+       print qq{<input type=hidden name="$_" value="$hash->{$_}">}
+           unless exists $saves{$_};
     }
 }
 
-sub NoHeaders($){
-    $_[0] =~ s/^.*?\n\n//;
-    return $_[0]
-}
-
-sub Entity($;$$$$){
-    $_[4] ||= 4;
-    $_[0] =~ s/&/&amp;/g;
-    $_[0] =~ s/\"/&quot;/g;
-    $_[0] =~ s/</&lt;/g;
-    $_[0] =~ s/>/&gt;/g;
-    if ($_[1]){
-       $_[0] =~ s/\n/<br>\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/  /&nbsp;&nbsp;/g;
+    for (@$ref){
+       eval {
+           s/&/&amp;/g;
+           s/\"/&quot;/g;
+           s/</&lt;/g;
+           s/>/&gt;/g;
+           s/\n/<br>\n/g;
+           s/\t/    /eg;
+           s/  /&nbsp;&nbsp;/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 = <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/&quot;/"\cC"/g;
+       $$ref =~ s/&gt;/>\cC>/g;
+       $$ref =~ s/&lt;/<\cC</g;
+       # Now this is a big, ugly regex! But hey - it works :)    
+       $$ref =~ s{((\w+://|www\.|WWW\.)[a-zA-Z0-9\.\@:-]+[^\"\'>< \r\t\n]*)}{
+           local $_ = $1, $p = $2, ((($b) = /([\.,!\?\(\)\[\]]+$)/) ? s/// :
+           undef), s/&(?!\x23?\w+;)/&amp;/g, s/\"/&quot;/g, $c = 
+           ($p eq 'www.' || $p eq 'WWW.' ? "http://$_" : $_),
+           qq{<a href="$c" target="_blank">$_</a>$b}
+       }eg;
+
+
+       $$ref =~ s/"\cC"/&quot;/g;
+       $$ref =~ s/>\cC>/&gt;/g;
+       $$ref =~ s/<\cC</&lt;/g;
+    };
+    if ($@){ return defined wantarray ? @_ : undef }
+    return defined wantarray ? $$ref : undef;
+}
 1;
\ No newline at end of file