use Exporter qw(import);
use SL::Common;
+use SL::JSON;
use SL::MoreCommon qw(uri_encode uri_decode);
use SL::Layout::None;
use SL::Presenter;
-our @EXPORT_OK = qw(flatten unflatten read_cgi_input);
+our @EXPORT_OK = qw(flatten unflatten);
use Rose::Object::MakeMethods::Generic
(
- 'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax type) ],
+ scalar => [ qw(applying_database_upgrades post_data) ],
+ 'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax is_mobile type) ],
);
sub init_cgi {
return ($ENV{HTTP_X_REQUESTED_WITH} || '') eq 'XMLHttpRequest' ? 1 : 0;
}
+sub init_is_mobile {
+ # mobile clients will change their user agent when the user requests
+ # desktop version so user agent is the most reliable way to identify
+ return ($ENV{HTTP_USER_AGENT} || '') =~ /Mobi/ ? 1 : 0;
+}
+
sub init_type {
return 'html';
}
+sub is_https {
+ $ENV{HTTPS} && 'on' eq lc $ENV{HTTPS};
+}
+
+sub cache {
+ my ($self, $topic, $default) = @_;
+
+ $topic = '::' . (caller(0))[0] . "::$topic" unless $topic =~ m{^::};
+
+ $self->{_cache} //= {};
+ $self->{_cache}->{$topic} //= ($default // {});
+
+ return $self->{_cache}->{$topic};
+}
+
sub _store_value {
my ($target, $key, $value) = @_;
my @tokens = split /((?:\[\+?\])?(?:\.)|(?:\[\+?\]))/, $key;
sub _input_to_hash {
$::lxdebug->enter_sub(2);
- my ($target, $input) = @_;
+ my ($target, $input, $log) = @_;
my @pairs = split(/&/, $input);
foreach (@pairs) {
my ($key, $value) = split(/=/, $_, 2);
- _store_value($target, uri_decode($key), uri_decode($value)) if ($key);
+ next unless $key;
+ _store_value($target, uri_decode($key), uri_decode($value));
+
+ # for debugging
+ $::lxdebug->add_request_params(uri_decode($key) => uri_decode($value)) if $log;
}
$::lxdebug->leave_sub(2);
}
sub _parse_multipart_formdata {
- my ($target, $temp_target, $input) = @_;
+ my ($target, $temp_target, $input, $log) = @_;
my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous, $p_attachment, $encoding, $transfer_encoding);
my $data_start = 0;
} else {
${ $previous } = $data;
}
+ $::lxdebug->add_request_params($name, $$previous) if $log;
undef $previous;
undef $filename;
$content_type = "text/plain";
$boundary_found = 1;
$need_cr = 0;
- $encoding = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
+ $encoding = 'UTF-8';
$transfer_encoding = undef;
last if $last_boundary;
next;
# legacy, some old upload routines expect this to be here
$temp_target->{FILENAME} = $filename if defined $filename;
- # name can potentially be both a normal variable or a file upload
- # a file upload can be identified by its "filename" attribute
- # the thing is, if a [+] clause vivifies atructur in one of the
+ # Name can potentially be both a normal variable or a file upload.
+ # A file upload can be identified by its "filename" attribute.
+ # The thing is, if a [+] clause vivifies structure in one of the
# branches it must be done in both, or subsequent "[]" will fail
my $temp_target_slot = _store_value($temp_target, $name);
my $target_slot = _store_value($target, $name);
$::lxdebug->leave_sub(2);
}
+sub _parse_json_formdata {
+ my ($content) = @_;
+
+ return $content ? SL::JSON::decode_json($content) : undef;
+}
+
sub _recode_recursively {
$::lxdebug->enter_sub;
my ($iconv, $from, $to) = @_;
# Workaround for a bug: converting $from->[$idx] directly
# leads to 'undef'. I don't know why. Converting a copy works,
# though.
- $to->[$idx] = $iconv->convert("" . $from->[$idx]);
+ $to->[$idx] = $iconv->convert("" . $from->[$idx]) if defined $from->[$idx] && !defined $to->[$idx];
} else {
$to->[$idx] ||= {} if 'HASH' eq ref $from->[$idx];
$to->[$idx] ||= [] if 'ARRAY' eq ref $from->[$idx];
sub read_cgi_input {
$::lxdebug->enter_sub;
- my ($target) = @_;
- my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
+ my ($self, $target) = @_;
# yes i know, copying all those values around isn't terribly efficient, but
# the old version of dumping everything into form and then launching a
# this way the data can at least be recoded on the fly as soon as we get to
# know the source encoding and only in the cases where encoding may be hidden
# among the payload we take the hit of copying the request around
- my $temp_target = { };
+ $self->post_data(undef);
+ my $data_to_decode = { };
+ my $iconv = SL::Iconv->new('UTF-8', 'UTF-8');
- # since both of these can potentially bring their encoding in INPUT_ENCODING
- # they get dumped into temp_target
- _input_to_hash($temp_target, $ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
- _input_to_hash($temp_target, $ARGV[0]) if @ARGV && $ARGV[0];
+ _input_to_hash($data_to_decode, $ENV{QUERY_STRING}, 1) if $ENV{QUERY_STRING};
+ _input_to_hash($data_to_decode, $ARGV[0], 1) if @ARGV && $ARGV[0];
if ($ENV{CONTENT_LENGTH}) {
my $content;
read STDIN, $content, $ENV{CONTENT_LENGTH};
+
if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
+ $self->post_data({});
+ my $post_data_to_decode = { };
+
# multipart formdata can bring it's own encoding, so give it both
- # and let ti decide on it's own
- _parse_multipart_formdata($target, $temp_target, $content);
+ # and let it decide on it's own
+ _parse_multipart_formdata($self->post_data, $post_data_to_decode, $content, 1);
+ _recode_recursively($iconv, $post_data_to_decode, $self->post_data) if keys %$post_data_to_decode;
+
+ $target->{$_} = $self->post_data->{$_} for keys %{ $self->post_data };
+
+ } elsif (($ENV{CONTENT_TYPE} // '') =~ m{^application/json}i) {
+ $self->post_data(_parse_json_formdata($content));
+
} else {
# normal encoding must be recoded
- _input_to_hash($temp_target, $content);
+ _input_to_hash($data_to_decode, $content, 1);
}
}
- my $encoding = delete $temp_target->{INPUT_ENCODING} || $db_charset;
-
- _recode_recursively(SL::Iconv->new($encoding, $db_charset), $temp_target => $target) if keys %$target;
+ _recode_recursively($iconv, $data_to_decode, $target) if keys %$data_to_decode;
if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
my %temp_form;
my ($source, $target, $prefix, $in_array) = @_;
$target ||= [];
- # there are two edge cases that need attention. first: more than one hash
- # inside an array. only the first of each nested can have a [+]. second: if
+ # There are two edge cases that need attention. First: more than one hash
+ # inside an array. Only the first of each nested can have a [+]. Second: if
# an array contains mixed values _store_value will rely on autovivification.
- # so any type change must have a [+]
- # this closure decides one recursion step AFTER an array has been found if a
+ # So any type change must have a [+]
+ # This closure decides one recursion step AFTER an array has been found if a
# [+] needs to be generated
my $arr_prefix = sub {
return $_[0] ? '[+]' : '[]' if $in_array;
for (ref $source) {
/^HASH$/ && do {
my $first = 1;
- for my $key (keys %$source) {
+ for my $key (sort keys %$source) {
flatten($source->{$key} => $target, (defined $prefix ? $prefix . $arr_prefix->($first) . '.' : '') . $key);
$first = 0;
};
=head1 SYNOPSIS
This module handles unpacking of CGI parameters. It also gives
-information about the request like whether or not it was done via AJAX
+information about the request, such as whether or not it was done via AJAX,
or the requested content type.
- use SL::Request qw(read_cgi_input);
+ use SL::Request;
# read cgi input depending on request type, unflatten and recode
- read_cgi_input($target_hash_ref);
+ $::request->read_cgi_input($target_hash_ref);
# $hashref and $new_hashref should be identical
my $new_arrayref = flatten($hashref);
=item Arrays
-Arrays will by trailing empty brackets (C<[]>). An hash like this
+Arrays will be marked by empty brackets (C<[]>). A hash like this
selected_id => [ 2, 6, 8, 9 ]
=item Nested structures
-A special version of this are nested hashs in an array, which is very common.
+A special version of this are nested hashes in an array, which is very common.
The combined operator (C<[].>) will be used. As a special case, every time a new
array slice is started, the special convention (C<[+].>) will be used. Again this
is because it's easy to write a template with it.
=item Sparse Arrays
-It is not possible to serialize somehing like
+It is not possible to serialize something like
sparse_array => do { my $sa = []; $sa[100] = 1; $sa },
This function will flatten the provided hash ref into the provided array ref.
The array ref may be non empty, but will be changed in this case.
-Return value is the flattened array ref.
+The return value is the flattened array ref.
=item C<unflatten ARRAYREF [ HASHREF ]>
=item C<layout>
Set and retrieve the layout object for the current request. Must be an instance
-of L<SL::Layout::Base>. Defaults to an isntance of L<SL::Layout::None>.
+of L<SL::Layout::Base>. Defaults to an instance of L<SL::Layout::None>.
For more information about layouts, see L<SL::Layout::Dispatcher>.
+=item C<cache $topic[, $default ]>
+
+Caches an item for the duration of the request. C<$topic> must be an
+index name referring to the thing to cache. It is used for retrieving
+it later on. If C<$topic> doesn't start with C<::> then the caller's
+package name is prepended to the topic. For example, if the a from
+package C<SL::StuffedStuff> calls with topic = C<get_stuff> then the
+actual key will be C<::SL::StuffedStuff::get_stuff>.
+
+If no item exists in the cache for C<$topic> then it is created and
+its initial value is set to C<$default>. If C<$default> is not given
+(undefined) then a new, empty hash reference is created.
+
+Returns the cached item.
+
+=item C<post_data>
+
+If the client sends data in the request body with the content type of
+either C<application/json> or C<multipart/form-data>, the content will
+be stored in the global request object, too. It can be retrieved via
+the C<post_data> function.
+
+For content type C<multipart/form-data> the same data is additionally
+stored in the global C<$::form> instance, potentially overwriting
+parameters given in the URL. This is done primarily for compatibility
+purposes with existing code that expects all parameters to be present
+in C<$::form>.
+
+For content type C<application/json> the data is only available in
+C<$::request>. The reason is that the top-level data in a JSON
+documents doesn't have to be an object which could be mapped to the
+hash C<$::form>. Instead, the top-level data can also be an
+array. Additionally keeping the namespaces of URL and POST parameters
+separate is cleaner and allows for fewer accidental conflicts.
+
=back
=head1 SPECIAL FUNCTIONS
=head2 C<_store_value()>
-parses a complex var name, and stores it in the form.
+Parses a complex var name, and stores it in the form.
-syntax:
+Syntax:
_store_value($target, $key, $value);
-keys must start with a string, and can contain various tokens.
-supported key structures are:
+Keys must start with a string, and can contain various tokens.
+Supported key structures are:
1. simple access
- simple key strings work as expected
+ Simple key strings work as expected
id => $form->{id}
2. hash access.
- separating two keys by a dot (.) will result in a hash lookup for the inner value
- this is similar to the behaviour of java and templating mechanisms.
+ Separating two keys by a dot (.) will result in a hash lookup for the inner value
+ This is similar to the behaviour of java and templating mechanisms.
filter.description => $form->{filter}->{description}
3. array+hashref access
- adding brackets ([]) before the dot will cause the next hash to be put into an array.
- using [+] instead of [] will force a new array index. this is useful for recurring
- data structures like part lists. put a [+] into the first varname, and use [] on the
+ Adding brackets ([]) before the dot will cause the next hash to be put into an array.
+ Using [+] instead of [] will force a new array index. This is useful for recurring
+ data structures like part lists. Put a [+] into the first varname, and use [] on the
following ones.
- repeating these names in your template:
+ Repeating these names in your template:
invoice.items[+].id
invoice.items[].parts_id
4. arrays
- using brackets at the end of a name will result in a pure array to be created.
- note that you mustn't use [+], which is reserved for array+hash access and will
+ Using brackets at the end of a name will result in the creation of a pure array.
+ Note that you mustn't use [+], which is reserved for array+hash access and will
result in undefined behaviour in array context.
filter.status[] => $form->{status}->[ val1, val2, ... ]
projects / kivitendo-erp.git / blobdiff