doc/ Trigram Erweiterung als Musskriterium für das Upgrade genannt
[kivitendo-erp.git] / SL / SEPA.pm
1 package SL::SEPA;
2
3 use strict;
4
5 use POSIX qw(strftime);
6
7 use Data::Dumper;
8 use SL::DBUtils;
9 use SL::DB::Invoice;
10 use SL::DB::PurchaseInvoice;
11 use SL::DB;
12 use SL::Locale::String qw(t8);
13 use DateTime;
14 use Carp;
15
16 sub retrieve_open_invoices {
17   $main::lxdebug->enter_sub();
18
19   my $self     = shift;
20   my %params   = @_;
21
22   my $myconfig = \%main::myconfig;
23   my $form     = $main::form;
24
25   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
26   my $arap     = $params{vc} eq 'customer' ? 'ar'       : 'ap';
27   my $vc       = $params{vc} eq 'customer' ? 'customer' : 'vendor';
28   my $vc_vc_id = $params{vc} eq 'customer' ? 'c_vendor_id' : 'v_customer_id';
29
30   my $mandate  = $params{vc} eq 'customer' ? " AND COALESCE(vc.mandator_id, '') <> '' AND vc.mandate_date_of_signature IS NOT NULL " : '';
31
32   # in query: for customers, use payment terms from invoice, for vendors use
33   # payment terms from vendor settings
34   # currently there is no option in vendor invoices for setting payment terms,
35   # so the vendor settings are always used
36
37   my $payment_term_type = $params{vc} eq 'customer' ? "${arap}" : 'vc';
38
39   # open_amount is not the current open amount according to bookkeeping, but
40   # the open amount minus the SEPA transfer amounts that haven't been closed yet
41   my $query =
42     qq|
43        SELECT ${arap}.id, ${arap}.invnumber, ${arap}.transdate, ${arap}.${vc}_id as vc_id, ${arap}.amount AS invoice_amount, ${arap}.invoice,
44          (${arap}.transdate + pt.terms_skonto) as skonto_date, (pt.percent_skonto * 100) as percent_skonto,
45          (${arap}.amount - (${arap}.amount * pt.percent_skonto)) as amount_less_skonto,
46          (${arap}.amount * pt.percent_skonto) as skonto_amount,
47          vc.name AS vcname, vc.language_id, ${arap}.duedate as duedate, ${arap}.direct_debit,
48          vc.${vc_vc_id} as vc_vc_id,
49
50          COALESCE(vc.iban, '') <> '' AND COALESCE(vc.bic, '') <> '' ${mandate} AS vc_bank_info_ok,
51
52          ${arap}.amount - ${arap}.paid - COALESCE(open_transfers.amount, 0) AS open_amount,
53          COALESCE(open_transfers.amount, 0) AS transfer_amount,
54          pt.description as pt_description
55
56        FROM ${arap}
57        LEFT JOIN ${vc} vc ON (${arap}.${vc}_id = vc.id)
58        LEFT JOIN (SELECT sei.${arap}_id, SUM(sei.amount) + SUM(COALESCE(sei.skonto_amount,0)) AS amount
59                   FROM sepa_export_items sei
60                   LEFT JOIN sepa_export se ON (sei.sepa_export_id = se.id)
61                   WHERE NOT se.closed
62                     AND (se.vc = '${vc}')
63                   GROUP BY sei.${arap}_id)
64          AS open_transfers ON (${arap}.id = open_transfers.${arap}_id)
65
66        LEFT JOIN payment_terms pt ON (${payment_term_type}.payment_id = pt.id)
67
68        WHERE ${arap}.amount > (COALESCE(open_transfers.amount, 0) + ${arap}.paid)
69
70        ORDER BY lower(vc.name) ASC, lower(${arap}.invnumber) ASC
71 |;
72     #  $main::lxdebug->message(LXDebug->DEBUG2(),"sepa add query:".$query);
73
74   my $results = selectall_hashref_query($form, $dbh, $query);
75
76   # add some more data to $results:
77   # create drop-down data for payment types and suggest amount to be paid according
78   # to open amount or skonto
79
80   foreach my $result ( @$results ) {
81     my $invoice = $vc eq 'customer' ? SL::DB::Manager::Invoice->find_by(         id => $result->{id} )
82                                     : SL::DB::Manager::PurchaseInvoice->find_by( id => $result->{id} );
83
84     $invoice->get_payment_suggestions(sepa => 1); # consider amounts of open entries in sepa_export_items
85     $result->{skonto_amount}             = $invoice->skonto_amount;
86     $result->{within_skonto_period}      = $invoice->within_skonto_period;
87     $result->{invoice_amount_suggestion} = $invoice->{invoice_amount_suggestion};
88     $result->{payment_select_options}    = $invoice->{payment_select_options};
89   };
90
91   $main::lxdebug->leave_sub();
92
93   return $results;
94 }
95
96 sub create_export {
97   my ($self, %params) = @_;
98   $main::lxdebug->enter_sub();
99
100   my $rc = SL::DB->client->with_transaction(\&_create_export, $self, %params);
101
102   $::lxdebug->leave_sub;
103   return $rc;
104 }
105
106 sub _create_export {
107   my $self     = shift;
108   my %params   = @_;
109
110   Common::check_params(\%params, qw(employee bank_transfers vc));
111
112   my $myconfig = \%main::myconfig;
113   my $form     = $main::form;
114   my $arap     = $params{vc} eq 'customer' ? 'ar'       : 'ap';
115   my $vc       = $params{vc} eq 'customer' ? 'customer' : 'vendor';
116   my $ARAP     = uc $arap;
117
118   my $dbh      = $params{dbh} || SL::DB->client->dbh;
119
120   my ($export_id) = selectfirst_array_query($form, $dbh, qq|SELECT nextval('sepa_export_id_seq')|);
121   my $query       =
122     qq|INSERT INTO sepa_export (id, employee_id, vc)
123        VALUES (?, (SELECT id
124                    FROM employee
125                    WHERE login = ?), ?)|;
126   do_query($form, $dbh, $query, $export_id, $params{employee}, $vc);
127
128   my $q_item_id = qq|SELECT nextval('id')|;
129   my $h_item_id = prepare_query($form, $dbh, $q_item_id);
130   my $c_mandate = $params{vc} eq 'customer' ? ', vc_mandator_id, vc_mandate_date_of_signature' : '';
131   my $p_mandate = $params{vc} eq 'customer' ? ', ?, ?' : '';
132
133   my $q_insert =
134     qq|INSERT INTO sepa_export_items (id,          sepa_export_id,           ${arap}_id,  chart_id,
135                                       amount,      requested_execution_date, reference,   end_to_end_id,
136                                       our_iban,    our_bic,                  vc_iban,     vc_bic,
137                                       skonto_amount, payment_type ${c_mandate})
138        VALUES                        (?,           ?,                        ?,           ?,
139                                       ?,           ?,                        ?,           ?,
140                                       ?,           ?,                        ?,           ?,
141                                       ?,           ? ${p_mandate})|;
142   my $h_insert = prepare_query($form, $dbh, $q_insert);
143
144   my $q_reference =
145     qq|SELECT arap.invnumber,
146          (SELECT COUNT(at.*)
147           FROM acc_trans at
148           LEFT JOIN chart c ON (at.chart_id = c.id)
149           WHERE (at.trans_id = ?)
150             AND (c.link LIKE '%${ARAP}_paid%'))
151          +
152          (SELECT COUNT(sei.*)
153           FROM sepa_export_items sei
154           WHERE (sei.ap_id = ?))
155          AS num_payments
156        FROM ${arap} arap
157        WHERE id = ?|;
158   my $h_reference = prepare_query($form, $dbh, $q_reference);
159
160   my @now         = localtime;
161
162   foreach my $transfer (@{ $params{bank_transfers} }) {
163     if (!$transfer->{reference}) {
164       do_statement($form, $h_reference, $q_reference, (conv_i($transfer->{"${arap}_id"})) x 3);
165
166       my ($invnumber, $num_payments) = $h_reference->fetchrow_array();
167       $num_payments++;
168
169       $transfer->{reference} = "${invnumber}-${num_payments}";
170     }
171
172     $h_item_id->execute() || $::form->dberror($q_item_id);
173     my ($item_id)      = $h_item_id->fetchrow_array();
174
175     my $end_to_end_id  = strftime "LXO%Y%m%d%H%M%S", localtime;
176     my $item_id_len    = length "$item_id";
177     my $num_zeroes     = 35 - $item_id_len - length $end_to_end_id;
178     $end_to_end_id    .= '0' x $num_zeroes if (0 < $num_zeroes);
179     $end_to_end_id    .= $item_id;
180     $end_to_end_id     = substr $end_to_end_id, 0, 35;
181
182     my @values = ($item_id,                          $export_id,
183                   conv_i($transfer->{"${arap}_id"}), conv_i($transfer->{chart_id}),
184                   $transfer->{amount},               conv_date($transfer->{requested_execution_date}),
185                   $transfer->{reference},            $end_to_end_id,
186                   map { my $pfx = $_; map { $transfer->{"${pfx}_${_}"} } qw(iban bic) } qw(our vc));
187     # save value of skonto_amount and payment_type
188     if ( $transfer->{payment_type} eq 'without_skonto' ) {
189       push(@values, 0);
190     } elsif ($transfer->{payment_type} eq 'difference_as_skonto' ) {
191       push(@values, $transfer->{amount});
192     } elsif ($transfer->{payment_type} eq 'with_skonto_pt' ) {
193       push(@values, $transfer->{skonto_amount});
194     } else {
195       die "illegal payment_type: " . $transfer->{payment_type} . "\n";
196     };
197     push(@values, $transfer->{payment_type});
198
199     push @values, $transfer->{vc_mandator_id}, conv_date($transfer->{vc_mandate_date_of_signature}) if $params{vc} eq 'customer';
200
201     do_statement($form, $h_insert, $q_insert, @values);
202   }
203
204   $h_insert->finish();
205   $h_item_id->finish();
206
207   return $export_id;
208 }
209
210 sub retrieve_export {
211   $main::lxdebug->enter_sub();
212
213   my $self     = shift;
214   my %params   = @_;
215
216   Common::check_params(\%params, qw(id vc));
217
218   my $myconfig = \%main::myconfig;
219   my $form     = $main::form;
220   my $vc       = $params{vc} eq 'customer' ? 'customer' : 'vendor';
221   my $arap     = $params{vc} eq 'customer' ? 'ar'       : 'ap';
222
223   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
224
225   my ($joins, $columns);
226
227   if ($params{details}) {
228     $columns = ', arap.invoice';
229     $joins   = "LEFT JOIN ${arap} arap ON (se.${arap}_id = arap.id)";
230   }
231
232   my $query =
233     qq|SELECT se.*,
234          CASE WHEN COALESCE(e.name, '') <> '' THEN e.name ELSE e.login END AS employee
235        FROM sepa_export se
236        LEFT JOIN employee e ON (se.employee_id = e.id)
237        WHERE se.id = ?|;
238
239   my $export = selectfirst_hashref_query($form, $dbh, $query, conv_i($params{id}));
240
241   if ($export->{id}) {
242     my ($columns, $joins);
243
244     my $mandator_id = $params{vc} eq 'customer' ? ', mandator_id, mandate_date_of_signature' : '';
245
246     if ($params{details}) {
247       $columns = qq|, arap.invnumber, arap.invoice, arap.transdate AS reference_date, vc.name AS vc_name, vc.${vc}number AS vc_number, c.accno AS chart_accno, c.description AS chart_description ${mandator_id}|;
248       $joins   = qq|LEFT JOIN ${arap} arap ON (sei.${arap}_id = arap.id)
249                     LEFT JOIN ${vc} vc     ON (arap.${vc}_id  = vc.id)
250                     LEFT JOIN chart c      ON (sei.chart_id   = c.id)|;
251     }
252
253     $query = qq|SELECT sei.*
254                   $columns
255                 FROM sepa_export_items sei
256                 $joins
257                 WHERE sei.sepa_export_id = ?|;
258
259     $export->{items} = selectall_hashref_query($form, $dbh, $query, conv_i($params{id}));
260
261   } else {
262     $export->{items} = [];
263   }
264
265   $main::lxdebug->leave_sub();
266
267   return $export;
268 }
269
270 sub close_export {
271   $main::lxdebug->enter_sub();
272
273   my $self     = shift;
274   my %params   = @_;
275
276   Common::check_params(\%params, qw(id));
277
278   my $myconfig = \%main::myconfig;
279   my $form     = $main::form;
280
281   SL::DB->client->with_transaction(sub {
282     my $dbh      = $params{dbh} || SL::DB->client->dbh;
283
284     my @ids          = ref $params{id} eq 'ARRAY' ? @{ $params{id} } : ($params{id});
285     my $placeholders = join ', ', ('?') x scalar @ids;
286     my $query        = qq|UPDATE sepa_export SET closed = TRUE WHERE id IN ($placeholders)|;
287
288     do_query($form, $dbh, $query, map { conv_i($_) } @ids);
289     1;
290   }) or do { die SL::DB->client->error };
291
292   $main::lxdebug->leave_sub();
293 }
294
295 sub undo_export {
296   $main::lxdebug->enter_sub();
297
298   my $self     = shift;
299   my %params   = @_;
300
301   Common::check_params(\%params, qw(id));
302
303   my $sepa_export = SL::DB::Manager::SepaExport->find_by(id => $params{id});
304
305   croak "Not a valid SEPA Export id: $params{id}" unless $sepa_export;
306   croak "Cannot undo closed exports."             if $sepa_export->closed;
307   croak "Cannot undo executed exports."           if $sepa_export->executed;
308
309   die "Could not undo $sepa_export->id" if !$sepa_export->delete();
310
311   $main::lxdebug->leave_sub();
312 }
313
314 sub list_exports {
315   $main::lxdebug->enter_sub();
316
317   my $self     = shift;
318   my %params   = @_;
319
320   my $myconfig = \%main::myconfig;
321   my $form     = $main::form;
322   my $vc       = $params{vc} eq 'customer' ? 'customer' : 'vendor';
323   my $arap     = $params{vc} eq 'customer' ? 'ar'       : 'ap';
324
325   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
326
327   my %sort_columns = (
328     'id'          => [ 'se.id',                ],
329     'export_date' => [ 'se.itime',             ],
330     'employee'    => [ 'e.name',      'se.id', ],
331     'executed'    => [ 'se.executed', 'se.id', ],
332     'closed'      => [ 'se.closed',   'se.id', ],
333     );
334
335   my %sort_spec = create_sort_spec('defs' => \%sort_columns, 'default' => 'id', 'column' => $params{sortorder}, 'dir' => $params{sortdir});
336
337   my (@where, @values, @where_sub, @values_sub, %joins_sub);
338
339   my $filter = $params{filter} || { };
340
341   foreach (qw(executed closed)) {
342     push @where, $filter->{$_} ? "se.$_" : "NOT se.$_" if (exists $filter->{$_});
343   }
344
345   my %operators = ('from' => '>=',
346                    'to'   => '<=');
347
348   foreach my $dir (qw(from to)) {
349     next unless ($filter->{"export_date_${dir}"});
350     push @where,  "se.itime $operators{$dir} ?::date";
351     push @values, $filter->{"export_date_${dir}"};
352   }
353
354   if ($filter->{invnumber}) {
355     push @where_sub,  "arap.invnumber ILIKE ?";
356     push @values_sub, like($filter->{invnumber});
357     $joins_sub{$arap} = 1;
358   }
359
360   if ($filter->{message_id}) {
361     push @values, like($filter->{message_id});
362     push @where,  <<SQL;
363       se.id IN (
364         SELECT sepa_export_id
365         FROM sepa_export_message_ids
366         WHERE message_id ILIKE ?
367       )
368 SQL
369   }
370
371   if ($filter->{vc}) {
372     push @where_sub,  "vc.name ILIKE ?";
373     push @values_sub, like($filter->{vc});
374     $joins_sub{$arap} = 1;
375     $joins_sub{vc}    = 1;
376   }
377
378   foreach my $type (qw(requested_execution execution)) {
379     foreach my $dir (qw(from to)) {
380       next unless ($filter->{"${type}_date_${dir}"});
381       push @where_sub,  "(items.${type}_date IS NOT NULL) AND (items.${type}_date $operators{$dir} ?)";
382       push @values_sub, $filter->{"${type}_date_${_}"};
383     }
384   }
385
386   if (@where_sub) {
387     my $joins_sub  = '';
388     $joins_sub    .= " LEFT JOIN ${arap} arap ON (items.${arap}_id = arap.id)" if ($joins_sub{$arap});
389     $joins_sub    .= " LEFT JOIN ${vc} vc      ON (arap.${vc}_id   = vc.id)"   if ($joins_sub{vc});
390
391     my $where_sub  = join(' AND ', map { "(${_})" } @where_sub);
392
393     my $query_sub  = qq|se.id IN (SELECT items.sepa_export_id
394                                   FROM sepa_export_items items
395                                   $joins_sub
396                                   WHERE $where_sub)|;
397
398     push @where,  $query_sub;
399     push @values, @values_sub;
400   }
401
402   push @where,  'se.vc = ?';
403   push @values, $vc;
404
405   my $where = @where ? ' WHERE ' . join(' AND ', map { "(${_})" } @where) : '';
406
407   my $query =
408     qq|SELECT se.id, se.employee_id, se.executed, se.closed, itime::date AS export_date,
409          (SELECT COUNT(*)
410           FROM sepa_export_items sei
411           WHERE (sei.sepa_export_id = se.id)) AS num_invoices,
412          (SELECT SUM(sei.amount)
413           FROM sepa_export_items sei
414           WHERE (sei.sepa_export_id = se.id)) AS sum_amounts,
415          (SELECT string_agg(semi.message_id, ', ')
416           FROM sepa_export_message_ids semi
417           WHERE semi.sepa_export_id = se.id) AS message_ids,
418          e.name AS employee
419        FROM sepa_export se
420        LEFT JOIN (
421          SELECT emp.id,
422            CASE WHEN COALESCE(emp.name, '') <> '' THEN emp.name ELSE emp.login END AS name
423          FROM employee emp
424        ) AS e ON (se.employee_id = e.id)
425        $where
426        ORDER BY $sort_spec{sql}|;
427
428   my $results = selectall_hashref_query($form, $dbh, $query, @values);
429
430   $main::lxdebug->leave_sub();
431
432   return $results;
433 }
434
435 sub post_payment {
436   my ($self, %params) = @_;
437   $main::lxdebug->enter_sub();
438
439   my $rc = SL::DB->client->with_transaction(\&_post_payment, $self, %params);
440
441   $::lxdebug->leave_sub;
442   return $rc;
443 }
444
445 sub _post_payment {
446   my $self     = shift;
447   my %params   = @_;
448
449   Common::check_params(\%params, qw(items));
450
451   my $myconfig = \%main::myconfig;
452   my $form     = $main::form;
453   my $vc       = $params{vc} eq 'customer' ? 'customer' : 'vendor';
454   my $arap     = $params{vc} eq 'customer' ? 'ar'       : 'ap';
455   my $mult     = $params{vc} eq 'customer' ? -1         : 1;
456   my $ARAP     = uc $arap;
457
458   my $dbh      = $params{dbh} || SL::DB->client->dbh;
459
460   my @items    = ref $params{items} eq 'ARRAY' ? @{ $params{items} } : ($params{items});
461
462   my %handles  = (
463     'get_item'       => [ qq|SELECT sei.*
464                              FROM sepa_export_items sei
465                              WHERE sei.id = ?| ],
466
467     'get_arap'       => [ qq|SELECT at.chart_id
468                              FROM acc_trans at
469                              LEFT JOIN chart c ON (at.chart_id = c.id)
470                              WHERE (trans_id = ?)
471                                AND ((c.link LIKE '%:${ARAP}') OR (c.link LIKE '${ARAP}:%') OR (c.link = '${ARAP}'))
472                              LIMIT 1| ],
473
474     'add_acc_trans'  => [ qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, gldate,       source, memo, taxkey, tax_id ,                                     chart_link)
475                              VALUES                (?,        ?,        ?,      ?,         current_date, ?,      '',   0,      (SELECT id FROM tax WHERE taxkey=0 LIMIT 1), (SELECT link FROM chart WHERE id=?))| ],
476
477     'update_arap'    => [ qq|UPDATE ${arap}
478                              SET paid = paid + ?
479                              WHERE id = ?| ],
480
481     'finish_item'    => [ qq|UPDATE sepa_export_items
482                              SET execution_date = ?, executed = TRUE
483                              WHERE id = ?| ],
484
485     'has_unexecuted' => [ qq|SELECT sei1.id
486                              FROM sepa_export_items sei1
487                              WHERE (sei1.sepa_export_id = (SELECT sei2.sepa_export_id
488                                                            FROM sepa_export_items sei2
489                                                            WHERE sei2.id = ?))
490                                AND NOT COALESCE(sei1.executed, FALSE)
491                              LIMIT 1| ],
492
493     'do_close'       => [ qq|UPDATE sepa_export
494                              SET executed = TRUE, closed = TRUE
495                              WHERE (id = ?)| ],
496     );
497
498   map { unshift @{ $_ }, prepare_query($form, $dbh, $_->[0]) } values %handles;
499
500   foreach my $item (@items) {
501
502     my $item_id = conv_i($item->{id});
503
504     # Retrieve the item data belonging to the ID.
505     do_statement($form, @{ $handles{get_item} }, $item_id);
506     my $orig_item = $handles{get_item}->[0]->fetchrow_hashref();
507
508     next if (!$orig_item);
509
510     # fetch item_id via Rose (same id as orig_item)
511     my $sepa_export_item = SL::DB::Manager::SepaExportItem->find_by( id => $item_id);
512
513     my $invoice;
514
515     if ( $sepa_export_item->ar_id ) {
516       $invoice = SL::DB::Manager::Invoice->find_by( id => $sepa_export_item->ar_id);
517     } elsif ( $sepa_export_item->ap_id ) {
518       $invoice = SL::DB::Manager::PurchaseInvoice->find_by( id => $sepa_export_item->ap_id);
519     } else {
520       die "sepa_export_item needs either ar_id or ap_id\n";
521     };
522
523     $invoice->pay_invoice(amount       => $sepa_export_item->amount,
524                           payment_type => $sepa_export_item->payment_type,
525                           chart_id     => $sepa_export_item->chart_id,
526                           source       => $sepa_export_item->reference,
527                           transdate    => $item->{execution_date},  # value from user form
528                          );
529
530     # Update the item to reflect that it has been posted.
531     do_statement($form, @{ $handles{finish_item} }, $item->{execution_date}, $item_id);
532
533     # Check whether or not we can close the export itself if there are no unexecuted items left.
534     do_statement($form, @{ $handles{has_unexecuted} }, $item_id);
535     my ($has_unexecuted) = $handles{has_unexecuted}->[0]->fetchrow_array();
536
537     if (!$has_unexecuted) {
538       do_statement($form, @{ $handles{do_close} }, $orig_item->{sepa_export_id});
539     }
540   }
541
542   map { $_->[0]->finish() } values %handles;
543
544   return 1;
545 }
546
547 1;
548
549
550 __END__
551
552 =head1 NAME
553
554 SL::SEPA - Base class for SEPA objects
555
556 =head1 SYNOPSIS
557
558  # get all open invoices we like to pay via SEPA
559  my $invoices = SL::SEPA->retrieve_open_invoices(vc => 'vendor');
560
561  # add some IBAN and purposes for open transaction
562  # and assign this to a SEPA export
563  my $id = SL::SEPA->create_export('employee'       => $::myconfig{login},
564                                  'bank_transfers' => \@bank_transfers,
565                                  'vc'             => 'vendor');
566
567 =head1 DESCRIPTIONS
568
569 This is the base class for SEPA. SEPA and the underlying directories
570 (SEPA::XML etc) are used to genereate valid XML files for the SEPA
571 (Single European Payment Area) specification and offers this structure
572 as a download via a xml file.
573
574 An export can have one or more transaction which have to
575 comply to the specification (IBAN, BIC, amount, purpose, etc).
576
577 Furthermore kivitendo sepa exports have two
578 valid states: Open or closed and executed or not executed.
579
580 The state closed can be set via a user interface and the
581 state executed is automatically assigned if the action payment
582 is triggered.
583
584 =head1 FUNCTIONS
585
586 =head2 C<undo_export> $sepa_export_id
587
588 Needs a valid sepa_export id and deletes the sepa export if
589 the state of the export is neither executed nor closed.
590 Returns undef if the deletion was successfully.
591 Otherwise the function just dies with a short notice of the id.
592
593 =cut
594
595
596
597