PLP/Fields.pm

   1 #----------------------#
   2   package PLP::Fields;
   3 #----------------------#
   4 use strict;
   5
   6 =head1 PLP::Fields
   7
   8 Has only one function: doit(), which ties the hashes %get, %post, %fields and %header in
   9 PLP::Script. Also generates %cookie immediately.
  10
  11     PLP::Fields::doit();
  12
  13 =cut
  14
  15 sub doit {
  16     tie %PLP::Script::get, 'PLP::Tie::Delay', 'PLP::Script::get', sub {
  17         my %get;
  18         if ($ENV{QUERY_STRING} ne ''){
  19             for (split /[&;]/, $ENV{QUERY_STRING}) {
  20                 my @keyval = split /=/;
  21                 PLP::Functions::DecodeURI(@keyval);
  22                 $get{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
  23                 push @{ $get{'@' . $keyval[0]} }, $keyval[1];
  24             }
  25         }
  26         return \%get;
  27     };
  28
  29     tie %PLP::Script::post, 'PLP::Tie::Delay', 'PLP::Script::post', sub {
  30         my %post;
  31         our $post = <STDIN>;
  32         if (defined($post) && $post ne '' &&
  33             ($ENV{CONTENT_TYPE} eq '' || $ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded')){
  34             for (split /[&;]/, $post) {
  35                 my @keyval = split /=/;
  36                 PLP::Functions::DecodeURI(@keyval);
  37                 $post{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
  38                 push @{ $post{'@' . $keyval[0]} }, $keyval[1];
  39             }
  40         }
  41         return \%post;
  42     };
  43
  44     tie %PLP::Script::fields, 'PLP::Tie::Delay', 'PLP::Script::fields', sub {
  45         $PLP::Script::get{PLPdummy}, $PLP::Script::post{PLPdummy}; # Trigger creation
  46         return {%PLP::Script::get, %PLP::Script::post}
  47     };
  48
  49     tie %PLP::Script::header, 'PLP::Tie::Headers';
  50
  51     if (defined($ENV{HTTP_COOKIE}) && $ENV{HTTP_COOKIE} ne ''){
  52         for (split /; ?/, $ENV{HTTP_COOKIE}) {
  53             my @keyval = split /=/;
  54             $PLP::Script::cookie{$keyval[0]} ||= $keyval[1];
  55         }
  56     }
  57
  58 }
  59 1;