PLP/Fields.pm

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