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