X-Git-Url: http://git.shiar.net/gitweb.cgi/perl/plp/.git/blobdiff_plain/b5eadb0c810558015cd4dc943e2c25b4acbfec58..b7a10718f1c1e5d0028cd367c337e9f85dc56618:/plpfunc.pm

diff --git a/plpfunc.pm b/plpfunc.pm
index 49bb63c..6d78066 100644
--- a/plpfunc.pm
+++ b/plpfunc.pm
@@ -1,14 +1,16 @@
 #!/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 URI::Escape;
+
 use strict;
 use vars qw(%header);
 
 sub HiddenFields($@){
     my $hash = shift;
     my %saves;
-    $saves{@_} = ();
+    @saves{@_} = ();
     for (keys %$hash){
 	print qq{<input type=hidden name="$_" value="$hash->{$_}">}
 	    unless exists $saves{$_};
@@ -31,10 +33,10 @@ sub Entity(@){
 	    s/</&lt;/g;
 	    s/>/&gt;/g;
 	    s/\n/<br>\n/g;
-	    s/\t/    /eg;
+	    s/\t/&nbsp; &nbsp; &nbsp; &nbsp;&nbsp;/g;
 	    s/  /&nbsp;&nbsp;/g;
 	};
-	if ($@){ return defined wantarray ? @_ : undef }
+#	if ($@){ return defined wantarray ? @_ : undef }
     }
     return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
 }
@@ -42,51 +44,61 @@ sub Entity(@){
 # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
 # situations.
 sub DecodeURI(@){
-    my @r;    
+    my @r;
+    local $_;    
     for (@_){
 	s/\+/%20/g;
-	my $dec = uri_unescape($_);
+	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");
+#	    return undef if $@; # ;DecodeURI("foo");
 	}
     }
     return defined wantarray ? (wantarray ? @r : "@r") : undef;
 }
 sub EncodeURI(@){
     my @r;
+    local $_;
     for (@_){
-        my $esc = uri_escape($_, '^;\/?:@&=\$,A-Za-z0-9\-_.!~*\'()');
+        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");
+#	    return undef if $@; # ;EncodeURI("foo");
 	}
     }
     return defined wantarray ? (wantarray ? @r : "@r") : undef;
 }
 
 sub AddCookie($){
-    if ($header{'set-cookie'}){
-	$header{'set-cookie'} .= "\nset-cookie: $_[0]";
+    if ($header{'Set-Cookie'}){
+	$header{'Set-Cookie'} .= "\nSet-Cookie: $_[0]";
     }else{
-	$header{'set-cookie'} = $_[0];
+	$header{'Set-Cookie'} = $_[0];
     }
 }
 
 sub ReadFile($){
-    my $o = $/; undef $/;    
-    open (READFILE, $_[0]);
+    local *READFILE;
+    local $/ = undef;
+    open (READFILE, "<$_[0]");
     my $r = <READFILE>;
     close READFILE;
-    $/ = $o;
     return $r;
 }
 
 sub WriteFile($$){
+    local *WRITEFILE;
     open (WRITEFILE, ">$_[0]");
     flock WRITEFILE, 2;
     print WRITEFILE $_[1];
@@ -94,8 +106,10 @@ sub WriteFile($$){
 }
 
 sub Counter($){
-    my $o = $/; undef $/;
-    open           COUNTER, "+<$_[0]";
+    local *COUNTER;
+    local $/ = undef;
+    open           COUNTER, "+<$_[0]" or
+    open	   COUNTER, ">$_[0]"  or return undef;
     flock          COUNTER, 2;
     seek           COUNTER, 0, 0;
     my $counter = <COUNTER>;
@@ -103,11 +117,11 @@ sub Counter($){
     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]);
@@ -115,19 +129,21 @@ sub AutoURL($){
 	$ref = \$_[0];
     }
     eval {
-	my ($p, $b, $c);
-	$$ref =~ s/&quot;/"\cC"/g;
-	$$ref =~ s/&gt;/>\cC>/g;
+	$$ref =~ s/&quot;/"\cC"/g; # Single characters are easier to match :)
+	$$ref =~ s/&gt;/>\cC>/g;   # so we can just use a character class []
 	$$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}
+	    local $_ = $1;
+	    my $scheme = $2;
+	    s/// if (my $trailing) = /([\.,!\?\(\)\[\]]+$)/;
+	    s/&(?!\x23?\w+;)/&amp;/g;
+	    s/\"/&quot;/g;
+	    my $href = ($scheme =~ /www\./i ? "http://$_" : $_);
+	    qq{<a href="$href" target="_blank">$_</a>$trailing};
 	}eg;
 
-
 	$$ref =~ s/"\cC"/&quot;/g;
 	$$ref =~ s/>\cC>/&gt;/g;
 	$$ref =~ s/<\cC</&lt;/g;
@@ -135,4 +151,4 @@ sub AutoURL($){
     if ($@){ return defined wantarray ? @_ : undef }
     return defined wantarray ? $$ref : undef;
 }
-1;
\ No newline at end of file
+1;