X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=0445a25467d283309baf9c45e24b666f718824d2;hb=75e721508b508648ffe2454f10cfe29ba8a359dd;hp=9bfb945546604ec3936b8a47e31ca08ea7a4ea7b;hpb=b54e817db78d0f178ea1a339a5fdd1e4281db421;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index 9bfb94554..0445a2546 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -49,6 +49,7 @@ use SL::Menu;
use SL::User;
use SL::Common;
use CGI;
+use List::Util qw(max min sum);
my $standard_dbh;
@@ -98,7 +99,8 @@ sub _request_to_hash {
if (($line eq $boundary) || ($line eq "$boundary\r")) {
$params{$name} =~ s|\r?\n$|| if $name;
- undef $name, $filename;
+ undef $name;
+ undef $filename;
$headers_done = 0;
$content_type = "text/plain";
@@ -181,7 +183,7 @@ sub new {
$self->{action} = lc $self->{action};
$self->{action} =~ s/( |-|,|\#)/_/g;
- $self->{version} = "2.4.2";
+ $self->{version} = "2.4.3";
$main::lxdebug->leave_sub();
@@ -294,11 +296,7 @@ sub error {
} else {
- if ($self->{error_function}) {
- &{ $self->{error_function} }($msg);
- } else {
- die "Error: $msg\n";
- }
+ die "Error: $msg\n";
}
$main::lxdebug->leave_sub();
@@ -335,20 +333,17 @@ sub info {
$main::lxdebug->leave_sub();
}
+# calculates the number of rows in a textarea based on the content and column number
+# can be capped with maxrows
sub numtextrows {
$main::lxdebug->enter_sub();
-
my ($self, $str, $cols, $maxrows) = @_;
- my $rows = 0;
-
- map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str;
-
- $maxrows = $rows unless defined $maxrows;
+ my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
+ $maxrows ||= $rows;
$main::lxdebug->leave_sub();
-
- return ($rows > $maxrows) ? $maxrows : $rows;
+ return min $rows, $maxrows;
}
sub dberror {
@@ -385,11 +380,22 @@ sub header {
my ($stylesheet, $favicon);
if ($ENV{HTTP_USER_AGENT}) {
+ my $doctype;
- if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) {
- $stylesheet =
- qq|
- |;
+ if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) {
+ # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise.
+ $doctype = qq|\n|;
+ }
+
+ my $stylesheets = "$self->{stylesheet} $self->{stylesheets}";
+
+ $stylesheets =~ s|^\s*||;
+ $stylesheets =~ s|\s*$||;
+ foreach my $file (split m/\s+/, $stylesheets) {
+ $file =~ s|.*/||;
+ next if (! -f "css/$file");
+
+ $stylesheet .= qq|\n|;
}
$self->{favicon} = "favicon.ico" unless $self->{favicon};
@@ -433,7 +439,7 @@ sub header {
}
print qq|Content-Type: text/html; charset=${db_charset};
-
+${doctype}
$self->{titlebar}
$stylesheet
@@ -582,17 +588,18 @@ sub parse_html_template2 {
$file = $self->_prepare_html_template($file, $additional_params);
my $template = Template->new({ 'INTERPOLATE' => 0,
- 'PRE_CHOMP' => Template::Constants::CHOMP_COLLAPSE,
- 'POST_CHOMP' => Template::Constants::CHOMP_COLLAPSE,
'EVAL_PERL' => 0,
'ABSOLUTE' => 1,
'CACHE_SIZE' => 0,
+ 'PLUGIN_BASE' => 'SL::Template::Plugin',
}) || die;
map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
my $output;
- $template->process($file, $additional_params, \$output);
+ if (!$template->process($file, $additional_params, \$output)) {
+ print STDERR $template->error();
+ }
$output = $main::locale->{iconv}->convert($output) if ($main::locale);
@@ -604,9 +611,10 @@ sub parse_html_template2 {
sub show_generic_error {
my ($self, $error, $title, $action) = @_;
- my $add_params = {};
- $add_params->{"title"} = $title if ($title);
- $self->{"label_error"} = $error;
+ my $add_params = {
+ 'title_error' => $title,
+ 'label_error' => $error,
+ };
my @vars;
if ($action) {
@@ -619,21 +627,26 @@ sub show_generic_error {
}
$add_params->{"VARIABLES"} = \@vars;
+ $self->{title} = $title if ($title);
+
$self->header();
- print($self->parse_html_template("generic/error", $add_params));
+ print $self->parse_html_template2("generic/error", $add_params);
die("Error: $error\n");
}
sub show_generic_information {
- my ($self, $error, $title) = @_;
+ my ($self, $text, $title) = @_;
- my $add_params = {};
- $add_params->{"title"} = $title if ($title);
- $self->{"label_information"} = $error;
+ my $add_params = {
+ 'title_information' => $title,
+ 'label_information' => $text,
+ };
+
+ $self->{title} = $title if ($title);
$self->header();
- print($self->parse_html_template("generic/information", $add_params));
+ print $self->parse_html_template2("generic/information", $add_params);
die("Information: $error\n");
}
@@ -692,7 +705,9 @@ sub redirect {
if ($self->{callback}) {
- ($script, $argv) = split(/\?/, $self->{callback});
+ ($script, $argv) = split(/\?/, $self->{callback}, 2);
+ $script =~ s|.*/||;
+ $script =~ s|[^a-zA-Z0-9_\.]||g;
exec("perl", "$script", $argv);
} else {
@@ -723,18 +738,23 @@ sub format_amount {
if ($amount eq "") {
$amount = 0;
}
- my $neg = ($amount =~ s/-//);
-
+
+ # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
+
+ my $neg = ($amount =~ s/^-//);
+ my $exp = ($amount =~ m/[e]/) ? 1 : 0;
+
if (defined($places) && ($places ne '')) {
- if ($places < 0) {
- $amount *= 1;
- $places *= -1;
-
- my ($actual_places) = ($amount =~ /\.(\d+)/);
- $actual_places = length($actual_places);
- $places = $actual_places > $places ? $actual_places : $places;
+ if (not $exp) {
+ if ($places < 0) {
+ $amount *= 1;
+ $places *= -1;
+
+ my ($actual_places) = ($amount =~ /\.(\d+)/);
+ $actual_places = length($actual_places);
+ $places = $actual_places > $places ? $actual_places : $places;
+ }
}
-
$amount = $self->round_amount($amount, $places);
}
@@ -757,6 +777,22 @@ sub format_amount {
return $amount;
}
#
+
+sub format_string {
+ $main::lxdebug->enter_sub(2);
+
+ my $self = shift;
+ my $input = shift;
+
+ $input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx;
+ $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
+ $input =~ s/\#\#/\#/g;
+
+ $main::lxdebug->leave_sub(2);
+
+ return $input;
+}
+
sub parse_amount {
$main::lxdebug->enter_sub(2);
@@ -844,6 +880,10 @@ sub parse_template {
qw(company address signature));
map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature));
+ map({ $self->{"${_}"} = $myconfig->{$_}; }
+ qw(co_ustid));
+
+
$self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
# OUT is used for the media, screen, printer, email
@@ -982,25 +1022,33 @@ Content-Length: $numbytes
$main::lxdebug->leave_sub();
}
-sub generate_attachment_filename {
- my ($self) = @_;
+sub get_formname_translation {
+ my ($self, $formname) = @_;
+
+ $formname ||= $self->{formname};
my %formname_translations = (
- bin_list => $main::locale->text('Bin List'),
- credit_note => $main::locale->text('Credit Note'),
- invoice => $main::locale->text('Invoice'),
- packing_list => $main::locale->text('Packing List'),
- pick_list => $main::locale->text('Pick List'),
- proforma => $main::locale->text('Proforma Invoice'),
- purchase_order => $main::locale->text('Purchase Order'),
- request_quotation => $main::locale->text('RFQ'),
- sales_order => $main::locale->text('Confirmation'),
- sales_quotation => $main::locale->text('Quotation'),
- storno_invoice => $main::locale->text('Storno Invoice'),
- storno_packing_list => $main::locale->text('Storno Packing List'),
+ bin_list => $main::locale->text('Bin List'),
+ credit_note => $main::locale->text('Credit Note'),
+ invoice => $main::locale->text('Invoice'),
+ packing_list => $main::locale->text('Packing List'),
+ pick_list => $main::locale->text('Pick List'),
+ proforma => $main::locale->text('Proforma Invoice'),
+ purchase_order => $main::locale->text('Purchase Order'),
+ request_quotation => $main::locale->text('RFQ'),
+ sales_order => $main::locale->text('Confirmation'),
+ sales_quotation => $main::locale->text('Quotation'),
+ storno_invoice => $main::locale->text('Storno Invoice'),
+ storno_packing_list => $main::locale->text('Storno Packing List'),
);
- my $attachment_filename = $formname_translations{$self->{"formname"}};
+ return $formname_translations{$formname}
+}
+
+sub generate_attachment_filename {
+ my ($self) = @_;
+
+ my $attachment_filename = $self->get_formname_translation();
my $prefix =
(grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv"
: ($self->{"type"} =~ /_quotation$/) ? "quo"
@@ -1169,13 +1217,13 @@ sub update_exchangerate {
$main::lxdebug->enter_sub();
my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
-
+ my ($query);
# some sanity check for currency
if ($curr eq '') {
$main::lxdebug->leave_sub();
return;
}
- my $query = qq|SELECT curr FROM defaults|;
+ $query = qq|SELECT curr FROM defaults|;
my ($currency) = selectrow_query($self, $dbh, $query);
my ($defaultcurrency) = split m/:/, $currency;
@@ -1186,7 +1234,7 @@ sub update_exchangerate {
return;
}
- my $query = qq|SELECT e.curr FROM exchangerate e
+ $query = qq|SELECT e.curr FROM exchangerate e
WHERE e.curr = ? AND e.transdate = ?
FOR UPDATE|;
my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
@@ -1251,13 +1299,14 @@ sub get_exchangerate {
$main::lxdebug->enter_sub();
my ($self, $dbh, $curr, $transdate, $fld) = @_;
+ my ($query);
unless ($transdate) {
$main::lxdebug->leave_sub();
return 1;
}
- my $query = qq|SELECT curr FROM defaults|;
+ $query = qq|SELECT curr FROM defaults|;
my ($currency) = selectrow_query($self, $dbh, $query);
my ($defaultcurrency) = split m/:/, $currency;
@@ -1267,7 +1316,7 @@ sub get_exchangerate {
return 1;
}
- my $query = qq|SELECT e.$fld FROM exchangerate e
+ $query = qq|SELECT e.$fld FROM exchangerate e
WHERE e.curr = ? AND e.transdate = ?|;
my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
@@ -1357,12 +1406,32 @@ sub set_payment_options {
($self->{netto_date}, $self->{skonto_date}) =
selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});
- my $total = ($self->{invtotal}) ? $self->{invtotal} : $self->{ordtotal};
- my $skonto_amount = $self->parse_amount($myconfig, $total) *
- $self->{percent_skonto};
+ my ($invtotal, $total);
+ my (%amounts, %formatted_amounts);
- $self->{skonto_amount} =
- $self->format_amount($myconfig, $skonto_amount, 2);
+ if ($self->{type} =~ /_order$/) {
+ $amounts{invtotal} = $self->{ordtotal};
+ $amounts{total} = $self->{ordtotal};
+
+ } elsif ($self->{type} =~ /_quotation$/) {
+ $amounts{invtotal} = $self->{quototal};
+ $amounts{total} = $self->{quototal};
+
+ } else {
+ $amounts{invtotal} = $self->{invtotal};
+ $amounts{total} = $self->{total};
+ }
+
+ map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
+
+ $amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto};
+ $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
+ $amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto});
+
+ foreach (keys %amounts) {
+ $amounts{$_} = $self->round_amount($amounts{$_}, 2);
+ $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
+ }
if ($self->{"language_id"}) {
$query =
@@ -1390,23 +1459,21 @@ sub set_payment_options {
($output_numberformat ne $myconfig->{"numberformat"})) {
my $saved_numberformat = $myconfig->{"numberformat"};
$myconfig->{"numberformat"} = $output_numberformat;
- $self->{skonto_amount} =
- $self->format_amount($myconfig, $skonto_amount, 2);
+ map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts;
$myconfig->{"numberformat"} = $saved_numberformat;
}
}
$self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
$self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
- $self->{payment_terms} =~ s/<%skonto_amount%>/$self->{skonto_amount}/g;
- $self->{payment_terms} =~ s/<%total%>/$self->{total}/g;
- $self->{payment_terms} =~ s/<%invtotal%>/$self->{invtotal}/g;
$self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
$self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
$self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
$self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
$self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
+ map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
+
$main::lxdebug->leave_sub();
}
@@ -1471,6 +1538,7 @@ sub add_shipto {
my $shipto;
my @values;
+
foreach my $item (qw(name department_1 department_2 street zipcode city country
contact phone fax email)) {
if ($self->{"shipto$item"}) {
@@ -1478,6 +1546,7 @@ sub add_shipto {
}
push(@values, $self->{"shipto${item}"});
}
+
if ($shipto) {
if ($self->{shipto_id}) {
my $query = qq|UPDATE shipto set
@@ -1506,8 +1575,10 @@ sub add_shipto {
shiptocontact = ? AND
shiptophone = ? AND
shiptofax = ? AND
- shiptoemail = ?|;
- my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values);
+ shiptoemail = ? AND
+ module = ? AND
+ trans_id = ?|;
+ my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
if(!$insert_check){
$query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
@@ -1806,11 +1877,12 @@ $main::lxdebug->enter_sub();
sub _get_customers {
$main::lxdebug->enter_sub();
- my ($self, $dbh, $key) = @_;
+ my ($self, $dbh, $key, $limit) = @_;
$key = "all_customers" unless ($key);
+ $limit_clause = "LIMIT $limit" if $limit;
- my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name|;
+ my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|;
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
@@ -1845,6 +1917,20 @@ sub _get_departments {
$main::lxdebug->leave_sub();
}
+sub _get_price_factors {
+ $main::lxdebug->enter_sub();
+
+ my ($self, $dbh, $key) = @_;
+
+ $key ||= "all_price_factors";
+
+ my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|;
+
+ $self->{$key} = selectall_hashref_query($self, $dbh, $query);
+
+ $main::lxdebug->leave_sub();
+}
+
sub get_lists {
$main::lxdebug->enter_sub();
@@ -1912,11 +1998,19 @@ sub get_lists {
}
if($params{"customers"}) {
- $self->_get_customers($dbh, $params{"customers"});
+ if (ref $params{"customers"} eq 'HASH') {
+ $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit});
+ } else {
+ $self->_get_customers($dbh, $params{"customers"});
+ }
}
if($params{"vendors"}) {
- $self->_get_vendors($dbh, $params{"vendors"});
+ if (ref $params{"vendors"} eq 'HASH') {
+ $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
+ } else {
+ $self->_get_vendors($dbh, $params{"vendors"});
+ }
}
if($params{"payments"}) {
@@ -1927,6 +2021,10 @@ sub get_lists {
$self->_get_departments($dbh, $params{"departments"});
}
+ if ($params{price_factors}) {
+ $self->_get_price_factors($dbh, $params{price_factors});
+ }
+
$main::lxdebug->leave_sub();
}
@@ -2164,7 +2262,7 @@ sub create_links {
while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
foreach my $key (split(/:/, $ref->{link})) {
- if ($key =~ /$module/) {
+ if ($key =~ /\Q$module\E/) {
# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;
@@ -2223,7 +2321,7 @@ sub create_links {
LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
WHERE c.link LIKE ?
AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
- OR c.link LIKE '%_tax%')
+ OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
ORDER BY c.accno|;
$sth = $dbh->prepare($query);
@@ -2233,7 +2331,7 @@ sub create_links {
while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
foreach my $key (split(/:/, $ref->{link})) {
- if ($key =~ /$module/) {
+ if ($key =~ /\Q$module\E/) {
# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;
@@ -2423,8 +2521,7 @@ sub redo_rows {
my @ndx = ();
- map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } }
- (1 .. $count);
+ map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
my $i = 0;
@@ -2465,8 +2562,8 @@ sub update_status {
}
$sth->finish();
- my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0";
- my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0";
+ my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+ my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
my %queued = split / /, $self->{queued};
my @values;
@@ -2510,7 +2607,7 @@ sub save_status {
my $formnames = $self->{printed};
my $emailforms = $self->{emailed};
- my $query = qq|DELETE FROM status
+ $query = qq|DELETE FROM status
WHERE (formname = ?) AND (trans_id = ?)|;
do_query($self, $dbh, $query, $self->{formname}, $self->{id});
@@ -2521,15 +2618,15 @@ sub save_status {
my %queued = split / /, $self->{queued};
foreach my $formname (keys %queued) {
- $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0";
- $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0";
+ $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+ $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
- $formnames =~ s/$self->{formname}//;
- $emailforms =~ s/$self->{formname}//;
+ $formnames =~ s/\Q$self->{formname}\E//;
+ $emailforms =~ s/\Q$self->{formname}\E//;
}
}
@@ -2543,8 +2640,8 @@ sub save_status {
map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
foreach my $formname (keys %status) {
- $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0";
- $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0";
+ $printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0";
+ $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
$query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
VALUES (?, ?, ?, ?)|;
@@ -2650,8 +2747,14 @@ sub update_defaults {
my ($var) = $sth->fetchrow_array;
$sth->finish;
- $var =~ s/\d+$/ sprintf '%0*d', length($&), $&+1 /e;
- $var ||= 1;
+ if ($var =~ m/\d+$/) {
+ my $new_var = (substr $var, $-[0]) * 1 + 1;
+ my $len_diff = length($var) - $-[0] - length($new_var);
+ $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
+
+ } else {
+ $var = $var . '1';
+ }
$query = qq|UPDATE defaults SET $fld = ?|;
do_query($self, $dbh, $query, $var);
@@ -2682,8 +2785,15 @@ sub update_business {
WHERE id = ? FOR UPDATE|;
my ($var) = selectrow_query($self, $dbh, $query, $business_id);
- $var =~ s/\d+$/ sprintf '%0*d', length($&), $&+1 /e;
-
+ if ($var =~ m/\d+$/) {
+ my $new_var = (substr $var, $-[0]) * 1 + 1;
+ my $len_diff = length($var) - $-[0] - length($new_var);
+ $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
+
+ } else {
+ $var = $var . '1';
+ }
+
$query = qq|UPDATE business
SET customernumberinit = ?
WHERE id = ?|;