]> wagnertech.de Git - mfinanz.git/blobdiff - SL/Form.pm
projects / mfinanz.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
DB-Upgrade-Skripte für 3.5.8
[mfinanz.git] / SL / Form.pm
diff --git a/SL/Form.pm b/SL/Form.pm
index c758659d4acc03ec19926e59321813085b041157..8d8f41768fb8ecd1e795d67c156d62f348683dd3 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -42,7 +42,6 @@ use Carp;
 use Data::Dumper;
 
 use Carp;
 use Data::Dumper;
 
 use Carp;
-use Config;
 use CGI;
 use Cwd;
 use Encode;
 use CGI;
 use Cwd;
 use Encode;
@@ -88,6 +87,7 @@ use List::Util qw(first max min sum);
 use List::MoreUtils qw(all any apply);
 use SL::DB::Tax;
 use SL::Helper::File qw(:all);
 use List::MoreUtils qw(all any apply);
 use SL::DB::Tax;
 use SL::Helper::File qw(:all);
+use SL::Helper::Number;
 use SL::Helper::CreatePDF qw(merge_pdfs);
 
 use strict;
 use SL::Helper::CreatePDF qw(merge_pdfs);
 
 use strict;
@@ -382,10 +382,11 @@ sub create_http_response {
     my $session_cookie_value = $main::auth->get_session_id();
 
     if ($session_cookie_value) {
     my $session_cookie_value = $main::auth->get_session_id();
 
     if ($session_cookie_value) {
-      $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
-                                     '-value'  => $session_cookie_value,
-                                     '-path'   => $uri->path,
-                                     '-secure' => $::request->is_https);
+      $session_cookie = $cgi->cookie('-name'    => $main::auth->get_session_cookie_name(),
+                                     '-value'   => $session_cookie_value,
+                                     '-path'    => $uri->path,
+                                     '-expires' => '+' . $::auth->{session_timeout} . 'm',
+                                     '-secure'  => $::request->is_https);
     }
   }
 
     }
   }
 
@@ -449,6 +450,7 @@ sub header {
   push @header, "<style type='text/css'>\@page { size:landscape; }</style> "                     if $self->{landscape};
   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>"         if -f $self->{favicon};
   push @header, map { qq|<script type="text/javascript" src="${_}${auto_reload_resources_param}"></script>| }                    $layout->javascripts;
   push @header, "<style type='text/css'>\@page { size:landscape; }</style> "                     if $self->{landscape};
   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>"         if -f $self->{favicon};
   push @header, map { qq|<script type="text/javascript" src="${_}${auto_reload_resources_param}"></script>| }                    $layout->javascripts;
+  push @header, '<meta name="viewport" content="width=device-width, initial-scale=1">';
   push @header, $self->{javascript} if $self->{javascript};
   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
 
   push @header, $self->{javascript} if $self->{javascript};
   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
 
@@ -548,8 +550,10 @@ sub _prepare_html_template {
   }
   $language = "de" unless ($language);
 
   }
   $language = "de" unless ($language);
 
-  if (-f "templates/webpages/${file}.html") {
-    $file = "templates/webpages/${file}.html";
+  my $webpages_path = $::request->layout->webpages_path;
+
+  if (-f "${webpages_path}/${file}.html") {
+    $file = "${webpages_path}/${file}.html";
 
   } elsif (ref $file eq 'SCALAR') {
     # file is a scalarref, use inline mode
 
   } elsif (ref $file eq 'SCALAR') {
     # file is a scalarref, use inline mode
@@ -699,44 +703,10 @@ sub sort_columns {
   return @columns;
 }
 #
   return @columns;
 }
 #
-sub format_amount {
-  $main::lxdebug->enter_sub(2);
 
 
+sub format_amount {
   my ($self, $myconfig, $amount, $places, $dash) = @_;
   my ($self, $myconfig, $amount, $places, $dash) = @_;
-  $amount ||= 0;
-  $dash   ||= '';
-  my $neg = $amount < 0;
-  my $force_places = defined $places && $places >= 0;
-
-  $amount = $self->round_amount($amount, abs $places) if $force_places;
-  $neg    = 0 if $amount == 0; # don't show negative zero
-  $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa
-
-  # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl
-  # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on
-  # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs.
-
-  $amount =~ s/0*$// unless defined $places && $places == 0;             # cull trailing 0s
-
-  my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
-  my @p = split(/\./, $amount);                                          # split amount at decimal point
-
-  $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1];                             # add 1,000 delimiters
-  $amount = $p[0];
-  if ($places || $p[1]) {
-    $amount .= $d[0]
-            .  ( $p[1] || '' )
-            .  (0 x max(abs($places || 0) - length ($p[1]||''), 0));     # pad the fraction
-  }
-
-  $amount = do {
-    ($dash =~ /-/)    ? ($neg ? "($amount)"                            : "$amount" )                              :
-    ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) :
-                        ($neg ? "-$amount"                             : "$amount" )                              ;
-  };
-
-  $main::lxdebug->leave_sub(2);
-  return $amount;
+  SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
 }
 
 sub format_amount_units {
 }
 
 sub format_amount_units {
@@ -825,82 +795,11 @@ sub format_string {
 #
 
 sub parse_amount {
 #
 
 sub parse_amount {
-  $main::lxdebug->enter_sub(2);
-
   my ($self, $myconfig, $amount) = @_;
   my ($self, $myconfig, $amount) = @_;
-
-  if (!defined($amount) || ($amount eq '')) {
-    $main::lxdebug->leave_sub(2);
-    return 0;
-  }
-
-  if (   ($myconfig->{numberformat} eq '1.000,00')
-      || ($myconfig->{numberformat} eq '1000,00')) {
-    $amount =~ s/\.//g;
-    $amount =~ s/,/\./g;
-  }
-
-  if ($myconfig->{numberformat} eq "1'000.00") {
-    $amount =~ s/\'//g;
-  }
-
-  $amount =~ s/,//g;
-
-  $main::lxdebug->leave_sub(2);
-
-  # Make sure no code wich is not a math expression ends up in eval().
-  return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
-
-  # Prevent numbers from being parsed as octals;
-  $amount =~ s{ (?<! [\d.] ) 0+ (?= [1-9] ) }{}gx;
-
-  return scalar(eval($amount)) * 1 ;
+  SL::Helper::Number::_parse_number($amount, %$myconfig);
 }
 
 }
 
-sub round_amount {
-  my ($self, $amount, $places, $adjust) = @_;
-
-  return 0 if !defined $amount;
-
-  $places //= 0;
-
-  if ($adjust) {
-    my $precision = $::instance_conf->get_precision || 0.01;
-    return $self->round_amount( $self->round_amount($amount / $precision, 0) * $precision, $places);
-  }
-
-  # We use Perl's knowledge of string representation for
-  # rounding. First, convert the floating point number to a string
-  # with a high number of places. Then split the string on the decimal
-  # sign and use integer calculation for rounding the decimal places
-  # part. If an overflow occurs then apply that overflow to the part
-  # before the decimal sign as well using integer arithmetic again.
-
-  my $int_amount = int(abs $amount);
-  my $str_places = max(min(10, 16 - length("$int_amount") - $places), $places);
-  my $amount_str = sprintf '%.*f', $places + $str_places, abs($amount);
-
-  return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
-
-  my ($pre, $post)      = ($1, $2);
-  my $decimals          = '1' . substr($post, 0, $places);
-
-  my $propagation_limit = $Config{i32size} == 4 ? 7 : 18;
-  my $add_for_rounding  = substr($post, $places, 1) >= 5 ? 1 : 0;
-
-  if ($places > $propagation_limit) {
-    $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding);
-    $pre      = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2';
-
-  } else {
-    $decimals += $add_for_rounding;
-    $pre      += 1 if substr($decimals, 0, 1) eq '2';
-  }
-
-  $amount  = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0);
-
-  return $amount;
-}
+sub round_amount { shift; goto &SL::Helper::Number::_round_number; }
 
 sub parse_template {
   $main::lxdebug->enter_sub();
 
 sub parse_template {
   $main::lxdebug->enter_sub();
@@ -1038,7 +937,7 @@ sub parse_template {
       }
     }
 
       }
     }
 
-    if (!$self->{preview} && $self->doc_storage_enabled)
+    if (!$self->{preview} && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled)
     {
       $self->{attachment_filename} ||= $self->generate_attachment_filename;
       $self->store_pdf($self);
     {
       $self->{attachment_filename} ||= $self->generate_attachment_filename;
       $self->store_pdf($self);
@@ -1058,7 +957,7 @@ sub parse_template {
     }
   }
 
     }
   }
 
-  if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->doc_storage_enabled) {
+  if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) {
     $self->{attachment_filename} ||= $self->generate_attachment_filename;
     my $file_obj = $self->store_pdf($self);
     $self->{print_file_id} = $file_obj->id if $file_obj;
     $self->{attachment_filename} ||= $self->generate_attachment_filename;
     my $file_obj = $self->store_pdf($self);
     $self->{print_file_id} = $file_obj->id if $file_obj;
@@ -1106,6 +1005,14 @@ sub send_email {
   map { $mail->{$_} = $self->{$_} }
     qw(cc subject message format);
 
   map { $mail->{$_} = $self->{$_} }
     qw(cc subject message format);
 
+  if ($self->{cc_employee}) {
+    my ($user, $my_emp_cc);
+    $user        = SL::DB::Manager::AuthUser->find_by(login => $self->{cc_employee});
+    $my_emp_cc   = $user->get_config_value('email') if ref $user eq 'SL::DB::AuthUser';
+    $mail->{cc} .= ", "       if $mail->{cc};
+    $mail->{cc} .= $my_emp_cc if $my_emp_cc;
+  }
+
   $mail->{bcc}    = $self->get_bcc_defaults($myconfig, $self->{bcc});
   $mail->{to}     = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
   $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
   $mail->{bcc}    = $self->get_bcc_defaults($myconfig, $self->{bcc});
   $mail->{to}     = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
   $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
@@ -1270,6 +1177,20 @@ sub get_formname_translation {
   return $formname_translations{$formname};
 }
 
   return $formname_translations{$formname};
 }
 
+sub get_cusordnumber_translation {
+  $main::lxdebug->enter_sub();
+  my ($self, $formname) = @_;
+
+  $formname ||= $self->{formname};
+
+  $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
+  local $::locale = Locale->new($self->{recipient_locale});
+
+
+  $main::lxdebug->leave_sub();
+  return $main::locale->text('Your Order');
+}
+
 sub get_number_prefix_for_type {
   $main::lxdebug->enter_sub();
   my ($self) = @_;
 sub get_number_prefix_for_type {
   $main::lxdebug->enter_sub();
   my ($self) = @_;
@@ -1345,6 +1266,10 @@ sub generate_email_subject {
     $subject .= " " . $self->{"${prefix}number"}
   }
 
     $subject .= " " . $self->{"${prefix}number"}
   }
 
+  if ($self->{cusordnumber}) {
+    $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject;
+  }
+
   $main::lxdebug->leave_sub();
   return $subject;
 }
   $main::lxdebug->leave_sub();
   return $subject;
 }
@@ -1898,10 +1823,10 @@ sub add_shipto {
                      shiptocountry = ?,
                      shiptogln = ?,
                      shiptocontact = ?,
                      shiptocountry = ?,
                      shiptogln = ?,
                      shiptocontact = ?,
-                     shiptocp_gender = ?,
                      shiptophone = ?,
                      shiptofax = ?,
                      shiptoemail = ?
                      shiptophone = ?,
                      shiptofax = ?,
                      shiptoemail = ?
+                     shiptocp_gender = ?,
                    WHERE shipto_id = ?|;
     do_query($self, $dbh, $query, @values, $self->{shipto_id});
   } else {
                    WHERE shipto_id = ?|;
     do_query($self, $dbh, $query, @values, $self->{shipto_id});
   } else {
@@ -1915,10 +1840,10 @@ sub add_shipto {
                      shiptocountry = ? AND
                      shiptogln = ? AND
                      shiptocontact = ? AND
                      shiptocountry = ? AND
                      shiptogln = ? AND
                      shiptocontact = ? AND
-                     shiptocp_gender = ? AND
                      shiptophone = ? AND
                      shiptofax = ? AND
                      shiptoemail = ? AND
                      shiptophone = ? AND
                      shiptofax = ? AND
                      shiptoemail = ? AND
+                     shiptocp_gender = ? AND
                      module = ? AND
                      trans_id = ?|;
     my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
                      module = ? AND
                      trans_id = ?|;
     my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
@@ -1926,7 +1851,7 @@ sub add_shipto {
       my $insert_query =
         qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
                                shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln,
       my $insert_query =
         qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
                                shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln,
-                               shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
+                               shiptocontact, shiptophone, shiptofax, shiptoemail, shiptocp_gender, module)
            VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
       do_query($self, $dbh, $insert_query, $id, @values, $module);
 
            VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
       do_query($self, $dbh, $insert_query, $id, @values, $module);
 
@@ -2653,7 +2578,7 @@ sub create_links {
     $query =
       qq|SELECT
            a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate,
     $query =
       qq|SELECT
            a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate,
-           a.duedate, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes,
+           a.duedate, a.tax_point, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes,
            a.mtime, a.itime,
            a.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
            a.mtime, a.itime,
            a.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
@@ -3044,11 +2969,13 @@ sub save_status {
 # $main::locale->text('ELSE')
 # $main::locale->text('SAVED FOR DUNNING')
 # $main::locale->text('DUNNING STARTED')
 # $main::locale->text('ELSE')
 # $main::locale->text('SAVED FOR DUNNING')
 # $main::locale->text('DUNNING STARTED')
+# $main::locale->text('PREVIEWED')
 # $main::locale->text('PRINTED')
 # $main::locale->text('MAILED')
 # $main::locale->text('SCREENED')
 # $main::locale->text('CANCELED')
 # $main::locale->text('IMPORT')
 # $main::locale->text('PRINTED')
 # $main::locale->text('MAILED')
 # $main::locale->text('SCREENED')
 # $main::locale->text('CANCELED')
 # $main::locale->text('IMPORT')
+# $main::locale->text('UNDO TRANSFER')
 # $main::locale->text('UNIMPORT')
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('UNIMPORT')
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
@@ -3268,19 +3195,6 @@ sub prepare_for_printing {
     $self->{"employee_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
   }
 
     $self->{"employee_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
   }
 
-  # Load shipping address from database. If shipto_id is set then it's
-  # one from the customer's/vendor's master data. Otherwise look an a
-  # customized address linking back to the current record.
-  my $shipto_module = $self->{type} =~ /_delivery_order$/                                             ? 'DO'
-                    : $self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/ ? 'OE'
-                    :                                                                                   'AR';
-  my $shipto        = $self->{shipto_id} ? SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load
-                    :                      SL::DB::Manager::Shipto->get_first(where => [ module => $shipto_module, trans_id => $self->{id} ]);
-  if ($shipto) {
-    $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns };
-    $self->{"shiptocvar_" . $_->config->name} = $_->value_as_text for @{ $shipto->cvars_by_config };
-  }
-
   my $language = $self->{language} ? '_' . $self->{language} : '';
 
   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
   my $language = $self->{language} ? '_' . $self->{language} : '';
 
   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
@@ -3329,7 +3243,7 @@ sub prepare_for_printing {
 
   # Format dates.
   $self->format_dates($output_dateformat, $output_longdates,
 
   # Format dates.
   $self->format_dates($output_dateformat, $output_longdates,
-                      qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid
+                      qw(invdate orddate quodate pldate duedate reqdate transdate tax_point shippingdate deliverydate validitydate paymentdate datepaid
                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
 
                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
 
Unnamed repository; edit this file 'description' to name the repository.