6 use SL::MoreCommon qw(uri_encode uri_decode);
7 use List::Util qw(first max min sum);
8 use List::MoreUtils qw(all any apply);
11 $::lxdebug->enter_sub(2);
13 my ($target, $key, $value) = @_;
14 my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key;
18 $curr = \ $target->{ shift @tokens };
22 my $sep = shift @tokens;
23 my $key = shift @tokens;
25 $curr = \ $$curr->[++$#$$curr], next if $sep eq '[]';
26 $curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].';
27 $curr = \ $$curr->[++$#$$curr] if $sep eq '[+].';
28 $curr = \ $$curr->{$key}
33 $::lxdebug->leave_sub(2);
39 $::lxdebug->enter_sub(2);
41 my ($target, $input) = @_;
42 my @pairs = split(/&/, $input);
45 my ($key, $value) = split(/=/, $_, 2);
46 _store_value($target, uri_decode($key), uri_decode($value)) if ($key);
49 $::lxdebug->leave_sub(2);
52 sub parse_multipart_formdata {
53 my ($target, $input) = @_;
54 my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
57 my $boundary = '--' . $1;
59 foreach my $line (split m/\n/, $input) {
60 last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));
62 if (($line eq $boundary) || ($line eq "$boundary\r")) {
63 ${ $previous } =~ s|\r?\n$|| if $previous;
69 $content_type = "text/plain";
76 next unless $boundary_found;
79 $line =~ s/[\r\n]*$//;
86 if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) {
87 if ($line =~ m|filename\s*=\s*"(.*?)"|i) {
89 substr $line, $-[0], $+[0] - $-[0], "";
92 if ($line =~ m|name\s*=\s*"(.*?)"|i) {
94 substr $line, $-[0], $+[0] - $-[0], "";
97 $previous = _store_value($uploads, $name, '') if ($name);
98 $target->{FILENAME} = $filename if ($filename);
103 if ($line =~ m|^content-type\s*:\s*(.*?)$|i) {
110 next unless $previous;
112 ${ $previous } .= "${line}\n";
115 ${ $previous } =~ s|\r?\n$|| if $previous;
117 $::lxdebug->leave_sub(2);
121 sub _request_to_hash {
122 $::lxdebug->enter_sub(2);
124 my ($target, $input) = @_;
127 if (!$ENV{'CONTENT_TYPE'}
128 || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
131 _input_to_hash($target, $input);
134 $uploads = _parse_multipart_formdata($target, $input);
137 $main::lxdebug->leave_sub(2);
141 sub _recode_recursively {
142 $main::lxdebug->enter_sub();
143 my ($iconv, $param) = @_;
145 if (any { ref $param eq $_ } qw(Form HASH)) {
146 foreach my $key (keys %{ $param }) {
147 if (!ref $param->{$key}) {
148 # Workaround for a bug: converting $param->{$key} directly
149 # leads to 'undef'. I don't know why. Converting a copy works,
151 $param->{$key} = $iconv->convert("" . $param->{$key});
153 _recode_recursively($iconv, $param->{$key});
157 } elsif (ref $param eq 'ARRAY') {
158 foreach my $idx (0 .. scalar(@{ $param }) - 1) {
159 if (!ref $param->[$idx]) {
160 # Workaround for a bug: converting $param->[$idx] directly
161 # leads to 'undef'. I don't know why. Converting a copy works,
163 $param->[$idx] = $iconv->convert("" . $param->[$idx]);
165 _recode_recursively($iconv, $param->[$idx]);
169 $main::lxdebug->leave_sub();
173 $::lxdebug->enter_sub;
177 _input_to_hash($target, $ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
178 _input_to_hash($target, $ARGV[0]) if @ARGV && $ARGV[0];
181 if ($ENV{CONTENT_LENGTH}) {
183 read STDIN, $content, $ENV{CONTENT_LENGTH};
184 $uploads = _request_to_hash($target, $content);
187 if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
189 $::auth->restore_form_from_session(delete $target->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
190 _input_to_hash($target, join '&', map { uri_encode($_) . '=' . uri_encode($temp_form{$_}) } keys %temp_form);
193 my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
194 my $encoding = delete $target->{INPUT_ENCODING} || $db_charset;
196 _recode_recursively(SL::Iconv->new($encoding, $db_charset), $target);
198 map { $target->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads;
200 $::lxdebug->leave_sub;
211 SL::Form.pm - main data object.
215 This module handles unpacking of cgi parameters. usually you donÄt want to call
216 anything in here directly,
218 SL::Request::read_cgi_input($target_hash_ref);
220 =head1 SPECIAL FUNCTIONS
222 =head2 C<_store_value()>
224 parses a complex var name, and stores it in the form.
227 $form->_store_value($key, $value);
229 keys must start with a string, and can contain various tokens.
230 supported key structures are:
233 simple key strings work as expected
238 separating two keys by a dot (.) will result in a hash lookup for the inner value
239 this is similar to the behaviour of java and templating mechanisms.
241 filter.description => $form->{filter}->{description}
243 3. array+hashref access
245 adding brackets ([]) before the dot will cause the next hash to be put into an array.
246 using [+] instead of [] will force a new array index. this is useful for recurring
247 data structures like part lists. put a [+] into the first varname, and use [] on the
250 repeating these names in your template:
253 invoice.items[].parts_id
257 $form->{invoice}->{items}->[
271 using brackets at the end of a name will result in a pure array to be created.
272 note that you mustn't use [+], which is reserved for array+hash access and will
273 result in undefined behaviour in array context.
275 filter.status[] => $form->{status}->[ val1, val2, ... ]