X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/ff159a4d47b9a2d10744dcfc23da2c63605c8a32..eeb5375ee7727c956cc357cc8f90b19d1bfe80b9:/SL/DB/BankTransaction.pm

diff --git a/SL/DB/BankTransaction.pm b/SL/DB/BankTransaction.pm
index b07cdf11f..bada24ea6 100644
--- a/SL/DB/BankTransaction.pm
+++ b/SL/DB/BankTransaction.pm
@@ -54,7 +54,7 @@ sub is_batch_transaction {
 
 
 sub get_agreement_with_invoice {
-  my ($self, $invoice, %params) = @_;
+  my ($self, $invoice) = @_;
 
   carp "get_agreement_with_invoice needs an invoice object as its first argument"
     unless ref($invoice) eq 'SL::DB::Invoice' or ref($invoice) eq 'SL::DB::PurchaseInvoice';
@@ -79,9 +79,12 @@ sub get_agreement_with_invoice {
     payment_within_30_days      => 1,
     remote_account_number       => 3,
     skonto_exact_amount         => 5,
+    skonto_fuzzy_amount         => 3,
     wrong_sign                  => -4,
     sepa_export_item            => 5,
+    end_to_end_id               => 8,
     batch_sepa_transaction      => 20,
+    qr_reference                => 20,
   );
 
   my ($agreement,$rule_matches);
@@ -91,6 +94,16 @@ sub get_agreement_with_invoice {
     $rule_matches .= 'batch_sepa_transaction(' . $points{'batch_sepa_transaction'} . ') ';
   }
 
+  # check swiss qr reference if feature enabled
+  if ($::instance_conf->get_create_qrbill_invoices == 1) {
+    if ($self->{qr_reference} && $invoice->{qr_reference} &&
+        $self->{qr_reference} eq $invoice->{qr_reference}) {
+
+      $agreement += $points{qr_reference};
+      $rule_matches .= 'qr_reference(' . $points{'qr_reference'} . ') ';
+    }
+  }
+
   # compare banking arrangements
   my ($iban, $bank_code, $account_number);
   $bank_code      = $invoice->customer->bank_code      if $invoice->is_sales;
@@ -139,6 +152,14 @@ sub get_agreement_with_invoice {
     $agreement += $points{skonto_exact_amount};
     $rule_matches .= 'skonto_exact_amount(' . $points{'skonto_exact_amount'} . ') ';
     $invoice->{skonto_type} = 'with_skonto_pt';
+  } elsif (   $::instance_conf->get_fuzzy_skonto
+           && $invoice->skonto_date && $::instance_conf->get_fuzzy_skonto_percentage > 0
+           && abs(abs($invoice->amount_less_skonto) - abs($self->amount))
+              < abs($invoice->amount / (100 / $::instance_conf->get_fuzzy_skonto_percentage))) {
+    # we have a skonto within the range of fuzzy skonto percentage (default 0.5%)
+    $agreement += $points{skonto_fuzzy_amount};
+    $rule_matches .= 'skonto_fuzzy_amount(' . $points{'skonto_fuzzy_amount'} . ') ';
+    $invoice->{skonto_type} = 'with_fuzzy_skonto_pt';
   }
 
   #search invoice number in purpose
@@ -146,19 +167,19 @@ sub get_agreement_with_invoice {
   # invnumber has to have at least 3 characters
   my $squashed_purpose = $self->purpose;
   $squashed_purpose =~ s/ //g;
-  if (length($invnumber) > 4 && $squashed_purpose =~ /$invnumber/ && $invoice->is_sales){
+  if (length($invnumber) > 4 && $squashed_purpose =~ /\Q$invnumber/ && $invoice->is_sales){
     $agreement      += $points{own_invoice_in_purpose};
     $rule_matches   .= 'own_invoice_in_purpose(' . $points{'own_invoice_in_purpose'} . ') ';
-  } elsif (length($invnumber) > 3 && $squashed_purpose =~ /$invnumber/ ) {
+  } elsif (length($invnumber) > 3 && $squashed_purpose =~ /\Q$invnumber/ ) {
     $agreement      += $points{invoice_in_purpose};
     $rule_matches   .= 'invoice_in_purpose(' . $points{'invoice_in_purpose'} . ') ';
   } else {
     # only check number part of invoice number
     $invnumber      =~ s/[A-Za-z_]+//g;
-    if (length($invnumber) > 4 && $squashed_purpose =~ /$invnumber/ && $invoice->is_sales){
+    if (length($invnumber) > 4 && $squashed_purpose =~ /\Q$invnumber/ && $invoice->is_sales){
       $agreement    += $points{own_invnumber_in_purpose};
       $rule_matches .= 'own_invnumber_in_purpose(' . $points{'own_invnumber_in_purpose'} . ') ';
-    } elsif (length($invnumber) > 3 && $squashed_purpose =~ /$invnumber/ ) {
+    } elsif (length($invnumber) > 3 && $squashed_purpose =~ /\Q$invnumber/ ) {
       $agreement    += $points{invnumber_in_purpose};
       $rule_matches .= 'invnumber_in_purpose(' . $points{'invnumber_in_purpose'} . ') ';
     }
@@ -198,7 +219,7 @@ sub get_agreement_with_invoice {
   my $depositorname;
   $depositorname = $invoice->customer->depositor if $invoice->is_sales;
   $depositorname = $invoice->vendor->depositor   if ! $invoice->is_sales;
-  if ( $depositorname && $self->remote_name =~ /$depositorname/ ) {
+  if ( $depositorname && $self->remote_name =~ /\Q$depositorname/ ) {
     $agreement += $points{depositor_matches};
     $rule_matches .= 'depositor_matches(' . $points{'depositor_matches'} . ') ';
   }
@@ -247,32 +268,27 @@ sub get_agreement_with_invoice {
     }
   }
 
-  # if there is exactly one non-executed sepa_export_item for the invoice
-  my $seis = $params{sepa_export_items}
-           ? [ grep { $invoice->id == ($invoice->is_sales ? $_->ar_id : $_->ap_id) } @{ $params{sepa_export_items} } ]
-           : $invoice->find_sepa_export_items({ executed => 0 });
+  my $seis = $invoice->find_sepa_export_items({ executed => 0 });
   if ($seis) {
-    if (scalar @$seis == 1) {
-      my $sei = $seis->[0];
-
-      # test for amount and id matching only, sepa transfer date and bank
-      # transaction date needn't match
-      if (abs($self->amount) == ($sei->amount) && $invoice->id == $sei->arap_id) {
-        $agreement    += $points{sepa_export_item};
-        $rule_matches .= 'sepa_export_item(' . $points{'sepa_export_item'} . ') ';
-      }
-    } else {
-      # zero or more than one sepa_export_item, do nothing for this invoice
-      # zero: do nothing, no sepa_export_item exists, no match
-      # more than one: does this ever apply? Currently you can't create sepa
-      # exports for invoices that already have a non-executed sepa_export
-      # TODO: Catch the more than one case. User is allowed to split
-      # payments for one invoice item in one sepa export.
+
+    # test if end to end id matches for any sepa export
+    if ($self->end_to_end_id &&
+        grep { $self->end_to_end_id eq $_->end_to_end_id } @{ $seis }) {
+      $agreement    += $points{end_to_end_id};
+      $rule_matches .= 'end_to_end_id(' . $points{'end_to_end_id'} . ') ';
     }
-  }
 
+    # if there is exactly one non-executed sepa_export_item for the invoice
+    # test for amount and id matching only, sepa transfer date and bank
+    # transaction date needn't match
+    if (scalar @{ $seis } == 1 && $invoice->id       == $seis->[0]->arap_id
+                               && abs($self->amount) == $seis->[0]->amount  ) {
+      $agreement    += $points{sepa_export_item};
+      $rule_matches .= 'sepa_export_item(' . $points{'sepa_export_item'} . ') ';
+    }
+  }
   return ($agreement,$rule_matches);
-};
+}
 
 sub _check_string {
     my $bankstring = shift;