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                  => -4,
  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->open_amount),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 && $invoice->amount > 0 && $self->amount < 0 ) ||
 166       ( $invoice->is_sales && $invoice->amount < 0 && $self->amount > 0 )     ) { # sales credit note
 167     $agreement += $points{wrong_sign};
 168     $rule_matches .= 'wrong_sign(' . $points{'wrong_sign'} . ') ';
 169   }
 170   if (( !$invoice->is_sales && $invoice->amount > 0 && $self->amount > 0)  ||
 171       ( !$invoice->is_sales && $invoice->amount < 0 && $self->amount < 0)     ) { # purchase credit note
 172     $agreement += $points{wrong_sign};
 173     $rule_matches .= 'wrong_sign(' . $points{'wrong_sign'} . ') ';
 174   }
 175
 176   # search customer/vendor number in purpose
 177   my $cvnumber;
 178   $cvnumber = $invoice->customer->customernumber if $invoice->is_sales;
 179   $cvnumber = $invoice->vendor->vendornumber     if ! $invoice->is_sales;
 180   if ( $cvnumber && $self->purpose =~ /\b$cvnumber\b/i ) {
 181     $agreement += $points{cust_vend_number_in_purpose};
 182     $rule_matches .= 'cust_vend_number_in_purpose(' . $points{'cust_vend_number_in_purpose'} . ') ';
 183   }
 184
 185   # search for customer/vendor name in purpose (may contain GMBH, CO KG, ...)
 186   my $cvname;
 187   $cvname = $invoice->customer->name if $invoice->is_sales;
 188   $cvname = $invoice->vendor->name   if ! $invoice->is_sales;
 189   if ( $cvname && $self->purpose =~ /\b\Q$cvname\E\b/i ) {
 190     $agreement += $points{cust_vend_name_in_purpose};
 191     $rule_matches .= 'cust_vend_name_in_purpose(' . $points{'cust_vend_name_in_purpose'} . ') ';
 192   }
 193
 194   # compare depositorname, don't try to match empty depositors
 195   my $depositorname;
 196   $depositorname = $invoice->customer->depositor if $invoice->is_sales;
 197   $depositorname = $invoice->vendor->depositor   if ! $invoice->is_sales;
 198   if ( $depositorname && $self->remote_name =~ /$depositorname/ ) {
 199     $agreement += $points{depositor_matches};
 200     $rule_matches .= 'depositor_matches(' . $points{'depositor_matches'} . ') ';
 201   }
 202
 203   #Check if words in remote_name appear in cvname
 204   my $check_string_points = _check_string($self->remote_name,$cvname);
 205   if ( $check_string_points ) {
 206     $agreement += $check_string_points;
 207     $rule_matches .= 'remote_name(' . $check_string_points . ') ';
 208   }
 209
 210   # transdate prefilter: compare transdate of bank_transaction with transdate of invoice
 211   if ( $datediff < -5 ) { # this might conflict with advance payments
 212     $agreement += $points{payment_before_invoice};
 213     $rule_matches .= 'payment_before_invoice(' . $points{'payment_before_invoice'} . ') ';
 214   }
 215   if ( $datediff < 30 ) {
 216     $agreement += $points{payment_within_30_days};
 217     $rule_matches .= 'payment_within_30_days(' . $points{'payment_within_30_days'} . ') ';
 218   }
 219
 220   # only if we already have a good agreement, let date further change value of agreement.
 221   # this is so that if there are several plausible open invoices which are all equal
 222   # (rent jan, rent feb...) the one with the best date match is chosen over
 223   # the others
 224
 225   # another way around this is to just pre-filter by periods instead of matching everything
 226   if ( $agreement > 5 ) {
 227     if ( $datediff == 0 ) {
 228       $agreement += $points{datebonus0};
 229       $rule_matches .= 'datebonus0(' . $points{'datebonus0'} . ') ';
 230     } elsif  ( $datediff > 0 and $datediff <= 14 ) {
 231       $agreement += $points{datebonus14};
 232       $rule_matches .= 'datebonus14(' . $points{'datebonus14'} . ') ';
 233     } elsif  ( $datediff >14 and $datediff < 35) {
 234       $agreement += $points{datebonus35};
 235       $rule_matches .= 'datebonus35(' . $points{'datebonus35'} . ') ';
 236     } elsif  ( $datediff >34 and $datediff < 120) {
 237       $agreement += $points{datebonus120};
 238       $rule_matches .= 'datebonus120(' . $points{'datebonus120'} . ') ';
 239     } elsif  ( $datediff < 0 ) {
 240       $agreement += $points{datebonus_negative};
 241       $rule_matches .= 'datebonus_negative(' . $points{'datebonus_negative'} . ') ';
 242     } else {
 243       # e.g. datediff > 120
 244     }
 245   }
 246
 247   # if there is exactly one non-executed sepa_export_item for the invoice
 248   my $seis = $params{sepa_export_items}
 249            ? [ grep { $invoice->id == ($invoice->is_sales ? $_->ar_id : $_->ap_id) } @{ $params{sepa_export_items} } ]
 250            : $invoice->find_sepa_export_items({ executed => 0 });
 251   if ($seis) {
 252     if (scalar @$seis == 1) {
 253       my $sei = $seis->[0];
 254
 255       # test for amount and id matching only, sepa transfer date and bank
 256       # transaction date needn't match
 257       if (abs($self->amount) == ($sei->amount) && $invoice->id == $sei->arap_id) {
 258         $agreement    += $points{sepa_export_item};
 259         $rule_matches .= 'sepa_export_item(' . $points{'sepa_export_item'} . ') ';
 260       }
 261     } else {
 262       # zero or more than one sepa_export_item, do nothing for this invoice
 263       # zero: do nothing, no sepa_export_item exists, no match
 264       # more than one: does this ever apply? Currently you can't create sepa
 265       # exports for invoices that already have a non-executed sepa_export
 266       # TODO: Catch the more than one case. User is allowed to split
 267       # payments for one invoice item in one sepa export.
 268     }
 269   }
 270
 271   return ($agreement,$rule_matches);
 272 };
 273
 274 sub _check_string {
 275     my $bankstring = shift;
 276     my $namestring = shift;
 277     return 0 unless $bankstring and $namestring;
 278
 279     my @bankwords = grep(/^\w+$/, split(/\b/,$bankstring));
 280
 281     my $match = 0;
 282     foreach my $bankword ( @bankwords ) {
 283         # only try to match strings with more than 2 characters
 284         next unless length($bankword)>2;
 285         if ( $namestring =~ /\b$bankword\b/i ) {
 286             $match++;
 287         };
 288     };
 289     return $match;
 290 };
 291
 292
 293 sub not_assigned_amount {
 294   my ($self) = @_;
 295
 296   my $not_assigned_amount = $self->amount - $self->invoice_amount;
 297   die ("undefined state") if (abs($not_assigned_amount) > abs($self->amount));
 298
 299   return $not_assigned_amount;
 300
 301 }
 302 sub closed_period {
 303   my ($self) = @_;
 304
 305   # check for closed period
 306   croak t8('Illegal date') unless ref $self->valutadate eq 'DateTime';
 307
 308
 309   my $closedto = $::locale->parse_date_to_object($::instance_conf->get_closedto);
 310   if ( ref $closedto && $self->valutadate < $closedto ) {
 311     return 1;
 312   } else {
 313     return 0;
 314   }
 315 }
 316 1;
 317
 318 __END__
 319
 320 =pod
 321
 322 =head1 NAME
 323
 324 SL::DB::BankTransaction
 325
 326 =head1 FUNCTIONS
 327
 328 =over 4
 329
 330 =item C<get_agreement_with_invoice $invoice>
 331
 332 Using a point system this function checks whether the bank transaction matches
 333 an invoices, using a variety of tests, such as
 334
 335 =over 2
 336
 337 =item * amount
 338
 339 =item * amount_less_skonto
 340
 341 =item * payment date
 342
 343 =item * invoice number in purpose
 344
 345 =item * customer or vendor name in purpose
 346
 347 =item * account number matches account number of customer or vendor
 348
 349 =back
 350
 351 The total number of points, and the rules that matched, are returned.
 352
 353 Example:
 354   my $bt      = SL::DB::Manager::BankTransaction->find_by(id => 522);
 355   my $invoice = SL::DB::Manager::Invoice->find_by(invnumber => '198');
 356   my ($agreement,rule_matches) = $bt->get_agreement_with_invoice($invoice);
 357
 358 =item C<linked_invoices>
 359
 360 Returns an array of record objects (invoices, debit, credit or gl objects)
 361 which are linked for this bank transaction.
 362
 363 Returns an empty array ref if no links are found.
 364 Usage:
 365  croak("No linked records at all") unless @{ $bt->linked_invoices() };
 366
 367
 368 =item C<not_assigned_amount>
 369
 370 Returns the not open amount of this bank transaction.
 371 Dies if the return amount is higher than the original amount.
 372
 373 =item C<closed_period>
 374
 375 Returns 1 if the bank transaction valutadate is in a closed period, 0 if the
 376 valutadate of the bank transaction is not in a closed period.
 377
 378 =back
 379
 380 =head1 AUTHOR
 381
 382 G. Richardson E<lt>grichardson@kivitendo-premium.de<gt>
 383
 384 =cut