X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/7074eea89228b278a16ec6e89b1dcefd2c6a8257..f217d072d76183bc07723dcc29503b732bd2022d:/SL/Form.pm diff --git a/SL/Form.pm b/SL/Form.pm index e0bff1b40..0f998e1e5 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -49,6 +49,7 @@ use File::Copy; 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; @@ -389,6 +390,7 @@ sub create_http_response { '-path' => $uri->path, '-expires' => '+' . $::auth->{session_timeout} . 'm', '-secure' => $::request->is_https); + $session_cookie = "$session_cookie; SameSite=strict"; } } @@ -431,11 +433,13 @@ sub header { $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}; @@ -465,7 +469,7 @@ sub header { # 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 < @@ -552,11 +556,13 @@ sub _prepare_html_template { } $language = "de" unless ($language); - my $webpages_path = $::request->layout->webpages_path; + my $webpages_path = $::request->layout->webpages_path; + my $webpages_fallback = $::request->layout->webpages_fallback_path; - if (-f "${webpages_path}/${file}.html") { - $file = "${webpages_path}/${file}.html"; + 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 { @@ -897,7 +903,8 @@ sub parse_template { 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}; @@ -981,6 +988,7 @@ sub send_email { if ($attfile) { $attfile->{override_file_name} = $attachment_name if $attachment_name; push @attfiles, $attfile; + $self->{file_id} = $attfile->id; } } else { @@ -1010,17 +1018,17 @@ sub send_email { $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}; @@ -1094,7 +1102,10 @@ sub get_formname_translation { 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'), @@ -1102,6 +1113,8 @@ sub get_formname_translation { 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'), @@ -1136,13 +1149,13 @@ sub get_number_prefix_for_type { my $prefix = (first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note)) ? 'inv' - : ($self->{type} =~ /_quotation$/) ? 'quo' + : ($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(); @@ -1198,6 +1211,9 @@ sub generate_email_subject { $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(); @@ -1206,7 +1222,11 @@ sub generate_email_subject { } if ($self->{cusordnumber}) { - $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject; + $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(); @@ -1418,22 +1438,31 @@ sub update_balance { 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|; @@ -1459,6 +1488,7 @@ sub update_exchangerate { } 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 = ?) @@ -1474,80 +1504,34 @@ sub update_exchangerate { $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 = ?|; @@ -1664,9 +1648,11 @@ sub set_payment_options { $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 { @@ -1766,8 +1752,8 @@ sub add_shipto { shiptocontact = ?, shiptophone = ?, shiptofax = ?, - shiptoemail = ? - shiptocp_gender = ?, + shiptoemail = ?, + shiptocp_gender = ? WHERE shipto_id = ?|; do_query($self, $dbh, $query, @values, $self->{shipto_id}); } else { @@ -2523,7 +2509,7 @@ sub create_links { 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 @@ -2584,26 +2570,40 @@ sub create_links { 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++; } @@ -2615,6 +2615,36 @@ sub create_links { 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 = @@ -2644,21 +2674,11 @@ sub create_links { $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(); @@ -2951,12 +2971,16 @@ sub save_status { # $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(); @@ -3187,8 +3211,10 @@ sub prepare_for_printing { 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); } @@ -3339,9 +3365,7 @@ sub calculate_arap { 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 { @@ -3352,6 +3376,8 @@ sub calculate_arap { $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"}; @@ -3568,6 +3594,36 @@ Can be called wit C