1 #-------------------------#
2 package PLP::Functions;
3 #-------------------------#
7 our @EXPORT = qw/HiddenFields Entity DecodeURI EncodeURI Entity include
8 AddCookie ReadFile WriteFile AutoURL Counter Include/;
16 eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
17 PLP::error($@, 1) if $@;
24 sub HiddenFields ($@) {
29 print qq{<input type=hidden name="$_" value="$hash->{$_}">}
30 unless exists $saves{$_};
37 if (defined wantarray) {
50 s/\t/ /g;
53 # if ($@){ return defined wantarray ? @_ : undef }
55 return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
58 # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
66 $dec =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
67 if (defined wantarray) {
71 # return undef if $@; # ;DecodeURI("foo");
74 return defined wantarray ? (wantarray ? @r : "@r") : undef;
83 ([^\/?:@\$,A-Za-z0-9\-_.!~*\'()])
85 sprintf("%%%02x", ord($1))
87 if (defined wantarray) {
91 # return undef if $@; # ;EncodeURI("foo");
94 return defined wantarray ? (wantarray ? @r : "@r") : undef;
98 if ($PLP::Script::header{'Set-Cookie'}) {
99 $PLP::Script::header{'Set-Cookie'} .= "\nSet-Cookie: $_[0]";
101 $PLP::Script::header{'Set-Cookie'} = $_[0];
108 open (READFILE, '<', $_[0]);
116 open (WRITEFILE, '>', $_[0]);
118 print WRITEFILE $_[1];
125 open COUNTER, "+<$_[0]" or
126 open COUNTER, ">$_[0]" or return undef;
129 my $counter = <COUNTER>;
132 print COUNTER ++$counter;
138 # This sub assumes your string does not match /(["<>])\cC\1/
140 if (defined wantarray){
141 $ref = \(my $copy = $_[0]);
146 $$ref =~ s/"/"\cC"/g; # Single characters are easier to match :)
147 $$ref =~ s/>/>\cC>/g; # so we can just use a character class []
148 $$ref =~ s/</<\cC</g;
150 # Now this is a big, ugly regex! But hey - it works :)
151 $$ref =~ s{((\w+://|www\.|WWW\.)[a-zA-Z0-9\.\@:-]+[^\"\'>< \r\t\n]*)}{
154 s/// if (my $trailing) = /([\.,!\?\(\)\[\]]+$)/;
155 s/&(?!\x23?\w+;)/&/g;
157 my $href = ($scheme =~ /www\./i ? "http://$_" : $_);
158 qq{<a href="$href" target="_blank">$_</a>$trailing};
161 $$ref =~ s/"\cC"/"/g;
162 $$ref =~ s/>\cC>/>/g;
163 $$ref =~ s/<\cC</</g;
165 if ($@){ return defined wantarray ? @_ : undef }
166 return defined wantarray ? $$ref : undef;