X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=b3a3e23dff21756173b119f7ab689f28362d702c;hb=8893354909b940b99cb05e85e1964bfc5e805baa;hp=6e7145f20fb5d773897029abe9508fb422b3adbf;hpb=3ceb381944924a7b6a14d69361754422b8b49589;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 6e7145f20..b3a3e23df 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -52,6 +52,7 @@ use SL::AM; use SL::Common; use SL::CVar; use SL::DB; +use SL::DBConnect; use SL::DBUtils; use SL::DO; use SL::IC; @@ -61,6 +62,7 @@ use SL::Menu; use SL::OE; use SL::Template; use SL::User; +use SL::X; use Template; use URI; use List::Util qw(first max min sum); @@ -133,6 +135,7 @@ sub _request_to_hash { my $self = shift; my $input = shift; + my $uploads = {}; if (!$ENV{'CONTENT_TYPE'} || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { @@ -140,7 +143,7 @@ sub _request_to_hash { $self->_input_to_hash($input); $main::lxdebug->leave_sub(2); - return; + return $uploads; } my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); @@ -185,7 +188,7 @@ sub _request_to_hash { substr $line, $-[0], $+[0] - $-[0], ""; } - $previous = $self->_store_value($name, '') if ($name); + $previous = _store_value($uploads, $name, '') if ($name); $self->{FILENAME} = $filename if ($filename); next; @@ -206,6 +209,8 @@ sub _request_to_hash { ${ $previous } =~ s|\r?\n$|| if $previous; $main::lxdebug->leave_sub(2); + + return $uploads; } sub _recode_recursively { @@ -256,10 +261,11 @@ sub new { $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; + my $uploads; if ($ENV{CONTENT_LENGTH}) { my $content; read STDIN, $content, $ENV{CONTENT_LENGTH}; - $self->_request_to_hash($content); + $uploads = $self->_request_to_hash($content); } my $db_charset = $::lx_office_conf{system}->{dbcharset}; @@ -270,6 +276,8 @@ sub new { _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self); + map { $self->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads; + #$self->{version} = "2.6.1"; # Old hardcoded but secure style open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file $self->{version} = ; @@ -451,7 +459,7 @@ sub hide_form { sub throw_on_error { my ($self, $code) = @_; - local $self->{__ERROR_HANDLER} = sub { die({ error => $_[0] }) }; + local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) }; $code->(); } @@ -623,6 +631,8 @@ sub create_http_response { $cgi_params{'-charset'} = $params{charset} if ($params{charset}); $cgi_params{'-cookie'} = $session_cookie if ($session_cookie); + map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length); + my $output = $cgi->header(%cgi_params); $main::lxdebug->leave_sub(); @@ -737,7 +747,7 @@ sub redirect_header { my $base_uri = $self->_get_request_uri; my $new_uri = URI->new_abs($new_url, $base_uri); - die "Headers already sent" if $::self->{header}; + die "Headers already sent" if $self->{header}; $self->{header} = 1; my $cgi = $main::cgi || CGI->new(''); @@ -804,12 +814,12 @@ sub _prepare_html_template { } $additional_params->{"conf_dbcharset"} = $::lx_office_conf{system}->{dbcharset}; - $additional_params->{"conf_webdav"} = $::lx_office_conf{system}->{webdav}; - $additional_params->{"conf_lizenzen"} = $::lx_office_conf{system}->{lizenzen}; + $additional_params->{"conf_webdav"} = $::lx_office_conf{features}->{webdav}; + $additional_params->{"conf_lizenzen"} = $::lx_office_conf{features}->{lizenzen}; $additional_params->{"conf_latex_templates"} = $::lx_office_conf{print_templates}->{latex}; $additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument}; - $additional_params->{"conf_vertreter"} = $::lx_office_conf{system}->{vertreter}; - $additional_params->{"conf_show_best_before"} = $::lx_office_conf{system}->{show_best_before}; + $additional_params->{"conf_vertreter"} = $::lx_office_conf{features}->{vertreter}; + $additional_params->{"conf_show_best_before"} = $::lx_office_conf{features}->{show_best_before}; $additional_params->{"conf_parts_image_css"} = $::lx_office_conf{features}->{parts_image_css}; $additional_params->{"conf_parts_listing_images"} = $::lx_office_conf{features}->{parts_listing_images}; $additional_params->{"conf_parts_show_image"} = $::lx_office_conf{features}->{parts_show_image}; @@ -987,17 +997,13 @@ sub redirect { my ($self, $msg) = @_; if (!$self->{callback}) { - $self->info($msg); - ::end_of_request(); - } -# my ($script, $argv) = split(/\?/, $self->{callback}, 2); -# $script =~ s|.*/||; -# $script =~ s|[^a-zA-Z0-9_\.]||g; -# exec("perl", "$script", $argv); + } else { + print $::form->redirect_header($self->{callback}); + } - print $::form->redirect_header($self->{callback}); + ::end_of_request(); $main::lxdebug->leave_sub(); } @@ -1574,7 +1580,7 @@ sub dbconnect { my ($self, $myconfig) = @_; # connect to database - my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options) + my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options) or $self->dberror; # set db options @@ -1593,7 +1599,7 @@ sub dbconnect_noauto { my ($self, $myconfig) = @_; # connect to database - my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0)) + my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0)) or $self->dberror; # set db options @@ -2453,7 +2459,8 @@ sub _get_warehouses { $self->{$key} = selectall_hashref_query($self, $dbh, $query); if ($bins_key) { - $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|; + $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ? + ORDER BY description|; my $sth = prepare_query($self, $dbh, $query); foreach my $warehouse (@{ $self->{$key} }) {