X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=86f643378a64c02dfb6f611d15e8b34b4145e4f5;hb=5d23fb605bc40f699ab677e6ee13a7e498c9fb14;hp=68272b31ca8b3dc338154746af3dc54f17cd9e74;hpb=3c2e635c3d0f16fc53c49fd7a4fa91ab7e92796b;p=kivitendo-erp.git

diff --git a/SL/Form.pm b/SL/Form.pm
index 68272b31c..86f643378 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -37,8 +37,6 @@
 
 package Form;
 
-#use strict;
-
 use Data::Dumper;
 
 use CGI;
@@ -59,6 +57,8 @@ use Template;
 use List::Util qw(first max min sum);
 use List::MoreUtils qw(any);
 
+use strict;
+
 my $standard_dbh;
 
 END {
@@ -68,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);
 
@@ -259,7 +203,10 @@ sub _recode_recursively {
   if (any { ref $param eq $_ } qw(Form HASH)) {
     foreach my $key (keys %{ $param }) {
       if (!ref $param->{$key}) {
-        $param->{$key} = $iconv->convert($param->{$key});
+        # Workaround for a bug: converting $param->{$key} directly
+        # leads to 'undef'. I don't know why. Converting a copy works,
+        # though.
+        $param->{$key} = $iconv->convert("" . $param->{$key});
       } else {
         _recode_recursively($iconv, $param->{$key});
       }
@@ -268,7 +215,10 @@ sub _recode_recursively {
   } elsif (ref $param eq 'ARRAY') {
     foreach my $idx (0 .. scalar(@{ $param }) - 1) {
       if (!ref $param->[$idx]) {
-        $param->[$idx] = $iconv->convert($param->[$idx]);
+        # Workaround for a bug: converting $param->[$idx] directly
+        # leads to 'undef'. I don't know why. Converting a copy works,
+        # though.
+        $param->[$idx] = $iconv->convert("" . $param->[$idx]);
       } else {
         _recode_recursively($iconv, $param->[$idx]);
       }
@@ -314,13 +264,13 @@ sub new {
       _recode_recursively($iconv, $self);
     }
 
-    delete $self{INPUT_ENCODING};
+    delete $self->{INPUT_ENCODING};
   }
 
   $self->{action}  =  lc $self->{action};
   $self->{action}  =~ s/( |-|,|\#)/_/g;
 
-  $self->{version} =  "2.6.0";
+  $self->{version} =  "2.6.1";
 
   $main::lxdebug->leave_sub();
 
@@ -630,6 +580,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}) {
@@ -704,7 +656,7 @@ sub header {
       ? "$self->{title} - $self->{titlebar}"
       : $self->{titlebar};
     my $ajax = "";
-    foreach my $item (@ { $self->{AJAX} }) {
+    for my $item (@ { $self->{AJAX} || [] }) {
       $ajax .= $item->show_javascript();
     }
 
@@ -722,6 +674,8 @@ sub header {
 
   $fokus
 
+  <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
+
   <meta name="robots" content="noindex,nofollow" />
   <script type="text/javascript" src="js/highlight_input.js"></script>
 
@@ -766,7 +720,7 @@ sub _prepare_html_template {
   my ($self, $file, $additional_params) = @_;
   my $language;
 
-  if (!defined(%main::myconfig) || !defined($main::myconfig{"countrycode"})) {
+  if (!%::myconfig || !$::myconfig{"countrycode"}) {
     $language = $main::language;
   } else {
     $language = $main::myconfig{"countrycode"};
@@ -817,6 +771,8 @@ sub _prepare_html_template {
   $additional_params->{"conf_lizenzen"}               = $main::lizenzen;
   $additional_params->{"conf_latex_templates"}        = $main::latex;
   $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates;
+  $additional_params->{"conf_vertreter"}              = $main::vertreter;
+  $additional_params->{"conf_show_best_before"}       = $main::show_best_before;
 
   if (%main::debug_options) {
     map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
@@ -1171,13 +1127,13 @@ sub round_amount {
   my ($self, $amount, $places) = @_;
   my $round_amount;
 
-  # Rounding like "Kaufmannsrunden"
-  # Descr. http://de.wikipedia.org/wiki/Rundung
-  # Inspired by
-  # http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html
-  # Solves Bug: 189
-  # Udo Spallek
-  $amount = $amount * (10**($places));
+  # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung )
+
+  # Round amounts to eight places before rounding to the requested
+  # number of places. This gets rid of errors due to internal floating
+  # point representation.
+  $amount       = $self->round_amount($amount, 8) if $places < 8;
+  $amount       = $amount * (10**($places));
   $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
 
   $main::lxdebug->leave_sub(2);
@@ -1222,6 +1178,10 @@ sub parse_template {
   } elsif ( $self->{"format"} =~ /elstertaxbird/i ) {
     $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath);
 
+  } elsif ( $self->{"format"} =~ /excel/i ) {
+    $template = ExcelTemplate->new($self->{"IN"}, $self, $myconfig, $userspath);
+    $ext_for_format = 'xls';
+
   } elsif ( defined $self->{'format'}) {
     $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
 
@@ -1429,6 +1389,7 @@ sub get_extension_for_format {
   my $extension = $self->{format} =~ /pdf/i          ? ".pdf"
                 : $self->{format} =~ /postscript/i   ? ".ps"
                 : $self->{format} =~ /opendocument/i ? ".odt"
+                : $self->{format} =~ /excel/i        ? ".xls"
                 : $self->{format} =~ /html/i         ? ".html"
                 :                                      "";
 
@@ -1489,7 +1450,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;
@@ -1588,7 +1549,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;
   }
 
@@ -1783,7 +1744,7 @@ sub check_exchangerate {
   return $exchangerate;
 }
 
-sub get_default_currency {
+sub get_all_currencies {
   $main::lxdebug->enter_sub();
 
   my ($self, $myconfig) = @_;
@@ -1791,14 +1752,24 @@ sub get_default_currency {
 
   my $query = qq|SELECT curr FROM defaults|;
 
-  my ($curr)            = selectrow_query($self, $dbh, $query);
-  my ($defaultcurrency) = split m/:/, $curr;
+  my ($curr)     = selectrow_query($self, $dbh, $query);
+  my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr;
 
   $main::lxdebug->leave_sub();
 
-  return $defaultcurrency;
+  return @currencies;
 }
 
+sub get_default_currency {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $myconfig) = @_;
+  my @currencies        = $self->get_all_currencies($myconfig);
+
+  $main::lxdebug->leave_sub();
+
+  return $currencies[0];
+}
 
 sub set_payment_options {
   $main::lxdebug->enter_sub();
@@ -1847,6 +1818,7 @@ sub set_payment_options {
     $amounts{invtotal} = $self->{invtotal};
     $amounts{total}    = $self->{total};
   }
+  $amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
 
   map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
 
@@ -1900,6 +1872,8 @@ sub set_payment_options {
 
   map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
 
+  $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
+
   $main::lxdebug->leave_sub();
 
 }
@@ -2272,9 +2246,15 @@ sub _get_business_types {
 
   my ($self, $dbh, $key) = @_;
 
-  $key = "all_business_types" unless ($key);
-  $self->{$key} =
-    selectall_hashref_query($self, $dbh, qq|SELECT * FROM business|);
+  my $options       = ref $key eq 'HASH' ? $key : { key => $key };
+  $options->{key} ||= "all_business_types";
+  my $where         = '';
+
+  if (exists $options->{salesman}) {
+    $where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
+  }
+
+  $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
 
   $main::lxdebug->leave_sub();
 }
@@ -2338,14 +2318,15 @@ $main::lxdebug->enter_sub();
 sub _get_customers {
   $main::lxdebug->enter_sub();
 
-  my ($self, $dbh, $key, $limit) = @_;
-
-  $key = "all_customers" unless ($key);
-  my $limit_clause = "LIMIT $limit" if $limit;
+  my ($self, $dbh, $key) = @_;
 
-  my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|;
+  my $options        = ref $key eq 'HASH' ? $key : { key => $key };
+  $options->{key}  ||= "all_customers";
+  my $limit_clause   = "LIMIT $options->{limit}" if $options->{limit};
+  my $where          = $options->{business_is_salesman} ? qq| AND business_id IN (SELECT id FROM business WHERE salesman)| : '';
 
-  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
+  my $query = qq|SELECT * FROM customer WHERE NOT obsolete $where ORDER BY name $limit_clause|;
+  $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
 
   $main::lxdebug->leave_sub();
 }
@@ -2512,11 +2493,7 @@ sub get_lists {
   }
 
   if($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"});
-    }
+    $self->_get_customers($dbh, $params{"customers"});
   }
 
   if($params{"vendors"}) {
@@ -2618,7 +2595,7 @@ sub all_vc {
   my ($count) = selectrow_query($self, $dbh, $query);
 
   # build selection list
-  if ($count < $myconfig->{vclimit}) {
+  if ($count <= $myconfig->{vclimit}) {
     $query = qq|SELECT id, name, salesman_id
                 FROM $table WHERE NOT obsolete
                 ORDER BY name|;
@@ -2738,7 +2715,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();
 }
@@ -3018,7 +2995,9 @@ sub lastname_used {
 sub current_date {
   $main::lxdebug->enter_sub();
 
-  my ($self, $myconfig, $thisdate, $days) = @_;
+  my $self              = shift;
+  my $myconfig          = shift  || \%::myconfig;
+  my ($thisdate, $days) = @_;
 
   my $dbh = $self->get_standard_dbh($myconfig);
   my $query;
@@ -3310,19 +3289,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();
 
@@ -3496,3 +3462,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