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