change code indenting to tabs
authorMischa POSLAWSKY <perl@shiar.org>
Sat, 31 Mar 2007 01:08:27 +0000 (03:08 +0200)
committerMischa POSLAWSKY <perl@shiar.org>
Sat, 31 Mar 2007 01:08:27 +0000 (03:08 +0200)
PLP/Functions.pm

index fa23270ba7b01439f56e2e11de5d01ad34770655..25022b5db1e9a6270d9ed900d2de262d6d98aaab 100644 (file)
@@ -8,175 +8,175 @@ our @EXPORT = qw/Entity DecodeURI EncodeURI include PLP_END
                  AddCookie ReadFile WriteFile AutoURL Counter Include exit/;
 
 sub Include ($) {
-    no strict;
-    $PLP::file = $_[0];
-    $PLP::inA = 0;
-    $PLP::inB = 0;
-    local $@;
-    eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
-    if ($@) {
-       PLP::Functions::exit() if $@ =~ /\cS\cT\cO\cP/;
-       PLP::error($@, 1);
-    }
+       no strict;
+       $PLP::file = $_[0];
+       $PLP::inA = 0;
+       $PLP::inB = 0;
+       local $@;
+       eval 'package PLP::Script; ' . PLP::source($PLP::file, 0, join ' ', (caller)[2,1]);
+       if ($@) {
+               PLP::Functions::exit() if $@ =~ /\cS\cT\cO\cP/;
+               PLP::error($@, 1);
+       }
 }
 
 sub include ($) {
-    goto &Include;
+       goto &Include;
 }
 
 sub exit (;$) {
-    die "\cS\cT\cO\cP\n";
+       die "\cS\cT\cO\cP\n";
 }
 
 sub PLP_END (&) {
-    push @PLP::END, shift;
+       push @PLP::END, shift;
 }
 
 sub Entity (@) {
-    my $ref;
-    my @copy;    
-    if (defined wantarray) {
-       @copy = @_;
-       $ref = \@copy;
-    } else {
-       $ref = \@_;
-    }
-    for (@$ref) {
-       eval {
-           s/&/&amp;/g;
-           s/\"/&quot;/g;
-           s/</&lt;/g;
-           s/>/&gt;/g;
-           s/\n/<br>\n/g;
-           s/\t/&nbsp; &nbsp; &nbsp; &nbsp;&nbsp;/g;
-           s/  /&nbsp;&nbsp;/g;
-       };
-#      if ($@){ return defined wantarray ? @_ : undef }
-    }
-    return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
+       my $ref;
+       my @copy;
+       if (defined wantarray) {
+               @copy = @_;
+               $ref = \@copy;
+       } else {
+               $ref = \@_;
+       }
+       for (@$ref) {
+               eval {
+                       s/&/&amp;/g;
+                       s/\"/&quot;/g;
+                       s/</&lt;/g;
+                       s/>/&gt;/g;
+                       s/\n/<br>\n/g;
+                       s/\t/&nbsp; &nbsp; &nbsp; &nbsp;&nbsp;/g;
+                       s/  /&nbsp;&nbsp;/g;
+               };
+#              if ($@){ return defined wantarray ? @_ : undef }
+       }
+       return defined wantarray ? (wantarray ? @$ref : "@$ref") : undef;
 }
 
 sub DecodeURI (@) {
-    # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
-    # situations.
-    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");
+       # Browsers do s/ /+/ - I don't care about RFC's, but I do care about real-life
+       # situations.
+       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;
+       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");
+       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;
+       return defined wantarray ? (wantarray ? @r : "@r") : undef;
 }
 
 sub AddCookie ($) {
-    if ($PLP::Script::header{'Set-Cookie'}) {
-       $PLP::Script::header{'Set-Cookie'} .= "\nSet-Cookie: $_[0]";
-    } else {
-       $PLP::Script::header{'Set-Cookie'} = $_[0];
-    }
+       if ($PLP::Script::header{'Set-Cookie'}) {
+               $PLP::Script::header{'Set-Cookie'} .= "\nSet-Cookie: $_[0]";
+       } else {
+               $PLP::Script::header{'Set-Cookie'} = $_[0];
+       }
 }
 
 sub ReadFile ($) {
-    local $/ = undef;
-    open (my $fh, '<', $_[0]) or do {
-       PLP::error("Cannot open $_[0] for reading ($!)", 1);
-       return undef;
-    };
-    my $r = readline $fh;
-    close $fh;
-    return $r;
+       local $/ = undef;
+       open (my $fh, '<', $_[0]) or do {
+               PLP::error("Cannot open $_[0] for reading ($!)", 1);
+               return undef;
+       };
+       my $r = readline $fh;
+       close $fh;
+       return $r;
 }
 
 sub WriteFile ($$) {
-    open (my $fh, '>', $_[0]) or do {
-       PLP::error("Cannot open $_[0] for writing ($!)", 1);
-       return undef;
-    };
-    flock $fh, LOCK_EX;
-    print $fh $_[1] or do {
-       PLP::error("Cannot write to $_[0] ($!)");
-       return undef;
-    };
-    close $fh or do {
-       PLP::error("Cannot close $_[0] ($!)");
-       return undef;
-    };
-    return 1;
+       open (my $fh, '>', $_[0]) or do {
+               PLP::error("Cannot open $_[0] for writing ($!)", 1);
+               return undef;
+       };
+       flock $fh, LOCK_EX;
+       print $fh $_[1] or do {
+               PLP::error("Cannot write to $_[0] ($!)");
+               return undef;
+       };
+       close $fh or do {
+               PLP::error("Cannot close $_[0] ($!)");
+               return undef;
+       };
+       return 1;
 }
 
 sub Counter ($) {
-    local $/ = undef;
-    my             $fh;
-    open           $fh, '+<', $_[0] or
-    open          $fh, '>',  $_[0] or return undef;
-    flock          $fh, 2;
-    seek           $fh, 0, 0;
-    my $counter = <$fh>;
-    seek           $fh, 0, 0;
-    truncate       $fh, 0;
-    print          $fh ++$counter   or return undef;
-    close          $fh              or return undef;
-    return $counter;
+       local $/ = undef;
+       my             $fh;
+       open           $fh, '+<', $_[0] or
+       open           $fh, '>',  $_[0] or return undef;
+       flock          $fh, 2;
+       seek           $fh, 0, 0;
+       my $counter = <$fh>;
+       seek           $fh, 0, 0;
+       truncate       $fh, 0;
+       print          $fh ++$counter   or return undef;
+       close          $fh              or return undef;
+       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/&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;
-           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;
-    };
-    if ($@){ return defined wantarray ? @_ : undef }
-    return defined wantarray ? $$ref : undef;
+       # 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/&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;
+                       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;
+       };
+       if ($@){ return defined wantarray ? @_ : undef }
+       return defined wantarray ? $$ref : undef;
 }
 
 1;