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