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