1 #-------------------------#
2 package PLP::Functions;
3 #-------------------------#
7 our @EXPORT = qw/HiddenFields Entity DecodeURI EncodeURI Entity include PLP_END
8 AddCookie ReadFile WriteFile AutoURL Counter Include exit/;
16 eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
18 PLP::Functions::exit if $@ =~ /\cS\cT\cO\cP/;
32 push @PLP::END, shift;
35 sub HiddenFields ($@) {
40 print qq{<input type=hidden name="$_" value="$hash->{$_}">}
41 unless exists $saves{$_};
48 if (defined wantarray) {
61 s/\t/ /g;
64 # if ($@){ return defined wantarray ? @_ : undef }
66 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
69 # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
77 $dec =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
78 if (defined wantarray) {
82 # return undef if $@; # ;DecodeURI("foo");
85 return defined wantarray ? (wantarray ? @r : "@r") : undef;
94 ([^\/?:@\$,A-Za-z0-9\-_.!~*\'()])
96 sprintf("%%%02x", ord($1))
98 if (defined wantarray) {
102 # return undef if $@; # ;EncodeURI("foo");
105 return defined wantarray ? (wantarray ? @r : "@r") : undef;
109 if ($PLP::Script::header{'Set-Cookie'}) {
110 $PLP::Script::header{'Set-Cookie'} .= "\nSet-Cookie: $_[0]";
112 $PLP::Script::header{'Set-Cookie'} = $_[0];
119 open (READFILE, '<', $_[0]);
127 open (WRITEFILE, '>', $_[0]);
129 print WRITEFILE $_[1];
136 open COUNTER, '+<', $_[0] or
137 open COUNTER, '>', $_[0] or return undef;
140 my $counter = <COUNTER>;
143 print COUNTER ++$counter;
149 # This sub assumes your string does not match /(["<>])\cC\1/
151 if (defined wantarray){
152 $ref = \(my $copy = $_[0]);
157 $$ref =~ s/"/"\cC"/g; # Single characters are easier to match :)
158 $$ref =~ s/>/>\cC>/g; # so we can just use a character class []
159 $$ref =~ s/</<\cC</g;
161 # Now this is a big, ugly regex! But hey - it works :)
162 $$ref =~ s{((\w+://|www\.|WWW\.)[a-zA-Z0-9\.\@:-]+[^\"\'>< \r\t\n]*)}{
165 s/// if (my $trailing) = /([\.,!\?\(\)\[\]]+$)/;
166 s/&(?!\x23?\w+;)/&/g;
168 my $href = ($scheme =~ /www\./i ? "http://$_" : $_);
169 qq{<a href="$href" target="_blank">$_</a>$trailing};
172 $$ref =~ s/"\cC"/"/g;
173 $$ref =~ s/>\cC>/>/g;
174 $$ref =~ s/<\cC</</g;
176 if ($@){ return defined wantarray ? @_ : undef }
177 return defined wantarray ? $$ref : undef;