BankTransaction: Treffer für Kreditorengutschriften erhöhen
[kivitendo-erp.git] / SL / DB / BankTransaction.pm
1 # This file has been auto-generated only because it didn't exist.
2 # Feel free to modify it at will; it will not be overwritten automatically.
3
4 package SL::DB::BankTransaction;
5
6 use strict;
7
8 use SL::DB::MetaSetup::BankTransaction;
9 use SL::DB::Manager::BankTransaction;
10 use SL::DB::Helper::LinkedRecords;
11 use Carp;
12
13 require SL::DB::Invoice;
14 require SL::DB::PurchaseInvoice;
15
16 __PACKAGE__->meta->initialize;
17
18
19 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
20 #__PACKAGE__->meta->make_manager_class;
21
22 sub compare_to {
23   my ($self, $other) = @_;
24
25   return  1 if  $self->transdate && !$other->transdate;
26   return -1 if !$self->transdate &&  $other->transdate;
27
28   my $result = 0;
29   $result    = $self->transdate <=> $other->transdate if $self->transdate;
30   return $result || ($self->id <=> $other->id);
31 }
32
33 sub linked_invoices {
34   my ($self) = @_;
35
36   #my $record_links = $self->linked_records(direction => 'both');
37
38   my @linked_invoices;
39
40   my $record_links = SL::DB::Manager::RecordLink->get_all(where => [ from_table => 'bank_transactions', from_id => $self->id ]);
41
42   foreach my $record_link (@{ $record_links }) {
43     push @linked_invoices, SL::DB::Manager::Invoice->find_by(id => $record_link->to_id)         if $record_link->to_table eq 'ar';
44     push @linked_invoices, SL::DB::Manager::PurchaseInvoice->find_by(id => $record_link->to_id) if $record_link->to_table eq 'ap';
45     push @linked_invoices, SL::DB::Manager::GLTransaction->find_by(id => $record_link->to_id)   if $record_link->to_table eq 'gl';
46   }
47
48   return [ @linked_invoices ];
49 }
50
51 sub is_batch_transaction {
52   ($_[0]->transaction_code // '') eq "191";
53 }
54
55
56 sub get_agreement_with_invoice {
57   my ($self, $invoice, %params) = @_;
58
59   carp "get_agreement_with_invoice needs an invoice object as its first argument"
60     unless ref($invoice) eq 'SL::DB::Invoice' or ref($invoice) eq 'SL::DB::PurchaseInvoice';
61
62   my %points = (
63     cust_vend_name_in_purpose   => 1,
64     cust_vend_number_in_purpose => 1,
65     datebonus0                  => 3,
66     datebonus14                 => 2,
67     datebonus35                 => 1,
68     datebonus120                => 0,
69     datebonus_negative          => -1,
70     depositor_matches           => 2,
71     exact_amount                => 4,
72     exact_open_amount           => 4,
73     invoice_in_purpose          => 2,
74     own_invoice_in_purpose      => 5,
75     invnumber_in_purpose        => 1,
76     own_invnumber_in_purpose    => 4,
77     # overpayment                 => -1, # either other invoice is more likely, or several invoices paid at once
78     payment_before_invoice      => -2,
79     payment_within_30_days      => 1,
80     remote_account_number       => 3,
81     skonto_exact_amount         => 5,
82     wrong_sign                  => -1,
83     sepa_export_item            => 5,
84     batch_sepa_transaction      => 20,
85   );
86
87   my ($agreement,$rule_matches);
88
89   if ( $self->is_batch_transaction && $self->{sepa_export_ok}) {
90     $agreement += $points{batch_sepa_transaction};
91     $rule_matches .= 'batch_sepa_transaction(' . $points{'batch_sepa_transaction'} . ') ';
92   }
93
94   # compare banking arrangements
95   my ($iban, $bank_code, $account_number);
96   $bank_code      = $invoice->customer->bank_code      if $invoice->is_sales;
97   $account_number = $invoice->customer->account_number if $invoice->is_sales;
98   $iban           = $invoice->customer->iban           if $invoice->is_sales;
99   $bank_code      = $invoice->vendor->bank_code        if ! $invoice->is_sales;
100   $iban           = $invoice->vendor->iban             if ! $invoice->is_sales;
101   $account_number = $invoice->vendor->account_number   if ! $invoice->is_sales;
102   if ( $bank_code eq $self->remote_bank_code && $account_number eq $self->remote_account_number ) {
103     $agreement += $points{remote_account_number};
104     $rule_matches .= 'remote_account_number(' . $points{'remote_account_number'} . ') ';
105   }
106   if ( $iban eq $self->remote_account_number ) {
107     $agreement += $points{remote_account_number};
108     $rule_matches .= 'remote_account_number(' . $points{'remote_account_number'} . ') ';
109   }
110
111   my $datediff = $self->transdate->{utc_rd_days} - $invoice->transdate->{utc_rd_days};
112   $invoice->{datediff} = $datediff;
113
114   # compare amount
115   if (abs(abs($invoice->amount) - abs($self->amount)) < 0.01 &&
116         $::form->format_amount(\%::myconfig,abs($invoice->amount),2) eq
117         $::form->format_amount(\%::myconfig,abs($self->amount),2)
118       ) {
119     $agreement += $points{exact_amount};
120     $rule_matches .= 'exact_amount(' . $points{'exact_amount'} . ') ';
121   }
122
123   # compare open amount, preventing double points when open amount = invoice amount
124   if ( $invoice->amount != $invoice->open_amount && abs(abs($invoice->open_amount) - abs($self->amount)) < 0.01 &&
125          $::form->format_amount(\%::myconfig,abs($invoice->amount_less_skonto),2) eq
126          $::form->format_amount(\%::myconfig,abs($self->amount),2)
127        ) {
128     $agreement += $points{exact_open_amount};
129     $rule_matches .= 'exact_open_amount(' . $points{'exact_open_amount'} . ') ';
130   }
131
132   if ( $invoice->skonto_date && abs(abs($invoice->amount_less_skonto) - abs($self->amount)) < 0.01 &&
133          $::form->format_amount(\%::myconfig,abs($invoice->amount_less_skonto),2) eq
134          $::form->format_amount(\%::myconfig,abs($self->amount),2)
135        ) {
136     $agreement += $points{skonto_exact_amount};
137     $rule_matches .= 'skonto_exact_amount(' . $points{'skonto_exact_amount'} . ') ';
138     $invoice->{skonto_type} = 'with_skonto_pt';
139   }
140
141   #search invoice number in purpose
142   my $invnumber = $invoice->invnumber;
143   # invnumber has to have at least 3 characters
144   my $squashed_purpose = $self->purpose;
145   $squashed_purpose =~ s/ //g;
146   if (length($invnumber) > 4 && $squashed_purpose =~ /$invnumber/ && $invoice->is_sales){
147     $agreement      += $points{own_invoice_in_purpose};
148     $rule_matches   .= 'own_invoice_in_purpose(' . $points{'own_invoice_in_purpose'} . ') ';
149   } elsif (length($invnumber) > 3 && $squashed_purpose =~ /$invnumber/ ) {
150     $agreement      += $points{invoice_in_purpose};
151     $rule_matches   .= 'invoice_in_purpose(' . $points{'invoice_in_purpose'} . ') ';
152   } else {
153     # only check number part of invoice number
154     $invnumber      =~ s/[A-Za-z_]+//g;
155     if (length($invnumber) > 4 && $squashed_purpose =~ /$invnumber/ && $invoice->is_sales){
156       $agreement    += $points{own_invnumber_in_purpose};
157       $rule_matches .= 'own_invnumber_in_purpose(' . $points{'own_invnumber_in_purpose'} . ') ';
158     } elsif (length($invnumber) > 3 && $squashed_purpose =~ /$invnumber/ ) {
159       $agreement    += $points{invnumber_in_purpose};
160       $rule_matches .= 'invnumber_in_purpose(' . $points{'invnumber_in_purpose'} . ') ';
161     }
162   }
163
164   #check sign
165   if ( $invoice->is_sales && $self->amount < 0 ) { # TODO debit note
166     $agreement += $points{wrong_sign};
167     $rule_matches .= 'wrong_sign(' . $points{'wrong_sign'} . ') ';
168   }
169   if (( !$invoice->is_sales && $invoice->amount > 0 && $self->amount > 0)  ||
170       ( !$invoice->is_sales && $invoice->amount < 0 && $self->amount < 0)     ) { # credit note
171     $agreement += $points{wrong_sign};
172     $rule_matches .= 'wrong_sign(' . $points{'wrong_sign'} . ') ';
173   }
174
175   # search customer/vendor number in purpose
176   my $cvnumber;
177   $cvnumber = $invoice->customer->customernumber if $invoice->is_sales;
178   $cvnumber = $invoice->vendor->vendornumber     if ! $invoice->is_sales;
179   if ( $cvnumber && $self->purpose =~ /\b$cvnumber\b/i ) {
180     $agreement += $points{cust_vend_number_in_purpose};
181     $rule_matches .= 'cust_vend_number_in_purpose(' . $points{'cust_vend_number_in_purpose'} . ') ';
182   }
183
184   # search for customer/vendor name in purpose (may contain GMBH, CO KG, ...)
185   my $cvname;
186   $cvname = $invoice->customer->name if $invoice->is_sales;
187   $cvname = $invoice->vendor->name   if ! $invoice->is_sales;
188   if ( $cvname && $self->purpose =~ /\b\Q$cvname\E\b/i ) {
189     $agreement += $points{cust_vend_name_in_purpose};
190     $rule_matches .= 'cust_vend_name_in_purpose(' . $points{'cust_vend_name_in_purpose'} . ') ';
191   }
192
193   # compare depositorname, don't try to match empty depositors
194   my $depositorname;
195   $depositorname = $invoice->customer->depositor if $invoice->is_sales;
196   $depositorname = $invoice->vendor->depositor   if ! $invoice->is_sales;
197   if ( $depositorname && $self->remote_name =~ /$depositorname/ ) {
198     $agreement += $points{depositor_matches};
199     $rule_matches .= 'depositor_matches(' . $points{'depositor_matches'} . ') ';
200   }
201
202   #Check if words in remote_name appear in cvname
203   my $check_string_points = _check_string($self->remote_name,$cvname);
204   if ( $check_string_points ) {
205     $agreement += $check_string_points;
206     $rule_matches .= 'remote_name(' . $check_string_points . ') ';
207   }
208
209   # transdate prefilter: compare transdate of bank_transaction with transdate of invoice
210   if ( $datediff < -5 ) { # this might conflict with advance payments
211     $agreement += $points{payment_before_invoice};
212     $rule_matches .= 'payment_before_invoice(' . $points{'payment_before_invoice'} . ') ';
213   }
214   if ( $datediff < 30 ) {
215     $agreement += $points{payment_within_30_days};
216     $rule_matches .= 'payment_within_30_days(' . $points{'payment_within_30_days'} . ') ';
217   }
218
219   # only if we already have a good agreement, let date further change value of agreement.
220   # this is so that if there are several plausible open invoices which are all equal
221   # (rent jan, rent feb...) the one with the best date match is chosen over
222   # the others
223
224   # another way around this is to just pre-filter by periods instead of matching everything
225   if ( $agreement > 5 ) {
226     if ( $datediff == 0 ) {
227       $agreement += $points{datebonus0};
228       $rule_matches .= 'datebonus0(' . $points{'datebonus0'} . ') ';
229     } elsif  ( $datediff > 0 and $datediff <= 14 ) {
230       $agreement += $points{datebonus14};
231       $rule_matches .= 'datebonus14(' . $points{'datebonus14'} . ') ';
232     } elsif  ( $datediff >14 and $datediff < 35) {
233       $agreement += $points{datebonus35};
234       $rule_matches .= 'datebonus35(' . $points{'datebonus35'} . ') ';
235     } elsif  ( $datediff >34 and $datediff < 120) {
236       $agreement += $points{datebonus120};
237       $rule_matches .= 'datebonus120(' . $points{'datebonus120'} . ') ';
238     } elsif  ( $datediff < 0 ) {
239       $agreement += $points{datebonus_negative};
240       $rule_matches .= 'datebonus_negative(' . $points{'datebonus_negative'} . ') ';
241     } else {
242       # e.g. datediff > 120
243     }
244   }
245
246   # if there is exactly one non-executed sepa_export_item for the invoice
247   my $seis = $params{sepa_export_items}
248            ? [ grep { $invoice->id == ($invoice->is_sales ? $_->ar_id : $_->ap_id) } @{ $params{sepa_export_items} } ]
249            : $invoice->find_sepa_export_items({ executed => 0 });
250   if ($seis) {
251     if (scalar @$seis == 1) {
252       my $sei = $seis->[0];
253
254       # test for amount and id matching only, sepa transfer date and bank
255       # transaction date needn't match
256       if (abs($self->amount) == ($sei->amount) && $invoice->id == $sei->arap_id) {
257         $agreement    += $points{sepa_export_item};
258         $rule_matches .= 'sepa_export_item(' . $points{'sepa_export_item'} . ') ';
259       }
260     } else {
261       # zero or more than one sepa_export_item, do nothing for this invoice
262       # zero: do nothing, no sepa_export_item exists, no match
263       # more than one: does this ever apply? Currently you can't create sepa
264       # exports for invoices that already have a non-executed sepa_export
265       # TODO: Catch the more than one case. User is allowed to split
266       # payments for one invoice item in one sepa export.
267     }
268   }
269
270   return ($agreement,$rule_matches);
271 };
272
273 sub _check_string {
274     my $bankstring = shift;
275     my $namestring = shift;
276     return 0 unless $bankstring and $namestring;
277
278     my @bankwords = grep(/^\w+$/, split(/\b/,$bankstring));
279
280     my $match = 0;
281     foreach my $bankword ( @bankwords ) {
282         # only try to match strings with more than 2 characters
283         next unless length($bankword)>2;
284         if ( $namestring =~ /\b$bankword\b/i ) {
285             $match++;
286         };
287     };
288     return $match;
289 };
290
291
292 sub not_assigned_amount {
293   my ($self) = @_;
294
295   my $not_assigned_amount = $self->amount - $self->invoice_amount;
296   die ("undefined state") if (abs($not_assigned_amount) > abs($self->amount));
297
298   return $not_assigned_amount;
299
300 }
301 sub closed_period {
302   my ($self) = @_;
303
304   # check for closed period
305   croak t8('Illegal date') unless ref $self->valutadate eq 'DateTime';
306
307
308   my $closedto = $::locale->parse_date_to_object($::instance_conf->get_closedto);
309   if ( ref $closedto && $self->valutadate < $closedto ) {
310     return 1;
311   } else {
312     return 0;
313   }
314 }
315 1;
316
317 __END__
318
319 =pod
320
321 =head1 NAME
322
323 SL::DB::BankTransaction
324
325 =head1 FUNCTIONS
326
327 =over 4
328
329 =item C<get_agreement_with_invoice $invoice>
330
331 Using a point system this function checks whether the bank transaction matches
332 an invoices, using a variety of tests, such as
333
334 =over 2
335
336 =item * amount
337
338 =item * amount_less_skonto
339
340 =item * payment date
341
342 =item * invoice number in purpose
343
344 =item * customer or vendor name in purpose
345
346 =item * account number matches account number of customer or vendor
347
348 =back
349
350 The total number of points, and the rules that matched, are returned.
351
352 Example:
353   my $bt      = SL::DB::Manager::BankTransaction->find_by(id => 522);
354   my $invoice = SL::DB::Manager::Invoice->find_by(invnumber => '198');
355   my ($agreement,rule_matches) = $bt->get_agreement_with_invoice($invoice);
356
357 =item C<linked_invoices>
358
359 Returns an array of record objects (invoices, debit, credit or gl objects)
360 which are linked for this bank transaction.
361
362 Returns an empty array ref if no links are found.
363 Usage:
364  croak("No linked records at all") unless @{ $bt->linked_invoices() };
365
366
367 =item C<not_assigned_amount>
368
369 Returns the not open amount of this bank transaction.
370 Dies if the return amount is higher than the original amount.
371
372 =item C<closed_period>
373
374 Returns 1 if the bank transaction valutadate is in a closed period, 0 if the
375 valutadate of the bank transaction is not in a closed period.
376
377 =back
378
379 =head1 AUTHOR
380
381 G. Richardson E<lt>grichardson@kivitendo-premium.de<gt>
382
383 =cut