X-Git-Url: http://git.shiar.nl/perl/plp/.git/blobdiff_plain/b7a10718f1c1e5d0028cd367c337e9f85dc56618..0f5e78a789961923b45cae1a881c655fff9e7283:/plpfunc.pm diff --git a/plpfunc.pm b/plpfunc.pm deleted file mode 100644 index 6d78066..0000000 --- a/plpfunc.pm +++ /dev/null @@ -1,154 +0,0 @@ -#!/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($@){ - my $hash = shift; - my %saves; - @saves{@_} = (); - for (keys %$hash){ - print qq{} - unless exists $saves{$_}; - } -} - -sub Entity(@){ - my $ref; - my @copy; - if (defined wantarray){ - @copy = @_; - $ref = \@copy; - }else{ - $ref = \@_; - } - for (@$ref){ - eval { - 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; -} - -# Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life -# situations. -sub DecodeURI(@){ - 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"); - } - } - return defined wantarray ? (wantarray ? @r : "@r") : 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"); - } - } - return defined wantarray ? (wantarray ? @r : "@r") : undef; -} - -sub AddCookie($){ - if ($header{'Set-Cookie'}){ - $header{'Set-Cookie'} .= "\nSet-Cookie: $_[0]"; - }else{ - $header{'Set-Cookie'} = $_[0]; - } -} - -sub ReadFile($){ - local *READFILE; - local $/ = undef; - open (READFILE, "<$_[0]"); - my $r = ; - close READFILE; - return $r; -} - -sub WriteFile($$){ - local *WRITEFILE; - open (WRITEFILE, ">$_[0]"); - flock WRITEFILE, 2; - print WRITEFILE $_[1]; - close WRITEFILE; -} - -sub Counter($){ - local *COUNTER; - local $/ = undef; - open COUNTER, "+<$_[0]" or - open COUNTER, ">$_[0]" or return undef; - flock COUNTER, 2; - seek COUNTER, 0, 0; - my $counter = ; - seek COUNTER, 0, 0; - truncate COUNTER, 0; - print COUNTER ++$counter; - close COUNTER; - 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