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