X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/c6d0de695657e132931e883c08f1436974bc22f2..b5f5d0631a2bc7cf065d65388c094d3fd4a2a160:/SL/Form.pm diff --git a/SL/Form.pm b/SL/Form.pm index 23dd5be50..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(''); @@ -810,11 +814,11 @@ 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_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}; @@ -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} }) {