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 This module is part of the PLP internals. Don't use it yourself.
  14
  15 =cut
  16
  17 sub doit {
  18     tie %PLP::Script::get, 'PLP::Tie::Delay', 'PLP::Script::get', sub {
  19         my %get;
  20         my $get;
  21         $get = $ENV{QUERY_STRING};
  22         if ($get ne ''){
  23             for (split /[&;]/, $get) {
  24                 my @keyval = split /=/, $_, 2;
  25                 PLP::Functions::DecodeURI(@keyval);
  26                 $get{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
  27                 push @{ $get{'@' . $keyval[0]} }, $keyval[1];
  28             }
  29         }
  30         return \%get;
  31     };
  32
  33     tie %PLP::Script::post, 'PLP::Tie::Delay', 'PLP::Script::post', sub {
  34         my %post;
  35         my $post;
  36         if ($ENV{MOD_PERL}) {
  37             $post = Apache->request->content;
  38         } else {
  39             read(*STDIN, $post, $ENV{CONTENT_LENGTH});
  40         }
  41         if (defined($post) && $post ne '' &&
  42             ($ENV{CONTENT_TYPE} eq '' || $ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded')){
  43             for (split /&/, $post) {
  44                 my @keyval = split /=/, $_, 2;
  45                 PLP::Functions::DecodeURI(@keyval);
  46                 $post{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
  47                 push @{ $post{'@' . $keyval[0]} }, $keyval[1];
  48             }
  49         }
  50         return \%post;
  51     };
  52
  53     tie %PLP::Script::fields, 'PLP::Tie::Delay', 'PLP::Script::fields', sub {
  54         $PLP::Script::get{PLPdummy}, $PLP::Script::post{PLPdummy}; # Trigger creation
  55         return {%PLP::Script::get, %PLP::Script::post}
  56     };
  57
  58     tie %PLP::Script::header, 'PLP::Tie::Headers';
  59
  60     if (defined($ENV{HTTP_COOKIE}) && $ENV{HTTP_COOKIE} ne ''){
  61         for (split /; ?/, $ENV{HTTP_COOKIE}) {
  62             my @keyval = split /=/, $_, 2;
  63             $PLP::Script::cookie{$keyval[0]} ||= $keyval[1];
  64         }
  65     }
  66
  67 }
  68 1;