Revision 48abd6c9
Von Sven Schöling vor fast 13 Jahren hinzugefügt
SL/Form.pm | ||
---|---|---|
58 | 58 |
use SL::IS; |
59 | 59 |
use SL::Mailer; |
60 | 60 |
use SL::Menu; |
61 |
use SL::MoreCommon qw(uri_encode uri_decode); |
|
61 | 62 |
use SL::OE; |
63 |
use SL::Request; |
|
62 | 64 |
use SL::Template; |
63 | 65 |
use SL::User; |
64 | 66 |
use SL::X; |
... | ... | |
81 | 83 |
undef $standard_dbh; |
82 | 84 |
} |
83 | 85 |
|
84 |
sub _store_value { |
|
85 |
$main::lxdebug->enter_sub(2); |
|
86 |
|
|
87 |
my $self = shift; |
|
88 |
my $key = shift; |
|
89 |
my $value = shift; |
|
90 |
|
|
91 |
my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key; |
|
92 |
|
|
93 |
my $curr; |
|
94 |
|
|
95 |
if (scalar @tokens) { |
|
96 |
$curr = \ $self->{ shift @tokens }; |
|
97 |
} |
|
98 |
|
|
99 |
while (@tokens) { |
|
100 |
my $sep = shift @tokens; |
|
101 |
my $key = shift @tokens; |
|
102 |
|
|
103 |
$curr = \ $$curr->[++$#$$curr], next if $sep eq '[]'; |
|
104 |
$curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].'; |
|
105 |
$curr = \ $$curr->[++$#$$curr] if $sep eq '[+].'; |
|
106 |
$curr = \ $$curr->{$key} |
|
107 |
} |
|
108 |
|
|
109 |
$$curr = $value; |
|
110 |
|
|
111 |
$main::lxdebug->leave_sub(2); |
|
112 |
|
|
113 |
return $curr; |
|
114 |
} |
|
115 |
|
|
116 |
sub _input_to_hash { |
|
117 |
$main::lxdebug->enter_sub(2); |
|
118 |
|
|
119 |
my $self = shift; |
|
120 |
my $input = shift; |
|
121 |
|
|
122 |
my @pairs = split(/&/, $input); |
|
123 |
|
|
124 |
foreach (@pairs) { |
|
125 |
my ($key, $value) = split(/=/, $_, 2); |
|
126 |
$self->_store_value($self->unescape($key), $self->unescape($value)) if ($key); |
|
127 |
} |
|
128 |
|
|
129 |
$main::lxdebug->leave_sub(2); |
|
130 |
} |
|
131 |
|
|
132 |
sub _request_to_hash { |
|
133 |
$main::lxdebug->enter_sub(2); |
|
134 |
|
|
135 |
my $self = shift; |
|
136 |
my $input = shift; |
|
137 |
my $uploads = {}; |
|
138 |
|
|
139 |
if (!$ENV{'CONTENT_TYPE'} |
|
140 |
|| ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { |
|
141 |
|
|
142 |
$self->_input_to_hash($input); |
|
143 |
|
|
144 |
$main::lxdebug->leave_sub(2); |
|
145 |
return $uploads; |
|
146 |
} |
|
147 |
|
|
148 |
my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); |
|
149 |
|
|
150 |
my $boundary = '--' . $1; |
|
151 |
|
|
152 |
foreach my $line (split m/\n/, $input) { |
|
153 |
last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r")); |
|
154 |
|
|
155 |
if (($line eq $boundary) || ($line eq "$boundary\r")) { |
|
156 |
${ $previous } =~ s|\r?\n$|| if $previous; |
|
157 |
|
|
158 |
undef $previous; |
|
159 |
undef $filename; |
|
160 |
|
|
161 |
$headers_done = 0; |
|
162 |
$content_type = "text/plain"; |
|
163 |
$boundary_found = 1; |
|
164 |
$need_cr = 0; |
|
165 |
|
|
166 |
next; |
|
167 |
} |
|
168 |
|
|
169 |
next unless $boundary_found; |
|
170 |
|
|
171 |
if (!$headers_done) { |
|
172 |
$line =~ s/[\r\n]*$//; |
|
173 |
|
|
174 |
if (!$line) { |
|
175 |
$headers_done = 1; |
|
176 |
next; |
|
177 |
} |
|
178 |
|
|
179 |
if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) { |
|
180 |
if ($line =~ m|filename\s*=\s*"(.*?)"|i) { |
|
181 |
$filename = $1; |
|
182 |
substr $line, $-[0], $+[0] - $-[0], ""; |
|
183 |
} |
|
184 |
|
|
185 |
if ($line =~ m|name\s*=\s*"(.*?)"|i) { |
|
186 |
$name = $1; |
|
187 |
substr $line, $-[0], $+[0] - $-[0], ""; |
|
188 |
} |
|
189 |
|
|
190 |
$previous = _store_value($uploads, $name, '') if ($name); |
|
191 |
$self->{FILENAME} = $filename if ($filename); |
|
192 |
|
|
193 |
next; |
|
194 |
} |
|
195 |
|
|
196 |
if ($line =~ m|^content-type\s*:\s*(.*?)$|i) { |
|
197 |
$content_type = $1; |
|
198 |
} |
|
199 |
|
|
200 |
next; |
|
201 |
} |
|
202 |
|
|
203 |
next unless $previous; |
|
204 |
|
|
205 |
${ $previous } .= "${line}\n"; |
|
206 |
} |
|
207 |
|
|
208 |
${ $previous } =~ s|\r?\n$|| if $previous; |
|
209 |
|
|
210 |
$main::lxdebug->leave_sub(2); |
|
211 |
|
|
212 |
return $uploads; |
|
213 |
} |
|
214 |
|
|
215 |
sub _recode_recursively { |
|
216 |
$main::lxdebug->enter_sub(); |
|
217 |
my ($iconv, $param) = @_; |
|
218 |
|
|
219 |
if (any { ref $param eq $_ } qw(Form HASH)) { |
|
220 |
foreach my $key (keys %{ $param }) { |
|
221 |
if (!ref $param->{$key}) { |
|
222 |
# Workaround for a bug: converting $param->{$key} directly |
|
223 |
# leads to 'undef'. I don't know why. Converting a copy works, |
|
224 |
# though. |
|
225 |
$param->{$key} = $iconv->convert("" . $param->{$key}); |
|
226 |
} else { |
|
227 |
_recode_recursively($iconv, $param->{$key}); |
|
228 |
} |
|
229 |
} |
|
230 |
|
|
231 |
} elsif (ref $param eq 'ARRAY') { |
|
232 |
foreach my $idx (0 .. scalar(@{ $param }) - 1) { |
|
233 |
if (!ref $param->[$idx]) { |
|
234 |
# Workaround for a bug: converting $param->[$idx] directly |
|
235 |
# leads to 'undef'. I don't know why. Converting a copy works, |
|
236 |
# though. |
|
237 |
$param->[$idx] = $iconv->convert("" . $param->[$idx]); |
|
238 |
} else { |
|
239 |
_recode_recursively($iconv, $param->[$idx]); |
|
240 |
} |
|
241 |
} |
|
242 |
} |
|
243 |
$main::lxdebug->leave_sub(); |
|
244 |
} |
|
245 |
|
|
246 | 86 |
sub new { |
247 | 87 |
$main::lxdebug->enter_sub(); |
248 | 88 |
|
... | ... | |
258 | 98 |
|
259 | 99 |
bless $self, $type; |
260 | 100 |
|
261 |
$main::lxdebug->leave_sub(); |
|
262 |
|
|
263 |
return $self; |
|
264 |
} |
|
265 |
|
|
266 |
sub read_cgi_input { |
|
267 |
$main::lxdebug->enter_sub(); |
|
268 |
|
|
269 |
my ($self) = @_; |
|
270 |
|
|
271 |
$self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; |
|
272 |
$self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; |
|
273 |
|
|
274 |
my $uploads; |
|
275 |
if ($ENV{CONTENT_LENGTH}) { |
|
276 |
my $content; |
|
277 |
read STDIN, $content, $ENV{CONTENT_LENGTH}; |
|
278 |
$uploads = $self->_request_to_hash($content); |
|
279 |
} |
|
280 |
|
|
281 |
if ($self->{RESTORE_FORM_FROM_SESSION_ID}) { |
|
282 |
my %temp_form; |
|
283 |
$::auth->restore_form_from_session(delete $self->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form); |
|
284 |
$self->_input_to_hash(join '&', map { $self->escape($_) . '=' . $self->escape($temp_form{$_}) } keys %temp_form); |
|
285 |
} |
|
286 |
|
|
287 |
my $db_charset = $::lx_office_conf{system}->{dbcharset}; |
|
288 |
$db_charset ||= Common::DEFAULT_CHARSET; |
|
289 |
|
|
290 |
my $encoding = $self->{INPUT_ENCODING} || $db_charset; |
|
291 |
delete $self->{INPUT_ENCODING}; |
|
292 |
|
|
293 |
_recode_recursively(SL::Iconv->new($encoding, $db_charset), $self); |
|
294 |
|
|
295 |
map { $self->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads; |
|
296 |
|
|
297 |
#$self->{version} = "2.6.1"; # Old hardcoded but secure style |
|
298 | 101 |
open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file |
299 | 102 |
$self->{version} = <VERSION_FILE>; |
300 | 103 |
close VERSION_FILE; |
... | ... | |
305 | 108 |
return $self; |
306 | 109 |
} |
307 | 110 |
|
111 |
sub read_cgi_input { |
|
112 |
my ($self) = @_; |
|
113 |
SL::Request::read_cgi_input($self); |
|
114 |
} |
|
115 |
|
|
308 | 116 |
sub _flatten_variables_rec { |
309 | 117 |
$main::lxdebug->enter_sub(2); |
310 | 118 |
|
... | ... | |
404 | 212 |
} |
405 | 213 |
|
406 | 214 |
sub escape { |
407 |
$main::lxdebug->enter_sub(2); |
|
408 |
|
|
409 | 215 |
my ($self, $str) = @_; |
410 | 216 |
|
411 |
$str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8; |
|
412 |
$str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge; |
|
413 |
|
|
414 |
$main::lxdebug->leave_sub(2); |
|
415 |
|
|
416 |
return $str; |
|
217 |
return uri_encode($str); |
|
417 | 218 |
} |
418 | 219 |
|
419 | 220 |
sub unescape { |
420 |
$main::lxdebug->enter_sub(2); |
|
421 |
|
|
422 | 221 |
my ($self, $str) = @_; |
423 | 222 |
|
424 |
$str =~ tr/+/ /; |
|
425 |
$str =~ s/\\$//; |
|
426 |
|
|
427 |
$str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; |
|
428 |
$str = Encode::decode('utf-8-strict', $str) if $::locale->is_utf8; |
|
429 |
|
|
430 |
$main::lxdebug->leave_sub(2); |
|
431 |
|
|
432 |
return $str; |
|
223 |
return uri_decode($str); |
|
433 | 224 |
} |
434 | 225 |
|
435 | 226 |
sub quote { |
... | ... | |
3790 | 3581 |
|
3791 | 3582 |
=head1 SPECIAL FUNCTIONS |
3792 | 3583 |
|
3793 |
=head2 C<_store_value()> |
|
3794 |
|
|
3795 |
parses a complex var name, and stores it in the form. |
|
3796 |
|
|
3797 |
syntax: |
|
3798 |
$form->_store_value($key, $value); |
|
3799 |
|
|
3800 |
keys must start with a string, and can contain various tokens. |
|
3801 |
supported key structures are: |
|
3802 |
|
|
3803 |
1. simple access |
|
3804 |
simple key strings work as expected |
|
3805 |
|
|
3806 |
id => $form->{id} |
|
3807 |
|
|
3808 |
2. hash access. |
|
3809 |
separating two keys by a dot (.) will result in a hash lookup for the inner value |
|
3810 |
this is similar to the behaviour of java and templating mechanisms. |
|
3811 |
|
|
3812 |
filter.description => $form->{filter}->{description} |
|
3813 |
|
|
3814 |
3. array+hashref access |
|
3815 |
|
|
3816 |
adding brackets ([]) before the dot will cause the next hash to be put into an array. |
|
3817 |
using [+] instead of [] will force a new array index. this is useful for recurring |
|
3818 |
data structures like part lists. put a [+] into the first varname, and use [] on the |
|
3819 |
following ones. |
|
3820 |
|
|
3821 |
repeating these names in your template: |
|
3822 |
|
|
3823 |
invoice.items[+].id |
|
3824 |
invoice.items[].parts_id |
|
3825 |
|
|
3826 |
will result in: |
|
3827 |
|
|
3828 |
$form->{invoice}->{items}->[ |
|
3829 |
{ |
|
3830 |
id => ... |
|
3831 |
parts_id => ... |
|
3832 |
}, |
|
3833 |
{ |
|
3834 |
id => ... |
|
3835 |
parts_id => ... |
|
3836 |
} |
|
3837 |
... |
|
3838 |
] |
|
3839 |
|
|
3840 |
4. arrays |
|
3841 |
|
|
3842 |
using brackets at the end of a name will result in a pure array to be created. |
|
3843 |
note that you mustn't use [+], which is reserved for array+hash access and will |
|
3844 |
result in undefined behaviour in array context. |
|
3845 |
|
|
3846 |
filter.status[] => $form->{status}->[ val1, val2, ... ] |
|
3847 |
|
|
3848 | 3584 |
=head2 C<update_business> PARAMS |
3849 | 3585 |
|
3850 | 3586 |
PARAMS (not named): |
SL/MoreCommon.pm | ||
---|---|---|
4 | 4 |
our @ISA = qw(Exporter); |
5 | 5 |
|
6 | 6 |
our @EXPORT = qw(save_form restore_form compare_numbers any cross); |
7 |
our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash); |
|
7 |
our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash uri_encode uri_decode uri_encode uri_decode);
|
|
8 | 8 |
|
9 | 9 |
use List::MoreUtils qw(zip); |
10 | 10 |
use YAML; |
... | ... | |
161 | 161 |
return zip(@indexes, @values); |
162 | 162 |
} |
163 | 163 |
|
164 |
sub uri_encode { |
|
165 |
my ($str) = @_; |
|
166 |
|
|
167 |
$str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8; |
|
168 |
$str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge; |
|
169 |
|
|
170 |
return $str; |
|
171 |
} |
|
172 |
|
|
173 |
sub uri_decode { |
|
174 |
my ($str) = @_; |
|
175 |
|
|
176 |
$str =~ tr/+/ /; |
|
177 |
$str =~ s/\\$//; |
|
178 |
|
|
179 |
$str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; |
|
180 |
$str = Encode::decode('utf-8-strict', $str) if $::locale->is_utf8; |
|
181 |
|
|
182 |
return $str; |
|
183 |
} |
|
184 |
|
|
164 | 185 |
1; |
165 | 186 |
|
166 | 187 |
__END__ |
SL/Request.pm | ||
---|---|---|
1 |
package SL::Request; |
|
2 |
|
|
3 |
use strict; |
|
4 |
|
|
5 |
use SL::Common; |
|
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); |
|
9 |
|
|
10 |
sub _store_value { |
|
11 |
$::lxdebug->enter_sub(2); |
|
12 |
|
|
13 |
my ($target, $key, $value) = @_; |
|
14 |
my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key; |
|
15 |
my $curr; |
|
16 |
|
|
17 |
if (scalar @tokens) { |
|
18 |
$curr = \ $target->{ shift @tokens }; |
|
19 |
} |
|
20 |
|
|
21 |
while (@tokens) { |
|
22 |
my $sep = shift @tokens; |
|
23 |
my $key = shift @tokens; |
|
24 |
|
|
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} |
|
29 |
} |
|
30 |
|
|
31 |
$$curr = $value; |
|
32 |
|
|
33 |
$::lxdebug->leave_sub(2); |
|
34 |
|
|
35 |
return $curr; |
|
36 |
} |
|
37 |
|
|
38 |
sub _input_to_hash { |
|
39 |
$::lxdebug->enter_sub(2); |
|
40 |
|
|
41 |
my ($target, $input) = @_; |
|
42 |
my @pairs = split(/&/, $input); |
|
43 |
|
|
44 |
foreach (@pairs) { |
|
45 |
my ($key, $value) = split(/=/, $_, 2); |
|
46 |
_store_value($target, uri_decode($key), uri_decode($value)) if ($key); |
|
47 |
} |
|
48 |
|
|
49 |
$::lxdebug->leave_sub(2); |
|
50 |
} |
|
51 |
|
|
52 |
sub parse_multipart_formdata { |
|
53 |
my ($target, $input) = @_; |
|
54 |
my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); |
|
55 |
my $uploads = {}; |
|
56 |
|
|
57 |
my $boundary = '--' . $1; |
|
58 |
|
|
59 |
foreach my $line (split m/\n/, $input) { |
|
60 |
last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r")); |
|
61 |
|
|
62 |
if (($line eq $boundary) || ($line eq "$boundary\r")) { |
|
63 |
${ $previous } =~ s|\r?\n$|| if $previous; |
|
64 |
|
|
65 |
undef $previous; |
|
66 |
undef $filename; |
|
67 |
|
|
68 |
$headers_done = 0; |
|
69 |
$content_type = "text/plain"; |
|
70 |
$boundary_found = 1; |
|
71 |
$need_cr = 0; |
|
72 |
|
|
73 |
next; |
|
74 |
} |
|
75 |
|
|
76 |
next unless $boundary_found; |
|
77 |
|
|
78 |
if (!$headers_done) { |
|
79 |
$line =~ s/[\r\n]*$//; |
|
80 |
|
|
81 |
if (!$line) { |
|
82 |
$headers_done = 1; |
|
83 |
next; |
|
84 |
} |
|
85 |
|
|
86 |
if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) { |
|
87 |
if ($line =~ m|filename\s*=\s*"(.*?)"|i) { |
|
88 |
$filename = $1; |
|
89 |
substr $line, $-[0], $+[0] - $-[0], ""; |
|
90 |
} |
|
91 |
|
|
92 |
if ($line =~ m|name\s*=\s*"(.*?)"|i) { |
|
93 |
$name = $1; |
|
94 |
substr $line, $-[0], $+[0] - $-[0], ""; |
|
95 |
} |
|
96 |
|
|
97 |
$previous = _store_value($uploads, $name, '') if ($name); |
|
98 |
$target->{FILENAME} = $filename if ($filename); |
|
99 |
|
|
100 |
next; |
|
101 |
} |
|
102 |
|
|
103 |
if ($line =~ m|^content-type\s*:\s*(.*?)$|i) { |
|
104 |
$content_type = $1; |
|
105 |
} |
|
106 |
|
|
107 |
next; |
|
108 |
} |
|
109 |
|
|
110 |
next unless $previous; |
|
111 |
|
|
112 |
${ $previous } .= "${line}\n"; |
|
113 |
} |
|
114 |
|
|
115 |
${ $previous } =~ s|\r?\n$|| if $previous; |
|
116 |
|
|
117 |
$::lxdebug->leave_sub(2); |
|
118 |
|
|
119 |
} |
|
120 |
|
|
121 |
sub _request_to_hash { |
|
122 |
$::lxdebug->enter_sub(2); |
|
123 |
|
|
124 |
my ($target, $input) = @_; |
|
125 |
my $uploads; |
|
126 |
|
|
127 |
if (!$ENV{'CONTENT_TYPE'} |
|
128 |
|| ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { |
|
129 |
|
|
130 |
$uploads = { }; |
|
131 |
_input_to_hash($target, $input); |
|
132 |
|
|
133 |
} else { |
|
134 |
$uploads = _parse_multipart_formdata($target, $input); |
|
135 |
} |
|
136 |
|
|
137 |
$main::lxdebug->leave_sub(2); |
|
138 |
return $uploads; |
|
139 |
} |
|
140 |
|
|
141 |
sub _recode_recursively { |
|
142 |
$main::lxdebug->enter_sub(); |
|
143 |
my ($iconv, $param) = @_; |
|
144 |
|
|
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, |
|
150 |
# though. |
|
151 |
$param->{$key} = $iconv->convert("" . $param->{$key}); |
|
152 |
} else { |
|
153 |
_recode_recursively($iconv, $param->{$key}); |
|
154 |
} |
|
155 |
} |
|
156 |
|
|
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, |
|
162 |
# though. |
|
163 |
$param->[$idx] = $iconv->convert("" . $param->[$idx]); |
|
164 |
} else { |
|
165 |
_recode_recursively($iconv, $param->[$idx]); |
|
166 |
} |
|
167 |
} |
|
168 |
} |
|
169 |
$main::lxdebug->leave_sub(); |
|
170 |
} |
|
171 |
|
|
172 |
sub read_cgi_input { |
|
173 |
$::lxdebug->enter_sub; |
|
174 |
|
|
175 |
my ($target) = @_; |
|
176 |
|
|
177 |
_input_to_hash($target, $ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; |
|
178 |
_input_to_hash($target, $ARGV[0]) if @ARGV && $ARGV[0]; |
|
179 |
|
|
180 |
my $uploads; |
|
181 |
if ($ENV{CONTENT_LENGTH}) { |
|
182 |
my $content; |
|
183 |
read STDIN, $content, $ENV{CONTENT_LENGTH}; |
|
184 |
$uploads = _request_to_hash($target, $content); |
|
185 |
} |
|
186 |
|
|
187 |
if ($target->{RESTORE_FORM_FROM_SESSION_ID}) { |
|
188 |
my %temp_form; |
|
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); |
|
191 |
} |
|
192 |
|
|
193 |
my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; |
|
194 |
my $encoding = delete $target->{INPUT_ENCODING} || $db_charset; |
|
195 |
|
|
196 |
_recode_recursively(SL::Iconv->new($encoding, $db_charset), $target); |
|
197 |
|
|
198 |
map { $target->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads; |
|
199 |
|
|
200 |
$::lxdebug->leave_sub; |
|
201 |
|
|
202 |
return $target; |
|
203 |
} |
|
204 |
|
|
205 |
1; |
|
206 |
|
|
207 |
__END__ |
|
208 |
|
|
209 |
=head1 NAME |
|
210 |
|
|
211 |
SL::Form.pm - main data object. |
|
212 |
|
|
213 |
=head1 SYNOPSIS |
|
214 |
|
|
215 |
This module handles unpacking of cgi parameters. usually you donÄt want to call |
|
216 |
anything in here directly, |
|
217 |
|
|
218 |
SL::Request::read_cgi_input($target_hash_ref); |
|
219 |
|
|
220 |
=head1 SPECIAL FUNCTIONS |
|
221 |
|
|
222 |
=head2 C<_store_value()> |
|
223 |
|
|
224 |
parses a complex var name, and stores it in the form. |
|
225 |
|
|
226 |
syntax: |
|
227 |
$form->_store_value($key, $value); |
|
228 |
|
|
229 |
keys must start with a string, and can contain various tokens. |
|
230 |
supported key structures are: |
|
231 |
|
|
232 |
1. simple access |
|
233 |
simple key strings work as expected |
|
234 |
|
|
235 |
id => $form->{id} |
|
236 |
|
|
237 |
2. hash access. |
|
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. |
|
240 |
|
|
241 |
filter.description => $form->{filter}->{description} |
|
242 |
|
|
243 |
3. array+hashref access |
|
244 |
|
|
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 |
|
248 |
following ones. |
|
249 |
|
|
250 |
repeating these names in your template: |
|
251 |
|
|
252 |
invoice.items[+].id |
|
253 |
invoice.items[].parts_id |
|
254 |
|
|
255 |
will result in: |
|
256 |
|
|
257 |
$form->{invoice}->{items}->[ |
|
258 |
{ |
|
259 |
id => ... |
|
260 |
parts_id => ... |
|
261 |
}, |
|
262 |
{ |
|
263 |
id => ... |
|
264 |
parts_id => ... |
|
265 |
} |
|
266 |
... |
|
267 |
] |
|
268 |
|
|
269 |
4. arrays |
|
270 |
|
|
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. |
|
274 |
|
|
275 |
filter.status[] => $form->{status}->[ val1, val2, ... ] |
|
276 |
|
|
277 |
=cut |
Auch abrufbar als: Unified diff
Request Handling aus Form ausgelagert.