use strict;
-use SL::Common;
-use SL::MoreCommon qw(uri_encode uri_decode);
+use parent qw(Rose::Object);
+
+use CGI qw(-no_xhtml);
use List::Util qw(first max min sum);
use List::MoreUtils qw(all any apply);
use Exporter qw(import);
+use SL::Common;
+use SL::MoreCommon qw(uri_encode uri_decode);
+use SL::Layout::None;
+use SL::Presenter;
+
our @EXPORT_OK = qw(flatten unflatten read_cgi_input);
+use Rose::Object::MakeMethods::Generic
+(
+ 'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax type) ],
+);
+
+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;
+}
+
+sub init_type {
+ return 'html';
+}
+
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;
+
+ # teach substr and length to use good ol' bytes, not 'em fancy characters
+ use bytes;
# 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
$ENV{'CONTENT_TYPE'} =~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/;
my $boundary = '--' . $1;
+ my $index = 0;
+ my $line_length;
foreach my $line (split m/\n/, $input) {
- last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));
+ $line_length = length $line;
- if (($line eq $boundary) || ($line eq "$boundary\r")) {
- ${ $previous } =~ s|\r?\n$|| if $previous;
- ${ $previous } = Encode::decode($encoding, $$previous) if $previous && !$filename && !$transfer_encoding eq 'binary';
+ if ($line =~ /^\Q$boundary\E(--)?\r?$/) {
+ my $last_boundary = $1;
+ my $data = substr $input, $data_start, $index - $data_start;
+ $data =~ s/\r?\n$//;
+
+ if ($previous && !$filename && $transfer_encoding && $transfer_encoding ne 'binary') {
+ ${ $previous } = Encode::decode($encoding, $data);
+ } 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;
}
if (!$line) {
$headers_done = 1;
+ $data_start = $index + $line_length + 1;
next;
}
next unless $previous;
- ${ $previous } .= "${line}\n";
+ } continue {
+ $index += $line_length + 1;
}
- ${ $previous } =~ s|\r?\n$|| if $previous;
-
$::lxdebug->leave_sub(2);
}
$::lxdebug->enter_sub;
my ($target) = @_;
- my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
# 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
# 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($temp_target, $ENV{QUERY_STRING}, 1) if $ENV{QUERY_STRING};
+ _input_to_hash($temp_target, $ARGV[0], 1) if @ARGV && $ARGV[0];
if ($ENV{CONTENT_LENGTH}) {
my $content;
if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
# 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);
+ _parse_multipart_formdata($target, $temp_target, $content, 1);
} else {
# normal encoding must be recoded
- _input_to_hash($temp_target, $content);
+ _input_to_hash($temp_target, $content, 1);
}
}
- my $encoding = delete $temp_target->{INPUT_ENCODING} || $db_charset;
+ my $encoding = delete $temp_target->{INPUT_ENCODING} || 'UTF-8';
- _recode_recursively(SL::Iconv->new($encoding, $db_charset), $temp_target => $target) if keys %$target;
+ _recode_recursively(SL::Iconv->new($encoding, 'UTF-8'), $temp_target => $target) if keys %$target;
if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
my %temp_form;
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 NAME
-SL::Request.pm - request parsing and data serialization
+SL::Request.pm - request parsing, data serialization, request information
=head1 SYNOPSIS
-This module handles unpacking of cgi parameters. usually you don't want to call
-anything in here directly.
+This module handles unpacking of CGI parameters. It also gives
+information about the request like whether or not it was done via AJAX
+or the requested content type.
use SL::Request qw(read_cgi_input);
my $new_arrayref = flatten($hashref);
my $new_hashref = unflatten($new_arrayref);
+ # Handle AJAX requests differently than normal requests:
+ if ($::request->is_ajax) {
+ $controller->render('json-mask', { type => 'json' });
+ } else {
+ $controller->render('full-mask');
+ }
=head1 DESCRIPTION
-This module handles flattening and unflattening of data for request
-roundtrip purposes. Lx-Office uses the format as described below:
+This module provides information about the request made by the
+browser.
+
+It also handles flattening and unflattening of data for request
+roundtrip purposes. kivitendo uses the format as described below:
=over 4
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.
+=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>).
+
+=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>.
+
+For more information about layouts, see L<SL::Layout::Dispatcher>.
+
=back
=head1 SPECIAL FUNCTIONS
projects / kivitendo-erp.git / blobdiff