X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=b3a3e23dff21756173b119f7ab689f28362d702c;hb=8893354909b940b99cb05e85e1964bfc5e805baa;hp=b2cb1dead91686ace4d8c6f10c06f2a9bbeef520;hpb=0bf9f21482c4581f8cea90cc8d847f876682302f;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index b2cb1dead..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); @@ -457,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->(); } @@ -629,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(); @@ -743,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(''); @@ -993,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(); } @@ -1580,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 @@ -1599,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 @@ -2459,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} }) {