PLP/Fields.pm

   1 #----------------------#
   2   package PLP::Fields;
   3 #----------------------#
   4 use strict;
   5
   6 # Has only one function: doit(), which ties the hashes %get, %post, %fields and %header in
   7 # PLP::Script. Also generates %cookie immediately.
   8 sub doit {
   9     tie %PLP::Script::get, 'PLP::Tie::Delay', 'PLP::Script::get', sub {
  10         my %get;
  11         my $get = $ENV{QUERY_STRING};
  12         if ($get ne ''){
  13             for (split /[&;]/, $get) {
  14                 my @keyval = split /=/, $_, 2;
  15                 PLP::Functions::DecodeURI(@keyval);
  16                 $get{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
  17                 push @{ $get{'@' . $keyval[0]} }, $keyval[1];
  18             }
  19         }
  20         return \%get;
  21     };
  22
  23     tie %PLP::Script::post, 'PLP::Tie::Delay', 'PLP::Script::post', sub {
  24         my %post;
  25         my $post;
  26         if ($ENV{MOD_PERL}) {
  27             $post = Apache->request->content;
  28         } else {
  29             read(*STDIN, $post, $ENV{CONTENT_LENGTH});
  30         }
  31         if (defined $post
  32             and $post ne ''
  33             and $ENV{CONTENT_TYPE} =~ m!^(?:application/x-www-form-urlencoded|$)!
  34         ){
  35             for (split /&/, $post) {
  36                 my @keyval = split /=/, $_, 2;
  37                 PLP::Functions::DecodeURI(@keyval);
  38                 $post{$keyval[0]} = $keyval[1] unless $keyval[0] =~ /^\@/;
  39                 push @{ $post{'@' . $keyval[0]} }, $keyval[1];
  40             }
  41         }
  42         return \%post;
  43     };
  44
  45     tie %PLP::Script::fields, 'PLP::Tie::Delay', 'PLP::Script::fields', sub {
  46 #       $PLP::Script::get{PLPdummy}, $PLP::Script::post{PLPdummy}; # Trigger creation
  47 #       No longer necessary, as PLP::Tie::Delay has been fixed since 3.00
  48 #       And fixed even more in 3.13
  49         return { %PLP::Script::get, %PLP::Script::post };
  50     };
  51
  52     tie %PLP::Script::header, 'PLP::Tie::Headers';
  53
  54     if (defined($ENV{HTTP_COOKIE}) && $ENV{HTTP_COOKIE} ne ''){
  55         for (split /; ?/, $ENV{HTTP_COOKIE}) {
  56             my @keyval = split /=/, $_, 2;
  57             $PLP::Script::cookie{$keyval[0]} ||= $keyval[1];
  58         }
  59     }
  60
  61 }
  62 1;
  63
  64 =head1 NAME
  65
  66 PLP::Fields - Special hashes for PLP
  67
  68 =head1 DESCRIPTION
  69
  70 For your convenience, PLP uses hashes to put things in. Some of these are tied
  71 hashes, so they contain a bit magic. For example, building the hash can be
  72 delayed until you actually use the hash.
  73
  74 =over 10
  75
  76 =item C<%get> and C<%post>
  77
  78 These are built from the C<key=value&key=value> (or C<key=value;key=value>
  79 strings in query string and post content. C<%post> is not built if the content
  80 type is not C<application/x-www-form-urlencoded>. In post content, the
  81 semi-colon is not a valid separator.
  82
  83 These hashes aren't built until they are used, to speed up your script if you
  84 don't use them. Because POST content can only be read once, you can C<use CGI;>
  85 and just never access C<%post> to avoid its building.
  86
  87 With a query string of C<key=firstvalue&key=secondvalue>, C<$get{key}> will
  88 contain only C<secondvalue>. You can access both elements by using the array
  89 reference C<$get{'@key'}>, which will contain C<[ 'firstvalue', 'secondvalue'
  90 ]>.
  91
  92 =item C<%fields>
  93
  94 This hash combines %get and %post, and triggers creation of both. POST gets
  95 precedence over GET (note: not even the C<@>-keys contain both values).
  96
  97 =item C<%cookie>, C<%cookies>
  98
  99 This is built immediately, because cookies are usually short in length. Cookies
 100 are not automatically url-decoded.
 101
 102 =item C<%header>, C<%headers>
 103
 104 In this hash, you can set headers. Underscores are converted to normal minus
 105 signs, so you can leave out quotes. The hash is case insensitive: the case used
 106 when sending the headers is the one you used first. The following are equal:
 107
 108     $header{CONTENT_TYPE}
 109     $header{'Content-Type'}
 110     $header{Content_Type}
 111     $headers{CONTENT_type}
 112
 113 =back
 114
 115 =head1 AUTHOR
 116
 117 Juerd Waalboer <juerd@cpan.org>
 118
 119 =cut
 120