X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=1668252fb62b06c142e38c7e98fc0a11936b7f82;hb=260f51feb81fce05d1e37806571a7cc2425f426d;hp=355d60aef9123f94b8ac5406af9ee1163b3db1ac;hpb=1a16973b266728b4ef9a388fb82abe236675f266;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 355d60aef..1668252fb 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,6 +68,62 @@ 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); @@ -74,30 +131,29 @@ sub _store_value { my $key = shift; my $value = shift; - my $curr = $self; + my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key; - while ($key =~ /\[\+?\]\.|\./) { - substr($key, 0, $+[0]) = ''; + my $curr; - if ($& eq '.') { - $curr->{$`} ||= { }; - $curr = $curr->{$`}; + if (scalar @tokens) { + $curr = \ $self->{ shift @tokens }; + } - } else { - $curr->{$`} ||= [ ]; - if (!scalar @{ $curr->{$`} } || $& eq '[+].') { - push @{ $curr->{$`} }, { }; - } + while (@tokens) { + my $sep = shift @tokens; + my $key = shift @tokens; - $curr = $curr->{$`}->[-1]; - } + $curr = \ $$curr->[++$#$$curr], next if $sep eq '[]'; + $curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].'; + $curr = \ $$curr->[++$#$$curr] if $sep eq '[+].'; + $curr = \ $$curr->{$key} } - $curr->{$key} = $value; + $$curr = $value; $main::lxdebug->leave_sub(2); - return \$curr->{$key}; + return $curr; } sub _input_to_hash { @@ -110,7 +166,7 @@ sub _input_to_hash { foreach (@pairs) { my ($key, $value) = split(/=/, $_, 2); - $self->_store_value($self->unescape($key), $self->unescape($value)); + $self->_store_value($self->unescape($key), $self->unescape($value)) if ($key); } $main::lxdebug->leave_sub(2); @@ -173,7 +229,7 @@ sub _request_to_hash { substr $line, $-[0], $+[0] - $-[0], ""; } - $previous = $self->_store_value($name, ''); + $previous = $self->_store_value($name, '') if ($name); $self->{FILENAME} = $filename if ($filename); next; @@ -196,6 +252,31 @@ sub _request_to_hash { $main::lxdebug->leave_sub(2); } +sub _recode_recursively { + $main::lxdebug->enter_sub(); + my ($iconv, $param) = @_; + + if (any { ref $param eq $_ } qw(Form HASH)) { + foreach my $key (keys %{ $param }) { + if (!ref $param->{$key}) { + $param->{$key} = $iconv->convert($param->{$key}); + } else { + _recode_recursively($iconv, $param->{$key}); + } + } + + } elsif (ref $param eq 'ARRAY') { + foreach my $idx (0 .. scalar(@{ $param }) - 1) { + if (!ref $param->[$idx]) { + $param->[$idx] = $iconv->convert($param->[$idx]); + } else { + _recode_recursively($iconv, $param->[$idx]); + } + } + } + $main::lxdebug->leave_sub(); +} + sub new { $main::lxdebug->enter_sub(); @@ -222,10 +303,24 @@ sub new { $self->_request_to_hash($_); + my $db_charset = $main::dbcharset; + $db_charset ||= Common::DEFAULT_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); + } + + delete $self->{INPUT_ENCODING}; + } + $self->{action} = lc $self->{action}; $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.6.0 beta 1"; + $self->{version} = "2.6.0"; $main::lxdebug->leave_sub(); @@ -358,28 +453,33 @@ sub unescape { } sub quote { + $main::lxdebug->enter_sub(); my ($self, $str) = @_; if ($str && !ref($str)) { $str =~ s/\"/"/g; } - $str; + $main::lxdebug->leave_sub(); + return $str; } sub unquote { + $main::lxdebug->enter_sub(); my ($self, $str) = @_; if ($str && !ref($str)) { $str =~ s/"/\"/g; } - $str; + $main::lxdebug->leave_sub(); + return $str; } sub hide_form { + $main::lxdebug->enter_sub(); my $self = shift; if (@_) { @@ -390,7 +490,7 @@ sub hide_form { print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } } - + $main::lxdebug->leave_sub(); } sub error { @@ -509,9 +609,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}); @@ -529,6 +630,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}) { @@ -573,13 +676,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| + @@ -610,13 +722,7 @@ sub header { $jsscript $ajax - + $fokus @@ -943,9 +1049,9 @@ sub format_amount { $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); $amount = do { - ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : - ($dash =~ /DRCR/) ? ($neg ? "$amount DR" : "$amount CR" ) : - ($neg ? "-$amount" : "$amount" ) ; + ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : + ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) : + ($neg ? "-$amount" : "$amount" ) ; }; @@ -1093,25 +1199,37 @@ sub parse_template { $self->{"cwd"} = getcwd(); $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; + my $ext_for_format; + if ($self->{"format"} =~ /(opendocument|oasis)/i) { - $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt'; + } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; - $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif (($self->{"format"} =~ /html/i) || - (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { - $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif (($self->{"format"} =~ /xml/i) || - (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'pdf'; + + } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { + $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'html'; + + } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { + $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'xml'; + } elsif ( $self->{"format"} =~ /elsterwinston/i ) { $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( $self->{"format"} =~ /elstertaxbird/i ) { $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( defined $self->{'format'}) { $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}"); + } elsif ( $self->{'format'} eq '' ) { $self->error("No Outputformat given: $self->{'format'}"); + } else { #Catch the rest $self->error("Outputformat not defined: $self->{'format'}"); } @@ -1196,10 +1314,10 @@ sub parse_template { } else { if (!$self->{"do_not_attach"}) { - @{ $mail->{attachments} } = - ({ "filename" => $self->{"tmpfile"}, - "name" => $self->{"attachment_filename"} ? - $self->{"attachment_filename"} : $self->{"tmpfile"} }); + my $attachment_name = $self->{attachment_filename} || $self->{tmpfile}; + $attachment_name =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format); + $mail->{attachments} = [{ "filename" => $self->{tmpfile}, + "name" => $attachment_name }]; } $mail->{message} =~ s/\r//g; @@ -1245,6 +1363,7 @@ Content-Length: $numbytes while () { print OUT $_; + } close(OUT); @@ -1264,6 +1383,7 @@ Content-Length: $numbytes } sub get_formname_translation { + $main::lxdebug->enter_sub(); my ($self, $formname) = @_; $formname ||= $self->{formname}; @@ -1283,12 +1403,15 @@ 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(); return $formname_translations{$formname} } sub get_number_prefix_for_type { + $main::lxdebug->enter_sub(); my ($self) = @_; my $prefix = @@ -1297,10 +1420,12 @@ sub get_number_prefix_for_type { : ($self->{type} =~ /_delivery_order$/) ? 'do' : 'ord'; + $main::lxdebug->leave_sub(); return $prefix; } sub get_extension_for_format { + $main::lxdebug->enter_sub(); my ($self) = @_; my $extension = $self->{format} =~ /pdf/i ? ".pdf" @@ -1309,10 +1434,12 @@ sub get_extension_for_format { : $self->{format} =~ /html/i ? ".html" : ""; + $main::lxdebug->leave_sub(); return $extension; } sub generate_attachment_filename { + $main::lxdebug->enter_sub(); my ($self) = @_; my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation()); @@ -1331,10 +1458,12 @@ sub generate_attachment_filename { $attachment_filename = $main::locale->quote_special_chars('filenames', $attachment_filename); $attachment_filename =~ s|[\s/\\]+|_|g; + $main::lxdebug->leave_sub(); return $attachment_filename; } sub generate_email_subject { + $main::lxdebug->enter_sub(); my ($self) = @_; my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation()); @@ -1344,6 +1473,7 @@ sub generate_email_subject { $subject .= " " . $self->{"${prefix}number"} } + $main::lxdebug->leave_sub(); return $subject; } @@ -1460,7 +1590,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; } @@ -1896,6 +2026,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; @@ -1936,13 +2068,17 @@ sub get_employee_data { sub get_duedate { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; + my ($self, $myconfig, $reference_date) = @_; - my $dbh = $self->get_standard_dbh($myconfig); - my $query = qq|SELECT current_date + terms_netto FROM payment_terms WHERE id = ?|; - ($self->{duedate}) = selectrow_query($self, $dbh, $query, $self->{payment_id}); + $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}); $main::lxdebug->leave_sub(); + + return $duedate; } sub _get_contacts { @@ -2065,7 +2201,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 | . @@ -2760,7 +2896,7 @@ sub create_links { (startdate <= a.transdate) ORDER BY startdate DESC LIMIT 1)) WHERE a.trans_id = ? AND a.fx_transaction = '0' - ORDER BY a.oid, a.transdate|; + ORDER BY a.acc_trans_id, a.transdate|; $sth = $dbh->prepare($query); do_statement($self, $sth, $query, $self->{id}); @@ -3116,9 +3252,8 @@ sub get_history { qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | . qq|FROM history_erp h | . qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | . - qq|WHERE trans_id = | . $trans_id - . $restriction . qq| | - . $order; + qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | . + $order; my $sth = $dbh->prepare($query) || $self->dberror($query); @@ -3177,6 +3312,19 @@ 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(); @@ -3193,6 +3341,8 @@ sub update_business { WHERE id = ? FOR UPDATE|; my ($var) = selectrow_query($self, $dbh, $query, $business_id); + return undef unless $var; + if ($var =~ m/\d+$/) { my $new_var = (substr $var, $-[0]) * 1 + 1; my $len_diff = length($var) - $-[0] - length($new_var); @@ -3331,7 +3481,7 @@ sub backup_vars { my $self = shift; my @vars = @_; - map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if $self->{$_} } @vars; + map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars; $main::lxdebug->leave_sub(); } @@ -3342,7 +3492,7 @@ sub restore_vars { my $self = shift; my @vars = @_; - map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if $self->{_VAR_BACKUP}->{$_} } @vars; + map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars; $main::lxdebug->leave_sub(); }