kivitendo/SL/Request.pm @ dd9732d8
48abd6c9 | Sven Schöling | package SL::Request;
|
||
use strict;
|
||||
8c6871be | Moritz Bunkus | use parent qw(Rose::Object);
|
||
use CGI qw(-no_xhtml);
|
||||
48abd6c9 | Sven Schöling | use List::Util qw(first max min sum);
|
||
use List::MoreUtils qw(all any apply);
|
||||
9414d575 | Sven Schöling | use Exporter qw(import);
|
||
48abd6c9 | Sven Schöling | |||
8c6871be | Moritz Bunkus | use SL::Common;
|
||
7d5fbd92 | Moritz Bunkus | use SL::JSON;
|
||
8c6871be | Moritz Bunkus | use SL::MoreCommon qw(uri_encode uri_decode);
|
||
use SL::Layout::None;
|
||||
use SL::Presenter;
|
||||
7d5fbd92 | Moritz Bunkus | our @EXPORT_OK = qw(flatten unflatten);
|
||
48abd6c9 | Sven Schöling | |||
8c6871be | Moritz Bunkus | use Rose::Object::MakeMethods::Generic
|
||
(
|
||||
7d5fbd92 | Moritz Bunkus | scalar => [ qw(applying_database_upgrades post_data) ],
|
||
90d4d3fd | Sven Schöling | 'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax is_mobile type) ],
|
||
8c6871be | Moritz Bunkus | );
|
||
sub init_cgi {
|
||||
return CGI->new({});
|
||||
}
|
||||
sub init_layout {
|
||||
return SL::Layout::None->new;
|
||||
}
|
||||
sub init_presenter {
|
||||
return SL::Presenter->new;
|
||||
}
|
||||
sub init_is_ajax {
|
||||
return ($ENV{HTTP_X_REQUESTED_WITH} || '') eq 'XMLHttpRequest' ? 1 : 0;
|
||||
}
|
||||
90d4d3fd | Sven Schöling | 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;
|
||||
}
|
||||
8c6871be | Moritz Bunkus | sub init_type {
|
||
return 'html';
|
||||
}
|
||||
8e51379e | Sven Schöling | sub is_https {
|
||
$ENV{HTTPS} && 'on' eq lc $ENV{HTTPS};
|
||||
}
|
||||
55872fd8 | Moritz Bunkus | sub cache {
|
||
my ($self, $topic, $default) = @_;
|
||||
$topic = '::' . (caller(0))[0] . "::$topic" unless $topic =~ m{^::};
|
||||
$self->{_cache} //= {};
|
||||
$self->{_cache}->{$topic} //= ($default // {});
|
||||
return $self->{_cache}->{$topic};
|
||||
}
|
||||
9414d575 | Sven Schöling | sub _store_value {
|
||
48abd6c9 | Sven Schöling | my ($target, $key, $value) = @_;
|
||
9414d575 | Sven Schöling | my @tokens = split /((?:\[\+?\])?(?:\.)|(?:\[\+?\]))/, $key;
|
||
48abd6c9 | Sven Schöling | my $curr;
|
||
if (scalar @tokens) {
|
||||
$curr = \ $target->{ shift @tokens };
|
||||
}
|
||||
while (@tokens) {
|
||||
my $sep = shift @tokens;
|
||||
my $key = shift @tokens;
|
||||
9414d575 | Sven Schöling | $curr = \ $$curr->[$#$$curr], next if $sep eq '[]' && @tokens;
|
||
$curr = \ $$curr->[++$#$$curr], next if $sep eq '[]' && !@tokens;
|
||||
$curr = \ $$curr->[++$#$$curr], next if $sep eq '[+]';
|
||||
48abd6c9 | Sven Schöling | $curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].';
|
||
$curr = \ $$curr->[++$#$$curr] if $sep eq '[+].';
|
||||
$curr = \ $$curr->{$key}
|
||||
}
|
||||
$$curr = $value;
|
||||
return $curr;
|
||||
}
|
||||
sub _input_to_hash {
|
||||
$::lxdebug->enter_sub(2);
|
||||
e8557567 | Sven Schöling | my ($target, $input, $log) = @_;
|
||
48abd6c9 | Sven Schöling | my @pairs = split(/&/, $input);
|
||
foreach (@pairs) {
|
||||
my ($key, $value) = split(/=/, $_, 2);
|
||||
e8557567 | Sven Schöling | 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;
|
||||
48abd6c9 | Sven Schöling | }
|
||
$::lxdebug->leave_sub(2);
|
||||
}
|
||||
6056e1d7 | Sven Schöling | sub _parse_multipart_formdata {
|
||
e8557567 | Sven Schöling | my ($target, $temp_target, $input, $log) = @_;
|
||
4785d221 | Sven Schöling | my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous, $p_attachment, $encoding, $transfer_encoding);
|
||
dc3f6120 | Sven Schöling | my $data_start = 0;
|
||
# teach substr and length to use good ol' bytes, not 'em fancy characters
|
||||
use bytes;
|
||||
6056e1d7 | Sven Schöling | |||
# We SHOULD honor encodings and transfer-encodings here, but as hard as I
|
||||
# looked I couldn't find a reasonably recent webbrowser that makes use of
|
||||
# these. Transfer encoding just eats up bandwidth...
|
||||
48abd6c9 | Sven Schöling | |||
6056e1d7 | Sven Schöling | # so all I'm going to do is add a fail safe that if anyone ever encounters
|
||
# this, it's going to croak so that debugging is easier
|
||||
$ENV{'CONTENT_TYPE'} =~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/;
|
||||
48abd6c9 | Sven Schöling | my $boundary = '--' . $1;
|
||
dc3f6120 | Sven Schöling | my $index = 0;
|
||
my $line_length;
|
||||
48abd6c9 | Sven Schöling | foreach my $line (split m/\n/, $input) {
|
||
dc3f6120 | Sven Schöling | $line_length = length $line;
|
||
if ($line =~ /^\Q$boundary\E(--)?\r?$/) {
|
||||
my $last_boundary = $1;
|
||||
my $data = substr $input, $data_start, $index - $data_start;
|
||||
$data =~ s/\r?\n$//;
|
||||
48abd6c9 | Sven Schöling | |||
dc3f6120 | Sven Schöling | if ($previous && !$filename && $transfer_encoding && $transfer_encoding ne 'binary') {
|
||
${ $previous } = Encode::decode($encoding, $data);
|
||||
} else {
|
||||
${ $previous } = $data;
|
||||
}
|
||||
e8557567 | Sven Schöling | $::lxdebug->add_request_params($name, $$previous) if $log;
|
||
48abd6c9 | Sven Schöling | |||
undef $previous;
|
||||
undef $filename;
|
||||
$headers_done = 0;
|
||||
$content_type = "text/plain";
|
||||
$boundary_found = 1;
|
||||
$need_cr = 0;
|
||||
dbda14c2 | Moritz Bunkus | $encoding = 'UTF-8';
|
||
6056e1d7 | Sven Schöling | $transfer_encoding = undef;
|
||
dc3f6120 | Sven Schöling | last if $last_boundary;
|
||
48abd6c9 | Sven Schöling | next;
|
||
}
|
||||
next unless $boundary_found;
|
||||
if (!$headers_done) {
|
||||
$line =~ s/[\r\n]*$//;
|
||||
if (!$line) {
|
||||
$headers_done = 1;
|
||||
dc3f6120 | Sven Schöling | $data_start = $index + $line_length + 1;
|
||
48abd6c9 | Sven Schöling | next;
|
||
}
|
||||
if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) {
|
||||
if ($line =~ m|filename\s*=\s*"(.*?)"|i) {
|
||||
$filename = $1;
|
||||
substr $line, $-[0], $+[0] - $-[0], "";
|
||||
}
|
||||
if ($line =~ m|name\s*=\s*"(.*?)"|i) {
|
||||
$name = $1;
|
||||
substr $line, $-[0], $+[0] - $-[0], "";
|
||||
}
|
||||
4785d221 | Sven Schöling | if ($name) {
|
||
# legacy, some old upload routines expect this to be here
|
||||
$temp_target->{FILENAME} = $filename if defined $filename;
|
||||
48abd6c9 | Sven Schöling | |||
7c215391 | Geoffrey Richardson | # 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
|
||||
4785d221 | Sven Schöling | # 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);
|
||||
# set the reference for appending of multiline data to the correct one
|
||||
$previous = defined $filename ? $target_slot : $temp_target_slot;
|
||||
# for multiple uploads: save the attachments in a SL/Mailer like structure
|
||||
if (defined $filename) {
|
||||
my $target_attachment = _store_value($target, "ATTACHMENTS.$name", {});
|
||||
my $temp_target_attachment = _store_value($temp_target, "ATTACHMENTS.$name", {});
|
||||
$$target_attachment->{data} = $previous;
|
||||
$$temp_target_attachment->{filename} = $filename;
|
||||
$p_attachment = $$temp_target_attachment;
|
||||
}
|
||||
34967eb4 | Sven Schöling | }
|
||
48abd6c9 | Sven Schöling | next;
|
||
}
|
||||
6056e1d7 | Sven Schöling | if ($line =~ m|^content-type\s*:\s*(.*?)[;\$]|i) {
|
||
48abd6c9 | Sven Schöling | $content_type = $1;
|
||
4785d221 | Sven Schöling | $p_attachment->{content_type} = $1;
|
||
6056e1d7 | Sven Schöling | |||
if ($content_type =~ /^text/ && $line =~ m|;\s*charset\s*:\s*("?)(.*?)\1$|i) {
|
||||
$encoding = $2;
|
||||
}
|
||||
next;
|
||||
}
|
||||
if ($line =~ m|^content-transfer-encoding\s*=\s*(.*?)$|i) {
|
||||
$transfer_encoding = lc($1);
|
||||
if ($transfer_encoding && $transfer_encoding !~ /^[78]bit|binary$/) {
|
||||
die 'Transfer encodings beyond 7bit/8bit and binary are not implemented.';
|
||||
}
|
||||
4785d221 | Sven Schöling | $p_attachment->{transfer_encoding} = $transfer_encoding;
|
||
6056e1d7 | Sven Schöling | |||
next;
|
||||
48abd6c9 | Sven Schöling | }
|
||
next;
|
||||
}
|
||||
next unless $previous;
|
||||
dc3f6120 | Sven Schöling | } continue {
|
||
$index += $line_length + 1;
|
||||
48abd6c9 | Sven Schöling | }
|
||
$::lxdebug->leave_sub(2);
|
||||
}
|
||||
7d5fbd92 | Moritz Bunkus | sub _parse_json_formdata {
|
||
my ($content) = @_;
|
||||
return $content ? SL::JSON::decode_json($content) : undef;
|
||||
}
|
||||
48abd6c9 | Sven Schöling | sub _recode_recursively {
|
||
6056e1d7 | Sven Schöling | $::lxdebug->enter_sub;
|
||
my ($iconv, $from, $to) = @_;
|
||||
48abd6c9 | Sven Schöling | |||
6056e1d7 | Sven Schöling | if (any { ref $from eq $_ } qw(Form HASH)) {
|
||
for my $key (keys %{ $from }) {
|
||||
if (!ref $from->{$key}) {
|
||||
# Workaround for a bug: converting $from->{$key} directly
|
||||
48abd6c9 | Sven Schöling | # leads to 'undef'. I don't know why. Converting a copy works,
|
||
# though.
|
||||
4785d221 | Sven Schöling | $to->{$key} = $iconv->convert("" . $from->{$key}) if defined $from->{$key} && !defined $to->{$key};
|
||
48abd6c9 | Sven Schöling | } else {
|
||
efd3ab01 | Sven Schöling | $to->{$key} ||= {} if 'HASH' eq ref $from->{$key};
|
||
$to->{$key} ||= [] if 'ARRAY' eq ref $from->{$key};
|
||||
6056e1d7 | Sven Schöling | _recode_recursively($iconv, $from->{$key}, $to->{$key});
|
||
48abd6c9 | Sven Schöling | }
|
||
}
|
||||
6056e1d7 | Sven Schöling | } elsif (ref $from eq 'ARRAY') {
|
||
foreach my $idx (0 .. scalar(@{ $from }) - 1) {
|
||||
if (!ref $from->[$idx]) {
|
||||
# Workaround for a bug: converting $from->[$idx] directly
|
||||
48abd6c9 | Sven Schöling | # leads to 'undef'. I don't know why. Converting a copy works,
|
||
# though.
|
||||
6ccea476 | Martin Helmling | $to->[$idx] = $iconv->convert("" . $from->[$idx]) if defined $from->[$idx] && !defined $to->[$idx];
|
||
48abd6c9 | Sven Schöling | } else {
|
||
efd3ab01 | Sven Schöling | $to->[$idx] ||= {} if 'HASH' eq ref $from->[$idx];
|
||
$to->[$idx] ||= [] if 'ARRAY' eq ref $from->[$idx];
|
||||
6056e1d7 | Sven Schöling | _recode_recursively($iconv, $from->[$idx], $to->[$idx]);
|
||
48abd6c9 | Sven Schöling | }
|
||
}
|
||||
}
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub read_cgi_input {
|
||||
$::lxdebug->enter_sub;
|
||||
7d5fbd92 | Moritz Bunkus | my ($self, $target) = @_;
|
||
6056e1d7 | Sven Schöling | |||
# 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
|
||||
# tactical recode nuke at the data is still worse.
|
||||
48abd6c9 | Sven Schöling | |||
6056e1d7 | Sven Schöling | # 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
|
||||
7d5fbd92 | Moritz Bunkus | $self->post_data(undef);
|
||
my $data_to_decode = { };
|
||||
my $iconv = SL::Iconv->new('UTF-8', 'UTF-8');
|
||||
6056e1d7 | Sven Schöling | |||
7d5fbd92 | Moritz Bunkus | _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];
|
||||
48abd6c9 | Sven Schöling | |||
if ($ENV{CONTENT_LENGTH}) {
|
||||
my $content;
|
||||
read STDIN, $content, $ENV{CONTENT_LENGTH};
|
||||
7d5fbd92 | Moritz Bunkus | |||
6056e1d7 | Sven Schöling | if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
|
||
7d5fbd92 | Moritz Bunkus | $self->post_data({});
|
||
my $post_data_to_decode = { };
|
||||
6056e1d7 | Sven Schöling | # multipart formdata can bring it's own encoding, so give it both
|
||
7c215391 | Geoffrey Richardson | # and let it decide on it's own
|
||
7d5fbd92 | Moritz Bunkus | _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 };
|
||||
bfe30464 | Moritz Bunkus | } elsif (($ENV{CONTENT_TYPE} // '') =~ m{^application/json}i) {
|
||
7d5fbd92 | Moritz Bunkus | $self->post_data(_parse_json_formdata($content));
|
||
6056e1d7 | Sven Schöling | } else {
|
||
# normal encoding must be recoded
|
||||
7d5fbd92 | Moritz Bunkus | _input_to_hash($data_to_decode, $content, 1);
|
||
6056e1d7 | Sven Schöling | }
|
||
48abd6c9 | Sven Schöling | }
|
||
7d5fbd92 | Moritz Bunkus | _recode_recursively($iconv, $data_to_decode, $target) if keys %$data_to_decode;
|
||
ec52855f | Sven Schöling | |||
48abd6c9 | Sven Schöling | if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
|
||
my %temp_form;
|
||||
$::auth->restore_form_from_session(delete $target->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
|
||||
6056e1d7 | Sven Schöling | _store_value($target, $_, $temp_form{$_}) for keys %temp_form;
|
||
48abd6c9 | Sven Schöling | }
|
||
$::lxdebug->leave_sub;
|
||||
return $target;
|
||||
}
|
||||
9414d575 | Sven Schöling | sub flatten {
|
||
my ($source, $target, $prefix, $in_array) = @_;
|
||||
$target ||= [];
|
||||
7c215391 | Geoffrey Richardson | # 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
|
||||
9414d575 | Sven Schöling | # an array contains mixed values _store_value will rely on autovivification.
|
||
7c215391 | Geoffrey Richardson | # So any type change must have a [+]
|
||
# This closure decides one recursion step AFTER an array has been found if a
|
||||
9414d575 | Sven Schöling | # [+] needs to be generated
|
||
my $arr_prefix = sub {
|
||||
return $_[0] ? '[+]' : '[]' if $in_array;
|
||||
return '';
|
||||
};
|
||||
for (ref $source) {
|
||||
/^HASH$/ && do {
|
||||
my $first = 1;
|
||||
95470a2f | Sven Schöling | for my $key (sort keys %$source) {
|
||
9414d575 | Sven Schöling | flatten($source->{$key} => $target, (defined $prefix ? $prefix . $arr_prefix->($first) . '.' : '') . $key);
|
||
$first = 0;
|
||||
};
|
||||
next;
|
||||
};
|
||||
/^ARRAY$/ && do {
|
||||
for my $i (0 .. $#$source) {
|
||||
flatten($source->[$i] => $target, $prefix . $arr_prefix->($i == 0), '1');
|
||||
}
|
||||
next;
|
||||
};
|
||||
!$_ && do {
|
||||
die "can't flatten a pure scalar" unless defined $prefix;
|
||||
push @$target, [ $prefix . $arr_prefix->(0) => $source ];
|
||||
next;
|
||||
};
|
||||
die "unrecognized reference of a data structure $_. cannot serialize refs, globs and code yet. to serialize Form please use the method there";
|
||||
}
|
||||
return $target;
|
||||
}
|
||||
sub unflatten {
|
||||
my ($data, $target) = @_;
|
||||
$target ||= {};
|
||||
for my $pair (@$data) {
|
||||
_store_value($target, @$pair) if defined $pair->[0];
|
||||
}
|
||||
return $target;
|
||||
}
|
||||
48abd6c9 | Sven Schöling | 1;
|
||
__END__
|
||||
=head1 NAME
|
||||
8c6871be | Moritz Bunkus | SL::Request.pm - request parsing, data serialization, request information
|
||
48abd6c9 | Sven Schöling | |||
=head1 SYNOPSIS
|
||||
8c6871be | Moritz Bunkus | This module handles unpacking of CGI parameters. It also gives
|
||
7c215391 | Geoffrey Richardson | information about the request, such as whether or not it was done via AJAX,
|
||
8c6871be | Moritz Bunkus | or the requested content type.
|
||
9414d575 | Sven Schöling | |||
7d5fbd92 | Moritz Bunkus | use SL::Request;
|
||
9414d575 | Sven Schöling | |||
# read cgi input depending on request type, unflatten and recode
|
||||
7d5fbd92 | Moritz Bunkus | $::request->read_cgi_input($target_hash_ref);
|
||
9414d575 | Sven Schöling | |||
# $hashref and $new_hashref should be identical
|
||||
my $new_arrayref = flatten($hashref);
|
||||
my $new_hashref = unflatten($new_arrayref);
|
||||
8c6871be | Moritz Bunkus | # Handle AJAX requests differently than normal requests:
|
||
if ($::request->is_ajax) {
|
||||
$controller->render('json-mask', { type => 'json' });
|
||||
} else {
|
||||
$controller->render('full-mask');
|
||||
}
|
||||
9414d575 | Sven Schöling | |||
=head1 DESCRIPTION
|
||||
8c6871be | Moritz Bunkus | This module provides information about the request made by the
|
||
browser.
|
||||
It also handles flattening and unflattening of data for request
|
||||
008c2e15 | Moritz Bunkus | roundtrip purposes. kivitendo uses the format as described below:
|
||
9414d575 | Sven Schöling | |||
=over 4
|
||||
=item Hashes
|
||||
Hash entries will be connected with a dot (C<.>). A simple hash like this
|
||||
order => {
|
||||
item => 2,
|
||||
customer => 5
|
||||
}
|
||||
will be serialized to
|
||||
[ order.item => 2 ],
|
||||
[ order.customer => 5 ],
|
||||
=item Arrays
|
||||
7c215391 | Geoffrey Richardson | Arrays will be marked by empty brackets (C<[]>). A hash like this
|
||
9414d575 | Sven Schöling | |||
selected_id => [ 2, 6, 8, 9 ]
|
||||
will be flattened to
|
||||
[ selected_id[] => 2 ],
|
||||
[ selected_id[] => 6 ],
|
||||
[ selected_id[] => 8 ],
|
||||
[ selected_id[] => 9 ],
|
||||
Since this will produce identical keys, the resulting flattened list can not be
|
||||
used as a hash. It is however very easy to use this in a template to generate
|
||||
input:
|
||||
[% FOREACH id = selected_ids %]
|
||||
<input type="hidden" name="selected_id[]" value="[% id | html %]">
|
||||
[% END %]
|
||||
=item Nested structures
|
||||
7c215391 | Geoffrey Richardson | A special version of this are nested hashes in an array, which is very common.
|
||
9414d575 | Sven Schöling | 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.
|
||||
So this
|
||||
order => {
|
||||
orderitems => [
|
||||
{
|
||||
id => 1,
|
||||
part => 15
|
||||
},
|
||||
{
|
||||
id => 2,
|
||||
part => 7
|
||||
},
|
||||
]
|
||||
}
|
||||
will be
|
||||
[ order.orderitems[+].id => 1 ],
|
||||
[ order.orderitems[].part => 15 ],
|
||||
[ order.orderitems[+].id => 2 ],
|
||||
[ order.orderitems[].part => 7 ],
|
||||
=item Limitations
|
||||
The format currently does have certain limitations when compared to other
|
||||
serialization formats.
|
||||
=over 4
|
||||
=item Order
|
||||
The order of serialized values matters to reconstruct arrays properly. This
|
||||
should rarely be a problem if you just flatten and dump into a url or a field
|
||||
of hiddens.
|
||||
=item Empty Keys
|
||||
The current implementation of flatten does produce correct serialization of
|
||||
empty keys, but unflatten is unable to resolve these. Do no use C<''> or
|
||||
C<undef> as keys. C<0> is fine.
|
||||
=item Key Escaping
|
||||
You cannot use the tokens C<[]>, C<[+]> and C<.> in keys. No way around it.
|
||||
=item Sparse Arrays
|
||||
7c215391 | Geoffrey Richardson | It is not possible to serialize something like
|
||
9414d575 | Sven Schöling | |||
sparse_array => do { my $sa = []; $sa[100] = 1; $sa },
|
||||
This is a feature, as perl doesn't do well with very large arrays.
|
||||
=item Recursion
|
||||
There is currently no support nor prevention for flattening a circular structure.
|
||||
=item Custom Delimiter
|
||||
No support for other delimiters, sorry.
|
||||
=item Other References
|
||||
No support for globs, scalar refs, code refs, filehandles and the like. These will die.
|
||||
=back
|
||||
=back
|
||||
=head1 FUNCTIONS
|
||||
=over 4
|
||||
=item C<flatten HASHREF [ ARRAYREF ]>
|
||||
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.
|
||||
7c215391 | Geoffrey Richardson | The return value is the flattened array ref.
|
||
9414d575 | Sven Schöling | |||
=item C<unflatten ARRAYREF [ HASHREF ]>
|
||||
This function will parse the array ref, and will store the contents into the hash ref. The hash ref may be non empty, in this case any new keys will override the old ones only on leafs with same type. Type changes on a node will die.
|
||||
48abd6c9 | Sven Schöling | |||
8c6871be | Moritz Bunkus | =item C<is_ajax>
|
||
Returns trueish if the request is an XML HTTP request, also known as
|
||||
an 'AJAX' request.
|
||||
=item C<type>
|
||||
Returns the requested content type (either C<html>, C<js> or C<json>).
|
||||
42f69828 | Sven Schöling | =item C<layout>
|
||
Set and retrieve the layout object for the current request. Must be an instance
|
||||
7c215391 | Geoffrey Richardson | of L<SL::Layout::Base>. Defaults to an instance of L<SL::Layout::None>.
|
||
42f69828 | Sven Schöling | |||
For more information about layouts, see L<SL::Layout::Dispatcher>.
|
||||
55872fd8 | Moritz Bunkus | =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.
|
||||
7d5fbd92 | Moritz Bunkus | =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.
|
||||
9414d575 | Sven Schöling | =back
|
||
48abd6c9 | Sven Schöling | |||
=head1 SPECIAL FUNCTIONS
|
||||
=head2 C<_store_value()>
|
||||
7c215391 | Geoffrey Richardson | Parses a complex var name, and stores it in the form.
|
||
48abd6c9 | Sven Schöling | |||
7c215391 | Geoffrey Richardson | Syntax:
|
||
9414d575 | Sven Schöling | _store_value($target, $key, $value);
|
||
48abd6c9 | Sven Schöling | |||
7c215391 | Geoffrey Richardson | Keys must start with a string, and can contain various tokens.
|
||
Supported key structures are:
|
||||
48abd6c9 | Sven Schöling | |||
1. simple access
|
||||
7c215391 | Geoffrey Richardson | Simple key strings work as expected
|
||
48abd6c9 | Sven Schöling | |||
id => $form->{id}
|
||||
2. hash access.
|
||||
7c215391 | Geoffrey Richardson | 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.
|
||||
48abd6c9 | Sven Schöling | |||
filter.description => $form->{filter}->{description}
|
||||
3. array+hashref access
|
||||
7c215391 | Geoffrey Richardson | 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
|
||||
48abd6c9 | Sven Schöling | following ones.
|
||
7c215391 | Geoffrey Richardson | Repeating these names in your template:
|
||
48abd6c9 | Sven Schöling | |||
invoice.items[+].id
|
||||
invoice.items[].parts_id
|
||||
will result in:
|
||||
$form->{invoice}->{items}->[
|
||||
{
|
||||
id => ...
|
||||
parts_id => ...
|
||||
},
|
||||
{
|
||||
id => ...
|
||||
parts_id => ...
|
||||
}
|
||||
...
|
||||
]
|
||||
4. arrays
|
||||
7c215391 | Geoffrey Richardson | 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
|
||||
48abd6c9 | Sven Schöling | result in undefined behaviour in array context.
|
||
filter.status[] => $form->{status}->[ val1, val2, ... ]
|
||||
=cut
|