use Data::Dumper;
use Carp;
-use Config;
use CGI;
use Cwd;
use Encode;
use File::Temp ();
use IO::File;
use Math::BigInt;
+use Params::Validate qw(:all);
use POSIX qw(strftime);
use SL::Auth;
use SL::Auth::DB;
use SL::DB;
use SL::DBConnect;
use SL::DBUtils;
+use SL::DB::AdditionalBillingAddress;
use SL::DB::Customer;
+use SL::DB::CustomVariableConfig;
use SL::DB::Default;
use SL::DB::PaymentTerm;
use SL::DB::Vendor;
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;
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);
+ $session_cookie = "$session_cookie; SameSite=strict";
}
}
$layout->use_javascript("$_.js") for (qw(
jquery jquery-ui jquery.cookie jquery.checkall jquery.download
- jquery/jquery.form jquery/fixes client_js
+ jquery/jquery.form jquery/fixes namespace client_js
jquery/jquery.tooltipster.min
common part_selection
), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
+ $layout->use_javascript("$_.js") for @{ $params{use_javascripts} // [] };
+
$self->{favicon} ||= "favicon.ico";
$self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->read_version if $self->{title} || !$self->{titlebar};
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} || [] };
# output
print $self->create_http_response(content_type => 'text/html', charset => 'UTF-8');
- print $doctypes{$params{doctype} || 'transitional'}, $/;
+ print $doctypes{$params{doctype} || $::request->layout->html_dialect}, $/;
print <<EOT;
<html>
<head>
}
$language = "de" unless ($language);
- if (-f "templates/webpages/${file}.html") {
- $file = "templates/webpages/${file}.html";
+ my $webpages_path = $::request->layout->webpages_path;
+ my $webpages_fallback = $::request->layout->webpages_fallback_path;
+
+ my @templates = first { -f } map { "${_}/${file}.html" } grep { defined } $webpages_path, $webpages_fallback;
+ if (@templates) {
+ $file = $templates[0];
} elsif (ref $file eq 'SCALAR') {
# file is a scalarref, use inline mode
} else {
return @columns;
}
#
-sub format_amount {
- $main::lxdebug->enter_sub(2);
+sub format_amount {
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;
-}
-
-sub format_amount_units {
- $main::lxdebug->enter_sub();
-
- my $self = shift;
- my %params = @_;
-
- my $myconfig = \%main::myconfig;
- my $amount = $params{amount} * 1;
- my $places = $params{places};
- my $part_unit_name = $params{part_unit};
- my $amount_unit_name = $params{amount_unit};
- my $conv_units = $params{conv_units};
- my $max_places = $params{max_places};
-
- if (!$part_unit_name) {
- $main::lxdebug->leave_sub();
- return '';
- }
-
- my $all_units = AM->retrieve_all_units;
-
- if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
- $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
- }
-
- if (!scalar @{ $conv_units }) {
- my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
- $main::lxdebug->leave_sub();
- return $result;
- }
-
- my $part_unit = $all_units->{$part_unit_name};
- my $conv_unit = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;
-
- $amount *= $conv_unit->{factor};
-
- my @values;
- my $num;
-
- foreach my $unit (@$conv_units) {
- my $last = $unit->{name} eq $part_unit->{name};
- if (!$last) {
- $num = int($amount / $unit->{factor});
- $amount -= $num * $unit->{factor};
- }
-
- if ($last ? $amount : $num) {
- push @values, { "unit" => $unit->{name},
- "amount" => $last ? $amount / $unit->{factor} : $num,
- "places" => $last ? $places : 0 };
- }
-
- last if $last;
- }
-
- if (!@values) {
- push @values, { "unit" => $part_unit_name,
- "amount" => 0,
- "places" => 0 };
- }
-
- my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;
-
- $main::lxdebug->leave_sub();
-
- return $result;
+ SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
}
sub format_string {
#
sub parse_amount {
- $main::lxdebug->enter_sub(2);
-
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();
# therefore copy to webdav, even if we do not have the webdav feature enabled (just archive)
my $copy_to_webdav = $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type}
&& $self->{type} ne 'statement';
+
+ $self->{attachment_filename} ||= $self->generate_attachment_filename;
+
if ( $ext_for_format eq 'pdf' && $self->doc_storage_enabled ) {
$self->append_general_pdf_attachments(filepath => $self->{tmpdir}."/".$self->{tmpfile},
type => $self->{type});
}
}
- 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->cleanup;
}
}
- if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->doc_storage_enabled) {
- $self->{attachment_filename} ||= $self->generate_attachment_filename;
+ if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) {
my $file_obj = $self->store_pdf($self);
$self->{print_file_id} = $file_obj->id if $file_obj;
}
- if ($self->{media} eq 'email') {
+ # dn has its own send email method, but sets media for print templates
+ if ($self->{media} eq 'email' && !$self->{dunning_id}) {
if ( getcwd() eq $self->{"tmpdir"} ) {
# in the case of generating pdf we are in the tmpdir, but WHY ???
$self->{tmpfile} = $userspath."/".$self->{tmpfile};
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->{fileid} = time() . '.' . $$ . '.';
+ $mail->{content_type} = "text/html";
my $full_signature = $self->create_email_signature();
- $full_signature =~ s/\r//g;
$mail->{attachments} = [];
my @attfiles;
# if we send html or plain text inline
if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
- $mail->{content_type} = "text/html";
$mail->{message} =~ s/\r//g;
$mail->{message} =~ s{\n}{<br>\n}g;
- $full_signature =~ s{\n}{<br>\n}g;
$mail->{message} .= $full_signature;
open(IN, "<", $self->{tmpfile})
$attachment_name =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format);
if (($self->{attachment_policy} // '') eq 'old_file') {
- my ( $attfile ) = SL::File->get_all(object_id => $self->{id},
- object_type => $self->{formname},
- file_type => 'document');
+ my ( $attfile ) = SL::File->get_all(object_id => $self->{id},
+ object_type => $self->{type},
+ file_type => 'document',
+ print_variant => $self->{formname},);
if ($attfile) {
$attfile->{override_file_name} = $attachment_name if $attachment_name;
push @attfiles, $attfile;
+ $self->{file_id} = $attfile->id;
}
} else {
$mail->{message} .= $full_signature;
$self->{emailerr} = $mail->send();
- if ($self->{emailerr}) {
- $self->cleanup;
- $self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr}));
- }
-
$self->{email_journal_id} = $mail->{journalentry};
$self->{snumbers} = "emailjournal" . "_" . $self->{email_journal_id};
$self->{what_done} = $::form->{type};
$self->{addition} = "MAILED";
$self->save_history;
+ if ($self->{emailerr}) {
+ $self->cleanup;
+ $self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr}));
+ }
+
#write back for message info and mail journal
$self->{cc} = $mail->{cc};
$self->{bcc} = $mail->{bcc};
local $::locale = Locale->new($self->{recipient_locale});
my %formname_translations = (
- bin_list => $main::locale->text('Bin List'),
- credit_note => $main::locale->text('Credit Note'),
- invoice => $main::locale->text('Invoice'),
- 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'),
- sales_delivery_order => $main::locale->text('Delivery Order'),
- purchase_delivery_order => $main::locale->text('Delivery Order'),
- dunning => $main::locale->text('Dunning'),
- dunning1 => $main::locale->text('Payment Reminder'),
- dunning2 => $main::locale->text('Dunning'),
- dunning3 => $main::locale->text('Last Dunning'),
- dunning_invoice => $main::locale->text('Dunning Invoice'),
- letter => $main::locale->text('Letter'),
- ic_supply => $main::locale->text('Intra-Community supply'),
- statement => $main::locale->text('Statement'),
+ bin_list => $main::locale->text('Bin List'),
+ credit_note => $main::locale->text('Credit Note'),
+ invoice => $main::locale->text('Invoice'),
+ invoice_copy => $main::locale->text('Invoice Copy'),
+ invoice_for_advance_payment => $main::locale->text('Invoice for Advance Payment'),
+ final_invoice => $main::locale->text('Final Invoice'),
+ pick_list => $main::locale->text('Pick List'),
+ proforma => $main::locale->text('Proforma Invoice'),
+ purchase_order => $main::locale->text('Purchase Order'),
+ purchase_order_confirmation => $main::locale->text('Purchase Order Confirmation'),
+ request_quotation => $main::locale->text('RFQ'),
+ purchase_quotation_intake => $main::locale->text('Purchase Quotation Intake'),
+ sales_order_intake => $main::locale->text('Sales Order Intake'),
+ sales_order => $main::locale->text('Confirmation'),
+ sales_quotation => $main::locale->text('Quotation'),
+ storno_invoice => $main::locale->text('Storno Invoice'),
+ sales_delivery_order => $main::locale->text('Delivery Order'),
+ purchase_delivery_order => $main::locale->text('Delivery Order'),
+ supplier_delivery_order => $main::locale->text('Supplier Delivery Order'),
+ rma_delivery_order => $main::locale->text('RMA Delivery Order'),
+ sales_reclamation => $main::locale->text('Sales Reclamation'),
+ purchase_reclamation => $main::locale->text('Purchase Reclamation'),
+ dunning => $main::locale->text('Dunning'),
+ dunning1 => $main::locale->text('Payment Reminder'),
+ dunning2 => $main::locale->text('Dunning'),
+ dunning3 => $main::locale->text('Last Dunning'),
+ dunning_invoice => $main::locale->text('Dunning Invoice'),
+ letter => $main::locale->text('Letter'),
+ ic_supply => $main::locale->text('Intra-Community supply'),
+ statement => $main::locale->text('Statement'),
);
$main::lxdebug->leave_sub();
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) = @_;
my $prefix =
- (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
- : ($self->{type} =~ /_quotation$/) ? 'quo'
- : ($self->{type} =~ /_delivery_order$/) ? 'do'
- : ($self->{type} =~ /letter/) ? 'letter'
- : 'ord';
+ (first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note)) ? 'inv'
+ : ($self->{type} =~ /_quotation/) ? 'quo'
+ : ($self->{type} =~ /_delivery_order$/) ? 'do'
+ : ($self->{type} =~ /letter/) ? 'letter'
+ : 'ord';
# better default like this?
- # : ($self->{type} =~ /(sales|purcharse)_order/ : 'ord';
+ # : ($self->{type} =~ /(sales|purchase)_order/ : 'ord';
# : 'prefix_undefined';
$main::lxdebug->leave_sub();
my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();
- if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
+ if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note))) {
$attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
} elsif ($attachment_filename && $self->{"${prefix}number"}) {
$main::lxdebug->enter_sub();
my ($self) = @_;
+ my $defaults = SL::DB::Default->get;
+
+ my $sep = ' / ';
my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();
$subject .= " " . $self->{"${prefix}number"}
}
+ if ($self->{cusordnumber}) {
+ $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . $sep . $subject;
+ }
+
+ if ($defaults->email_subject_transaction_description) {
+ $subject .= $sep . $self->{transaction_description} if $self->{transaction_description};
+ }
+
$main::lxdebug->leave_sub();
return $subject;
}
return undef unless $body;
+ $body .= GenericTranslations->get(translation_type => "salutation_punctuation_mark", language_id => $self->{language_id});
+ $body = '<p>' . $::locale->quote_special_chars('HTML', $body) . '</p>';
+
my $translation_type = $params{translation_type} // "preset_text_$self->{formname}";
my $main_body = GenericTranslations->get(translation_type => $translation_type, language_id => $self->{language_id});
$main_body = GenericTranslations->get(translation_type => $params{fallback_translation_type}, language_id => $self->{language_id}) if !$main_body && $params{fallback_translation_type};
- $body .= GenericTranslations->get(translation_type => "salutation_punctuation_mark", language_id => $self->{language_id}) . "\n\n";
$body .= $main_body;
$body = $main::locale->unquote_special_chars('HTML', $body);
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;
- }
- $query = qq|SELECT name AS curr FROM currencies WHERE id=(SELECT currency_id FROM defaults)|;
-
- my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
-
- if ($curr eq $defaultcurrency) {
+ validate_pos(@_,
+ { isa => 'Form'},
+ { isa => 'DBI::db'},
+ { type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
+ { type => SCALAR, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+\d+\d+/ } } }, # we have three numers
+ { type => SCALAR, callbacks => { is_null_or_ar_int => sub { $_[0] == 0
+ || $_[0] > 0
+ && $_[1]->[0]->{script} =~ m/cp\.pl|ar\.pl|is\.pl/ } } }, # value buy fxrate
+ { type => SCALAR, callbacks => { is_null_or_ap_int => sub { $_[0] == 0
+ || $_[0] > 0
+ && $_[1]->[0]->{script} =~ m/cp\.pl|ap\.pl|ir\.pl/ } } }, # value sell fxrate
+ { type => SCALAR, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 },
+ { type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/(ar|ap|bank_transactions)/ } }, optional => 1 }
+ );
+
+ my ($self, $dbh, $curr, $transdate, $buy, $sell, $id, $record_table) = @_;
+
+ # record has a exchange rate and should be updated
+ if ($record_table && $id) {
+ do_query($self, $dbh, qq|UPDATE $record_table SET exchangerate = ? WHERE id = ?|, $buy || $sell, $id);
$main::lxdebug->leave_sub();
return;
}
+ my ($query);
$query = qq|SELECT e.currency_id FROM exchangerate e
WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ?
FOR UPDATE|;
}
if ($sth->fetchrow_array) {
+ # die "this never happens never"; # except for credit or debit bookings
$query = qq|UPDATE exchangerate
SET $set
WHERE currency_id = (SELECT id FROM currencies WHERE name = ?)
$main::lxdebug->leave_sub();
}
-sub save_exchangerate {
- $main::lxdebug->enter_sub();
-
- my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
-
- SL::DB->client->with_transaction(sub {
- my $dbh = SL::DB->client->dbh;
-
- my ($buy, $sell);
-
- $buy = $rate if $fld eq 'buy';
- $sell = $rate if $fld eq 'sell';
-
-
- $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
- 1;
- }) or do { die SL::DB->client->error };
-
- $main::lxdebug->leave_sub();
-}
-
-sub get_exchangerate {
- $main::lxdebug->enter_sub();
-
- my ($self, $dbh, $curr, $transdate, $fld) = @_;
- my ($query);
-
- unless ($transdate && $curr) {
- $main::lxdebug->leave_sub();
- return 1;
- }
-
- $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|;
-
- my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
-
- if ($curr eq $defaultcurrency) {
- $main::lxdebug->leave_sub();
- return 1;
- }
-
- $query = qq|SELECT e.$fld FROM exchangerate e
- WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|;
- my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
-
-
-
- $main::lxdebug->leave_sub();
-
- return $exchangerate;
-}
-
sub check_exchangerate {
$main::lxdebug->enter_sub();
- my ($self, $myconfig, $currency, $transdate, $fld) = @_;
+ validate_pos(@_,
+ { isa => 'Form'},
+ { type => HASHREF, callbacks => { has_yy_in_dateformat => sub { $_[0]->{dateformat} =~ m/yy/ } } },
+ { type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
+ { type => SCALAR | HASHREF, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+.\d+.\d+/ } } }, # we have three numbers. Either DateTime or form scalar
+ { type => SCALAR, callbacks => { is_buy_or_sell_rate => sub { shift =~ m/^(buy|sell)$/ } } },
+ { type => SCALAR | UNDEF, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 },
+ { type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/^(ar|ap)$/ } }, optional => 1 }
+ );
+ my ($self, $myconfig, $currency, $transdate, $fld, $id, $record_table) = @_;
- if ($fld !~/^buy|sell$/) {
- $self->error('Fatal: check_exchangerate called with invalid buy/sell argument');
- }
-
- unless ($transdate) {
- $main::lxdebug->leave_sub();
- return "";
- }
+ my $dbh = $self->get_standard_dbh($myconfig);
- my ($defaultcurrency) = $self->get_default_currency($myconfig);
+ # callers wants a check if record has a exchange rate and should be fetched instead
+ if ($record_table && $id) {
+ my ($record_exchange_rate) = selectrow_query($self, $dbh, qq|SELECT exchangerate FROM $record_table WHERE id = ?|, $id);
+ if ($record_exchange_rate && $record_exchange_rate > 0) {
- if ($currency eq $defaultcurrency) {
- $main::lxdebug->leave_sub();
- return 1;
+ $main::lxdebug->leave_sub();
+ # second param indicates record exchange rate
+ return ($record_exchange_rate, 1);
+ }
}
- my $dbh = $self->get_standard_dbh($myconfig);
+ # fetch default from exchangerate table
my $query = qq|SELECT e.$fld FROM exchangerate e
WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|;
$self->{payment_terms} =~ s/<\%mandator_id\%>/$self->{mandator_id}/g;
map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
-
- $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
-
+ # put amounts in form for print template
+ foreach (keys %formatted_amounts) {
+ next if $_ =~ m/(^total$|^invtotal$)/;
+ $self->{$_} = $formatted_amounts{$_};
+ }
}
sub get_template_language {
shiptocontact = ?,
shiptophone = ?,
shiptofax = ?,
- shiptoemail = ?
- shiptocp_gender = ?,
+ shiptoemail = ?,
+ shiptocp_gender = ?
WHERE shipto_id = ?|;
do_query($self, $dbh, $query, @values, $self->{shipto_id});
} else {
$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.globalproject_id, ${extra_columns}
+ a.globalproject_id, a.transaction_description, ${extra_columns}
c.name AS $table,
d.description AS department,
e.name AS employee
c.accno, c.description,
a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id,
p.projectnumber,
- t.rate, t.id
+ t.rate, t.id,
+ a.fx_transaction
FROM acc_trans a
LEFT JOIN chart c ON (c.id = a.chart_id)
LEFT JOIN project p ON (p.id = a.project_id)
LEFT JOIN tax t ON (t.id= a.tax_id)
WHERE a.trans_id = ?
- AND a.fx_transaction = '0'
ORDER BY a.acc_trans_id, a.transdate|;
$sth = $dbh->prepare($query);
do_statement($self, $sth, $query, $self->{id});
# get exchangerate for currency
- $self->{exchangerate} =
- $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
+ ($self->{exchangerate}, $self->{record_forex}) = $self->check_exchangerate($myconfig, $self->{currency}, $self->{transdate}, $fld,
+ $self->{id}, $arap);
+
my $index = 0;
+ my @fx_transaction_entries;
# store amounts in {acc_trans}{$key} for multiple accounts
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
+ # skip fx_transaction entries and add them for post processing
+ if ($ref->{fx_transaction}) {
+ die "first entry in a record transaction should not be fx_transaction" unless @fx_transaction_entries;
+ push @{ $fx_transaction_entries[-1] }, $ref;
+ next;
+ } else {
+ push @fx_transaction_entries, [ $ref ];
+ }
+
+
+ # credit and debit bookings calc fx rate for positions
+ # also used as exchangerate_$i for payments - exchangerate here can come from frontend or from bank transactions
$ref->{exchangerate} =
- $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
+ $self->check_exchangerate($myconfig, $self->{currency}, $ref->{transdate}, $fld);
if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
$index++;
}
push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
}
+ # post process fx_transactions.
+ # old bin/mozilla code first posts the intended foreign currency amount and then the correction for exchange flagged as fx_transaction
+ # for example: when posting 20 USD on a system in EUR with an exchangerate of 1.1, the resulting acc_trans will say:
+ # +20 no fx (intended: 20 USD)
+ # +2 fx (but it's actually 22 EUR)
+ #
+ # for payments this is followed by the fxgain/loss. when paying the above invoice with 20 USD at 1.3 exchange:
+ # -20 no fx (intended: 20 USD)
+ # -6 fx (but it's actually 26 EUR)
+ # +4 fx (but 4 of them go to fxgain)
+ #
+ # bin/mozilla/ controllers will display the intended amount as is, but would have to guess at the actual book value
+ # without the extra fields
+ #
+ # bank transactions however will convert directly into internal currency, so a foreign currency invoice might end up
+ # having non-fxtransactions. to make sure that these are roundtrip safe, flag the fx-transaction payments as fx and give the
+ # intendended internal amount
+ #
+ # this still operates on the cached entries of form->{acc_trans}
+ for my $fx_block (@fx_transaction_entries) {
+ my ($ref, @fx_entries) = @$fx_block;
+ for my $fx_ref (@fx_entries) {
+ if ($fx_ref->{chart_id} == $ref->{chart_id}) {
+ $ref->{defaultcurrency_paid} //= $ref->{amount};
+ $ref->{defaultcurrency_paid} += $fx_ref->{amount};
+ $ref->{fx_transaction} = 1;
+ }
+ }
+ }
+
$sth->finish;
#check das:
$query =
$ref = selectfirst_hashref_query($self, $dbh, $query);
map { $self->{$_} = $ref->{$_} } keys %$ref;
- if ($self->{"$self->{vc}_id"}) {
-
- # only setup currency
- ($self->{currency}) = $self->{defaultcurrency} if !$self->{currency};
-
- } else {
-
- $self->lastname_used($dbh, $myconfig, $table, $module);
-
- # get exchangerate for currency
- $self->{exchangerate} =
- $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
-
- }
-
+ # failsafe, set currency if caller has not yet assigned one
+ $self->lastname_used($dbh, $myconfig, $table, $module) unless ($self->{"$self->{vc}_id"});
+ $self->{currency} = $self->{defaultcurrency} unless $self->{currency};
+ $self->{exchangerate} =
+ $self->check_exchangerate($myconfig, $self->{currency}, $self->{transdate}, $fld);
}
$main::lxdebug->leave_sub();
}
sub get_variable_content_types {
- my %html_variables = (
- longdescription => 'html',
- partnotes => 'html',
- notes => 'html',
- orignotes => 'html',
- notes1 => 'html',
- notes2 => 'html',
- notes3 => 'html',
- notes4 => 'html',
- header_text => 'html',
- footer_text => 'html',
+ my ($self) = @_;
+
+ my %html_variables = (
+ longdescription => 'html',
+ partnotes => 'html',
+ notes => 'html',
+ orignotes => 'html',
+ notes1 => 'html',
+ notes2 => 'html',
+ notes3 => 'html',
+ notes4 => 'html',
+ header_text => 'html',
+ footer_text => 'html',
);
- return \%html_variables;
+
+ return {
+ %html_variables,
+ $self->get_variable_content_types_for_cvars,
+ };
+}
+
+sub get_variable_content_types_for_cvars {
+ my ($self) = @_;
+ my $html_configs = SL::DB::Manager::CustomVariableConfig->get_all(where => [ type => 'htmlfield' ]);
+ my %types;
+
+ if (@{ $html_configs }) {
+ my %prefix_by_module = (
+ Contacts => 'cp_cvar_',
+ CT => 'vc_cvar_',
+ IC => 'ic_cvar_',
+ Projects => 'project_cvar_',
+ ShipTo => 'shiptocvar_',
+ );
+
+ foreach my $cfg (@{ $html_configs }) {
+ my $prefix = $prefix_by_module{$cfg->module};
+ $types{$prefix . $cfg->name} = 'html' if $prefix;
+ }
+ }
+
+ return %types;
}
sub current_date {
# $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('UNDO TRANSFER')
# $main::locale->text('UNIMPORT')
# $main::locale->text('invoice')
+# $main::locale->text('invoice_for_advance_payment')
+# $main::locale->text('final_invoice')
# $main::locale->text('proforma')
+# $main::locale->text('storno_invoice')
+# $main::locale->text('sales_order_intake')
# $main::locale->text('sales_order')
# $main::locale->text('pick_list')
# $main::locale->text('purchase_order')
+# $main::locale->text('purchase_order_confirmation')
# $main::locale->text('bin_list')
# $main::locale->text('sales_quotation')
# $main::locale->text('request_quotation')
+# $main::locale->text('purchase_quotation_intake')
sub save_history {
$main::lxdebug->enter_sub();
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 . qq|) $restriction | .
+ qq|WHERE (trans_id = | . $dbh->quote($trans_id) . qq|) $restriction | .
$order;
my $sth = $dbh->prepare($query) || $self->dberror($query);
if ($self->{type} =~ /_delivery_order$/) {
DO->order_details(\%::myconfig, $self);
- } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) {
+ } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order|purchase_quotation_intake/) {
OE->order_details(\%::myconfig, $self);
+ } elsif ($self->{type} =~ /reclamation/) {
+ # skip reclamation here, legacy template arrays are added in the reclamation controller
} else {
IS->invoice_details(\%::myconfig, $self, $::locale);
}
+ $self->set_addition_billing_address_print_variables;
+
# Chose extension & set source file name
my $extension = 'html';
if ($self->{format} eq 'postscript') {
# 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})));
today => DateTime->today,
};
+ if ($defaults->print_interpolate_variables_in_positions) {
+ $self->substitute_placeholders_in_template_arrays({ field => 'description', type => 'text' }, { field => 'longdescription', type => 'html' });
+ }
+
+ return $self;
+}
+
+sub set_addition_billing_address_print_variables {
+ my ($self) = @_;
+
+ return if !$self->{billing_address_id};
+
+ my $address = SL::DB::Manager::AdditionalBillingAddress->find_by(id => $self->{billing_address_id});
+ return if !$address;
+
+ $self->{"billing_address_${_}"} = $address->$_ for map { $_->name } @{ $address->meta->columns };
+}
+
+sub substitute_placeholders_in_template_arrays {
+ my ($self, @fields) = @_;
+
+ foreach my $spec (@fields) {
+ $spec = { field => $spec, type => 'text' } if !ref($spec);
+ my $field = $spec->{field};
+
+ next unless exists $self->{TEMPLATE_ARRAYS} && exists $self->{TEMPLATE_ARRAYS}->{$field};
+
+ my $tag_start = $spec->{type} eq 'html' ? '<%' : '<%';
+ my $tag_end = $spec->{type} eq 'html' ? '%>' : '%>';
+ my $formatter = $spec->{type} eq 'html' ? sub { $::locale->quote_special_chars('html', $_[0] // '') } : sub { $_[0] };
+
+ $self->{TEMPLATE_ARRAYS}->{$field} = [
+ apply { s{${tag_start}(.+?)${tag_end}}{ $formatter->($self->{$1}) }eg }
+ @{ $self->{TEMPLATE_ARRAYS}->{$field} }
+ ];
+ }
+
return $self;
}
my $tax_id = $self->{"tax_id_$i"};
my $selected_tax = SL::DB::Manager::Tax->find_by(id => "$tax_id");
-
- if ( $selected_tax ) {
-
+ if ( $selected_tax && !$selected_tax->reverse_charge_chart_id) {
if ( $buysell eq 'sell' ) {
$self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
} else {
$self->{"taxrate_$i"} = $selected_tax->rate;
};
+ $self->{"taxkey_$i"} = $selected_tax->taxkey if ($selected_tax && $selected_tax->reverse_charge_chart_id);
+
($self->{"amount_$i"}, $self->{"tax_$i"}) = $self->calculate_tax($self->{"amount_$i"},$self->{"taxrate_$i"},$taxincluded,$roundplaces);
$netamount += $self->{"amount_$i"};
}
sub create_email_signature {
-
my $client_signature = $::instance_conf->get_signature;
my $user_signature = $::myconfig{signature};
- my $signature = '';
- if ( $client_signature or $user_signature ) {
- $signature = "\n\n-- \n";
- $signature .= $user_signature . "\n" if $user_signature;
- $signature .= $client_signature . "\n" if $client_signature;
- };
- return $signature;
-
-};
+ return join '', grep { $_ } ($user_signature, $client_signature);
+}
sub calculate_tax {
# this function calculates the net amount and tax for the lines in ar, ap and
Returns undef if no save operation has been done yet ($self->{id} not present).
Returns undef if no concurrent write process is detected otherwise a error message.
+=back
+
+=over 4
+
+=item C<check_exchangerate> $myconfig, $currency, $transdate, $fld, $id, $record_table
+
+Needs a local myconfig, a currency string, a date of the transaction, a field (fld) which
+has to be either the buy or sell exchangerate and checks if there is already a buy or
+sell exchangerate for this date.
+Returns 0 or (NULL) if no entry is found or the already stored exchangerate.
+If the optional parameter id and record_table is passed, the method tries to look up
+a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions.
+If none is found the default (daily) entry will be checked.
+The method is very strict about the parameters and tries to fail if anything does
+not look like the expected type.
+
+=item C<update_exchangerate> $dbh, $curr, $transdate, $buy, $sell, $id, $record_table
+
+Needs a dbh connection, a currency string, a date of the transaction, buy (0|1), sell (0|1) which
+determines if either the buy or sell or both exchangerates should be updated and updates
+the exchangerate for this currency for this date.
+If the optional parameter id and record_table is passed, the method saves
+a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions.
+
+The method is very strict about the parameters and tries to fail if anything does not look
+like the expected type.
+
+
+
+
=back
=cut
projects / mfinanz.git / blobdiff