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