X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=1668252fb62b06c142e38c7e98fc0a11936b7f82;hb=260f51feb81fce05d1e37806571a7cc2425f426d;hp=637bbe286b056776f45d1b14819e4e4ce8eb5eae;hpb=49c7621e7bd48352be257e6ceea0e6fbb1718516;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index 637bbe286..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,48 +68,105 @@ 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);
- my $curr = shift;
+ my $self = shift;
my $key = shift;
my $value = shift;
- while ($key =~ /\[\+?\]\.|\./) {
- substr($key, 0, $+[0]) = '';
+ my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key;
- if ($& eq '.') {
- $curr->{$`} ||= { };
- $curr = $curr->{$`};
+ my $curr;
- } else {
- $curr->{$`} ||= [ ];
- if (!scalar @{ $curr->{$`} } || $& eq '[+].') {
- push @{ $curr->{$`} }, { };
- }
+ if (scalar @tokens) {
+ $curr = \ $self->{ shift @tokens };
+ }
- $curr = $curr->{$`}->[-1];
- }
+ while (@tokens) {
+ my $sep = shift @tokens;
+ my $key = shift @tokens;
+
+ $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 {
$main::lxdebug->enter_sub(2);
- my $params = shift;
- my $input = shift;
+ my $self = shift;
+ my $input = shift;
- my @pairs = split(/&/, $input);
+ my @pairs = split(/&/, $input);
foreach (@pairs) {
my ($key, $value) = split(/=/, $_, 2);
- _store_value($params, unescape(undef, $key), unescape(undef, $value));
+ $self->_store_value($self->unescape($key), $self->unescape($value)) if ($key);
}
$main::lxdebug->leave_sub(2);
@@ -117,13 +175,13 @@ sub _input_to_hash {
sub _request_to_hash {
$main::lxdebug->enter_sub(2);
- my $params = shift;
- my $input = shift;
+ my $self = shift;
+ my $input = shift;
if (!$ENV{'CONTENT_TYPE'}
|| ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
- _input_to_hash($params, $input);
+ $self->_input_to_hash($input);
$main::lxdebug->leave_sub(2);
return;
@@ -171,8 +229,8 @@ sub _request_to_hash {
substr $line, $-[0], $+[0] - $-[0], "";
}
- $previous = _store_value($params, $name, '');
- $params->{FILENAME} = $filename if ($filename);
+ $previous = $self->_store_value($name, '') if ($name);
+ $self->{FILENAME} = $filename if ($filename);
next;
}
@@ -195,9 +253,10 @@ sub _request_to_hash {
}
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});
@@ -215,6 +274,7 @@ sub _recode_recursively {
}
}
}
+ $main::lxdebug->leave_sub();
}
sub new {
@@ -241,27 +301,26 @@ sub new {
bless $self, $type;
- my $parameters = { };
- _request_to_hash($parameters, $_);
+ $self->_request_to_hash($_);
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;
- if ($parameters->{INPUT_ENCODING} && (lc $parameters->{INPUT_ENCODING} ne $db_charset)) {
- require Text::Iconv;
- my $iconv = Text::Iconv->new($parameters->{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, $parameters);
+ _recode_recursively($iconv, $self);
+ }
- delete $parameters{INPUT_ENCODING};
+ delete $self->{INPUT_ENCODING};
}
- map { $self->{$_} = $parameters->{$_}; } keys %{ $parameters };
-
$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();
@@ -394,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 (@_) {
@@ -426,7 +490,7 @@ sub hide_form {
print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
}
}
-
+ $main::lxdebug->leave_sub();
}
sub error {
@@ -545,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});
@@ -565,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}) {
@@ -609,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|
+
@@ -646,13 +722,7 @@ sub header {
$jsscript
$ajax
-
+ $fokus
@@ -979,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" ) ;
};
@@ -1133,7 +1203,7 @@ sub parse_template {
if ($self->{"format"} =~ /(opendocument|oasis)/i) {
$template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath);
- $ext_for_format = 'odt';
+ $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
} elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
$ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"};
@@ -1293,6 +1363,7 @@ Content-Length: $numbytes
while () {
print OUT $_;
+
}
close(OUT);
@@ -1312,6 +1383,7 @@ Content-Length: $numbytes
}
sub get_formname_translation {
+ $main::lxdebug->enter_sub();
my ($self, $formname) = @_;
$formname ||= $self->{formname};
@@ -1331,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 =
@@ -1345,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"
@@ -1357,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());
@@ -1379,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());
@@ -1392,6 +1473,7 @@ sub generate_email_subject {
$subject .= " " . $self->{"${prefix}number"}
}
+ $main::lxdebug->leave_sub();
return $subject;
}
@@ -1508,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;
}
@@ -1944,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;
@@ -1984,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 {
@@ -2113,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 | .
@@ -2808,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});
@@ -3164,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);
@@ -3225,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();
@@ -3241,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);
@@ -3379,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();
}
@@ -3390,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();
}