X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=71538515474d9b80f7cd6fa9e55b6463d6bd9c27;hb=a7d906be599d13f0e0477987437540243ce886d3;hp=9a7c9e1759673c8474dd9ff27aef30d5c6e9aa70;hpb=66c9114861885f75a29030682be83976cd93838b;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 9a7c9e175..715385154 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -37,8 +37,6 @@ package Form; -#use strict; - use Data::Dumper; use CGI; @@ -57,6 +55,9 @@ use SL::Template; use SL::User; use Template; use List::Util qw(first max min sum); +use List::MoreUtils qw(any); + +use strict; my $standard_dbh; @@ -67,62 +68,6 @@ END { } } -=item _store_value() - -parses a complex var name, and stores it in the form. - -syntax: - $form->_store_value($key, $value); - -keys must start with a string, and can contain various tokens. -supported key structures are: - -1. simple access - simple key strings work as expected - - id => $form->{id} - -2. hash access. - 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. - - filter.description => $form->{filter}->{description} - -3. array+hashref access - - 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 - following ones. - - repeating these names in your template: - - invoice.items[+].id - invoice.items[].parts_id - - will result in: - - $form->{invoice}->{items}->[ - { - id => ... - parts_id => ... - }, - { - id => ... - parts_id => ... - } - ... - ] - -4. arrays - - using brackets at the end of a name will result in a pure array to be created. - note that you mustn't use [+], which is reserved for array+hash access and will - result in undefined behaviour in array context. - - filter.status[] => $form->{status}->[ val1, val2, ... ] - -=cut sub _store_value { $main::lxdebug->enter_sub(2); @@ -255,7 +200,7 @@ sub _recode_recursively { $main::lxdebug->enter_sub(); my ($iconv, $param) = @_; - if (ref $param eq 'HASH') { + if (any { ref $param eq $_ } qw(Form HASH)) { foreach my $key (keys %{ $param }) { if (!ref $param->{$key}) { $param->{$key} = $iconv->convert($param->{$key}); @@ -305,13 +250,15 @@ sub new { my $db_charset = $main::dbcharset; $db_charset ||= Common::DEFAULT_CHARSET; - if ($self->{INPUT_ENCODING} && (lc $self->{INPUT_ENCODING} ne $db_charset)) { - require Text::Iconv; - my $iconv = Text::Iconv->new($self->{INPUT_ENCODING}, $db_charset); + if ($self->{INPUT_ENCODING}) { + if (lc $self->{INPUT_ENCODING} ne lc $db_charset) { + require Text::Iconv; + my $iconv = Text::Iconv->new($self->{INPUT_ENCODING}, $db_charset); - _recode_recursively($iconv, $self); + _recode_recursively($iconv, $self); + } - delete $self{INPUT_ENCODING}; + delete $self->{INPUT_ENCODING}; } $self->{action} = lc $self->{action}; @@ -606,9 +553,10 @@ sub create_http_response { my $session_cookie_value = $main::auth->get_session_id(); $session_cookie_value ||= 'NO_SESSION'; - $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), - '-value' => $session_cookie_value, - '-path' => $base_path); + $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), + '-value' => $session_cookie_value, + '-path' => $base_path, + '-secure' => $ENV{HTTPS}); } my %cgi_params = ('-type' => $params{content_type}); @@ -626,6 +574,8 @@ sub create_http_response { sub header { $main::lxdebug->enter_sub(); + # extra code ist currently only used by menuv3 and menuv4 to set their css. + # it is strongly deprecated, and will be changed in a future version. my ($self, $extra_code) = @_; if ($self->{header}) { @@ -670,13 +620,22 @@ sub header { |; } - my $fokus = qq| document.$self->{fokus}.focus();| if ($self->{"fokus"}); + my $fokus = qq| + + | if $self->{"fokus"}; #Set Calendar my $jsscript = ""; if ($self->{jsscript} == 1) { $jsscript = qq| + @@ -707,13 +666,9 @@ sub header { $jsscript $ajax - + $fokus + + @@ -1354,6 +1309,7 @@ Content-Length: $numbytes while () { print OUT $_; + } close(OUT); @@ -1393,6 +1349,7 @@ sub get_formname_translation { storno_packing_list => $main::locale->text('Storno Packing List'), sales_delivery_order => $main::locale->text('Delivery Order'), purchase_delivery_order => $main::locale->text('Delivery Order'), + dunning => $main::locale->text('Dunning'), ); $main::lxdebug->leave_sub(); @@ -1480,7 +1437,7 @@ sub cleanup { close(FH); } - if ($self->{tmpfile}) { + if ($self->{tmpfile} && ! $::keep_temp_files) { $self->{tmpfile} =~ s|.*/||g; # strip extension $self->{tmpfile} =~ s/\.\w+$//g; @@ -1579,7 +1536,7 @@ sub get_standard_dbh { my ($self, $myconfig) = @_; if ($standard_dbh && !$standard_dbh->{Active}) { - $main::lxdebug->message(LXDebug::INFO, "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); + $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); undef $standard_dbh; } @@ -2015,6 +1972,8 @@ sub get_employee { my ($self, $dbh) = @_; + $dbh ||= $self->get_standard_dbh(\%main::myconfig); + my $query = qq|SELECT id, name FROM employee WHERE login = ?|; ($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login}); $self->{"employee_id"} *= 1; @@ -2057,11 +2016,11 @@ sub get_duedate { my ($self, $myconfig, $reference_date) = @_; - my $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date'; + $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date'; - my $dbh = $self->get_standard_dbh($myconfig); - my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|; - my ($duedate) = selectrow_query($self, $dbh, $query, $self->{payment_id}); + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|; + my ($duedate) = selectrow_query($self, $dbh, $query, $self->{payment_id}); $main::lxdebug->leave_sub(); @@ -2188,7 +2147,7 @@ sub _get_charts { my $transdate = quote_db_date($params->{transdate}); my $query = - qq|SELECT c.id, c.accno, c.description, c.link, tk.taxkey_id, tk.tax_id | . + qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | . qq|FROM chart c | . qq|LEFT JOIN taxkeys tk ON | . qq|(tk.id = (SELECT id FROM taxkeys | . @@ -2727,7 +2686,7 @@ sub all_departments { ORDER BY description|; $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); - delete($self->{all_departments}) unless (@{ $self->{all_departments} }); + delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] }); $main::lxdebug->leave_sub(); } @@ -3299,19 +3258,6 @@ sub update_defaults { return $var; } -=item update_business - -PARAMS (not named): - \%config, - config hashref - $business_id, - business id - $dbh - optional database handle - -handles business (thats customer/vendor types) sequences. - -special behaviour for empty strings in customerinitnumber field: -will in this case not increase the value, and return undef. - -=cut sub update_business { $main::lxdebug->enter_sub(); @@ -3485,3 +3431,93 @@ sub restore_vars { } 1; + +__END__ + +=head1 NAME + +SL::Form.pm - main data object. + +=head1 SYNOPSIS + +This is the main data object of Lx-Office. +Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points. +Points of interest for a beginner are: + + - $form->error - renders a generic error in html. accepts an error message + - $form->get_standard_dbh - returns a database connection for the + +=head1 SPECIAL FUNCTIONS + +=over 4 + +=item _store_value() + +parses a complex var name, and stores it in the form. + +syntax: + $form->_store_value($key, $value); + +keys must start with a string, and can contain various tokens. +supported key structures are: + +1. simple access + simple key strings work as expected + + id => $form->{id} + +2. hash access. + 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. + + filter.description => $form->{filter}->{description} + +3. array+hashref access + + 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 + following ones. + + repeating these names in your template: + + invoice.items[+].id + invoice.items[].parts_id + + will result in: + + $form->{invoice}->{items}->[ + { + id => ... + parts_id => ... + }, + { + id => ... + parts_id => ... + } + ... + ] + +4. arrays + + using brackets at the end of a name will result in a pure array to be created. + note that you mustn't use [+], which is reserved for array+hash access and will + result in undefined behaviour in array context. + + filter.status[] => $form->{status}->[ val1, val2, ... ] + +=item update_business PARAMS + +PARAMS (not named): + \%config, - config hashref + $business_id, - business id + $dbh - optional database handle + +handles business (thats customer/vendor types) sequences. + +special behaviour for empty strings in customerinitnumber field: +will in this case not increase the value, and return undef. + +=back + +=cut