X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=579b1ef65cdfbbf8faf669c58811d91fa0ea68d5;hb=88e6dce2c094fa468e4397030d2f14289a265e62;hp=c13422264806f5daed40aa5689cc7d28cb10cf97;hpb=6ff01fdb61880344c2826c86955ef4c1e8f47db4;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index c13422264..579b1ef65 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;
}
@@ -198,7 +256,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});
@@ -243,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 2";
+ $self->{version} = "2.6.0";
$main::lxdebug->leave_sub();
@@ -552,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});
@@ -572,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}) {
@@ -616,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|
+
@@ -653,13 +722,7 @@ sub header {
$jsscript
$ajax
-
+ $fokus
@@ -1140,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"};
@@ -1300,6 +1363,7 @@ Content-Length: $numbytes
while () {
print OUT $_;
+
}
close(OUT);
@@ -1339,6 +1403,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();
@@ -1525,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;
}
@@ -1961,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;
@@ -2003,11 +2070,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();
@@ -2134,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 | .
@@ -2673,7 +2740,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();
}
@@ -3245,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();
@@ -3261,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);