SL/BackgroundJob/CreatePeriodicInvoices.pm

   1 package SL::BackgroundJob::CreatePeriodicInvoices;
   2
   3 use strict;
   4
   5 use parent qw(SL::BackgroundJob::Base);
   6
   7 use Config::Std;
   8 use DateTime::Format::Strptime;
   9 use English qw(-no_match_vars);
  10 use List::MoreUtils qw(uniq);
  11
  12 use SL::Common;
  13 use SL::DB::AuthUser;
  14 use SL::DB::Default;
  15 use SL::DB::Order;
  16 use SL::DB::Invoice;
  17 use SL::DB::PeriodicInvoice;
  18 use SL::DB::PeriodicInvoicesConfig;
  19 use SL::File;
  20 use SL::Helper::CreatePDF qw(create_pdf find_template);
  21 use SL::Mailer;
  22 use SL::Util qw(trim);
  23 use SL::System::Process;
  24
  25 sub create_job {
  26   $_[0]->create_standard_job('0 3 1 * *'); # first day of month at 3:00 am
  27 }
  28
  29 sub run {
  30   my $self        = shift;
  31   $self->{db_obj} = shift;
  32
  33   $self->{$_} = [] for qw(job_errors posted_invoices printed_invoices printed_failed emailed_invoices emailed_failed disabled_orders);
  34
  35   if (!$self->{db_obj}->db->with_transaction(sub {
  36     1;                          # make Emacs happy
  37
  38     my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(query => [ active => 1 ]);
  39
  40     foreach my $config (@{ $configs }) {
  41       my $new_end_date = $config->handle_automatic_extension;
  42       _log_msg("Periodic invoice configuration ID " . $config->id . " extended through " . $new_end_date->strftime('%d.%m.%Y') . "\n") if $new_end_date;
  43     }
  44
  45     my (@invoices_to_print, @invoices_to_email);
  46
  47     _log_msg("Number of configs: " . scalar(@{ $configs}));
  48
  49     foreach my $config (@{ $configs }) {
  50       # A configuration can be set to inactive by
  51       # $config->handle_automatic_extension. Therefore the check in
  52       # ...->get_all() does not suffice.
  53       _log_msg("Config " . $config->id . " active " . $config->active);
  54       next unless $config->active;
  55
  56       my @dates = _calculate_dates($config);
  57
  58       _log_msg("Dates: " . join(' ', map { $_->to_lxoffice } @dates));
  59
  60       foreach my $date (@dates) {
  61         my $data = $self->_create_periodic_invoice($config, $date);
  62         next unless $data;
  63
  64         _log_msg("Invoice " . $data->{invoice}->invnumber . " posted for config ID " . $config->id . ", period start date " . $::locale->format_date(\%::myconfig, $date) . "\n");
  65
  66         push @{ $self->{posted_invoices} }, $data->{invoice};
  67         push @invoices_to_print, $data if $config->print;
  68         push @invoices_to_email, $data if $config->send_email;
  69
  70         my $inactive_ordnumber = $config->disable_one_time_config;
  71         if ($inactive_ordnumber) {
  72           # disable one time configs and skip eventual invoices
  73           _log_msg("Order " . $inactive_ordnumber . " deavtivated \n");
  74           push @{ $self->{disabled_orders} }, $inactive_ordnumber;
  75           last;
  76         }
  77       }
  78     }
  79
  80     foreach my $inv ( @invoices_to_print ) { $self->_print_invoice($inv); }
  81     foreach my $inv ( @invoices_to_email ) { $self->_email_invoice($inv); }
  82
  83     $self->_send_summary_email;
  84
  85       1;
  86     })) {
  87       $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
  88       return undef;
  89     }
  90
  91     if (@{ $self->{job_errors} }) {
  92       my $msg = join "\n", @{ $self->{job_errors} };
  93       _log_msg("Errors: $msg");
  94       die $msg;
  95     }
  96
  97   return 1;
  98 }
  99
 100 sub _log_msg {
 101   my $message  = join('', 'SL::BackgroundJob::CreatePeriodicInvoices: ', @_);
 102   $message    .= "\n" unless $message =~ m/\n$/;
 103   $::lxdebug->message(LXDebug::DEBUG1(), $message);
 104 }
 105
 106 sub _generate_time_period_variables {
 107   my $config            = shift;
 108   my $period_start_date = shift;
 109   my $period_end_date   = $period_start_date->clone->add(months => $config->get_billing_period_length)->subtract(days => 1);
 110
 111   my @month_names       = ('',
 112                            $::locale->text('January'), $::locale->text('February'), $::locale->text('March'),     $::locale->text('April'),   $::locale->text('May'),      $::locale->text('June'),
 113                            $::locale->text('July'),    $::locale->text('August'),   $::locale->text('September'), $::locale->text('October'), $::locale->text('November'), $::locale->text('December'));
 114
 115   my $vars = {
 116     current_quarter     => [ $period_start_date->clone->truncate(to => 'month'),                        sub { $_[0]->quarter } ],
 117     previous_quarter    => [ $period_start_date->clone->truncate(to => 'month')->subtract(months => 3), sub { $_[0]->quarter } ],
 118     next_quarter        => [ $period_start_date->clone->truncate(to => 'month')->add(     months => 3), sub { $_[0]->quarter } ],
 119
 120     current_month       => [ $period_start_date->clone->truncate(to => 'month'),                        sub { $_[0]->month } ],
 121     previous_month      => [ $period_start_date->clone->truncate(to => 'month')->subtract(months => 1), sub { $_[0]->month } ],
 122     next_month          => [ $period_start_date->clone->truncate(to => 'month')->add(     months => 1), sub { $_[0]->month } ],
 123
 124     current_month_long  => [ $period_start_date->clone->truncate(to => 'month'),                        sub { $month_names[ $_[0]->month ] } ],
 125     previous_month_long => [ $period_start_date->clone->truncate(to => 'month')->subtract(months => 1), sub { $month_names[ $_[0]->month ] } ],
 126     next_month_long     => [ $period_start_date->clone->truncate(to => 'month')->add(     months => 1), sub { $month_names[ $_[0]->month ] } ],
 127
 128     current_year        => [ $period_start_date->clone->truncate(to => 'year'),                         sub { $_[0]->year } ],
 129     previous_year       => [ $period_start_date->clone->truncate(to => 'year')->subtract(years => 1),   sub { $_[0]->year } ],
 130     next_year           => [ $period_start_date->clone->truncate(to => 'year')->add(     years => 1),   sub { $_[0]->year } ],
 131
 132     period_start_date   => [ $period_start_date->clone, sub { $::locale->format_date(\%::myconfig, $_[0]) } ],
 133     period_end_date     => [ $period_end_date,          sub { $::locale->format_date(\%::myconfig, $_[0]) } ],
 134   };
 135
 136   return $vars;
 137 }
 138
 139 sub _replace_vars {
 140   my (%params) = @_;
 141   my $sub      = $params{attribute};
 142   my $str      = $params{object}->$sub // '';
 143   my $sub_fmt  = lc($params{attribute_format} // 'text');
 144
 145   my ($start_tag, $end_tag) = $sub_fmt eq 'html' ? ('&lt;%', '%&gt;') : ('<%', '%>');
 146   my @invoice_keys          = $params{invoice} ? (map { $_->name } $params{invoice}->meta->columns) : ();
 147   my $key_name_re           = join '|', map { quotemeta } (@invoice_keys, keys %{ $params{vars} });
 148
 149   $str =~ s{ ${start_tag} ($key_name_re) ( \s+ format \s*=\s* (.*?) \s* )? ${end_tag} }{
 150     my ($key, $format) = ($1, $3);
 151     $key               = $::locale->unquote_special_chars('html', $key) if $sub_fmt eq 'html';
 152     my $new_value;
 153
 154     if ($params{vars}->{$key} && $format) {
 155       $format    = $::locale->unquote_special_chars('html', $format) if $sub_fmt eq 'html';
 156
 157       $new_value = DateTime::Format::Strptime->new(
 158         pattern     => $format,
 159         locale      => 'de_DE',
 160         time_zone   => 'local',
 161       )->format_datetime($params{vars}->{$key}->[0]);
 162
 163     } elsif ($params{vars}->{$key}) {
 164       $new_value = $params{vars}->{$1}->[1]->($params{vars}->{$1}->[0]);
 165
 166     } elsif ($params{invoice} && $params{invoice}->can($key)) {
 167       $new_value = $params{invoice}->$key;
 168     }
 169
 170     $new_value //= '';
 171     $new_value   = $::locale->quote_special_chars('html', $new_value) if $sub_fmt eq 'html';
 172
 173     $new_value;
 174
 175   }eigx;
 176
 177   $params{object}->$sub($str);
 178 }
 179
 180 sub _adjust_sellprices_for_period_lengths {
 181   my (%params) = @_;
 182
 183   return if $params{config}->periodicity eq 'o';
 184
 185   my $billing_len     = $params{config}->get_billing_period_length;
 186   my $order_value_len = $params{config}->get_order_value_period_length;
 187
 188   return if $billing_len == $order_value_len;
 189
 190   my $is_last_invoice_in_cycle = $params{config}->is_last_bill_date_in_order_value_cycle(date => $params{period_start_date});
 191
 192   _log_msg("_adjust_sellprices_for_period_lengths: period_start_date $params{period_start_date} is_last_invoice_in_cycle $is_last_invoice_in_cycle billing_len $billing_len order_value_len $order_value_len");
 193
 194   if ($order_value_len < $billing_len) {
 195     my $num_orders_per_invoice = $billing_len / $order_value_len;
 196
 197     $_->sellprice($_->sellprice * $num_orders_per_invoice) for @{ $params{invoice}->items };
 198
 199     return;
 200   }
 201
 202   my $num_invoices_in_cycle = $order_value_len / $billing_len;
 203
 204   foreach my $item (@{ $params{invoice}->items }) {
 205     my $sellprice_one_invoice = $::form->round_amount($item->sellprice * $billing_len / $order_value_len, 2);
 206
 207     if ($is_last_invoice_in_cycle) {
 208       $item->sellprice($item->sellprice - ($num_invoices_in_cycle - 1) * $sellprice_one_invoice);
 209
 210     } else {
 211       $item->sellprice($sellprice_one_invoice);
 212     }
 213   }
 214 }
 215
 216 sub _create_periodic_invoice {
 217   my $self              = shift;
 218   my $config            = shift;
 219   my $period_start_date = shift;
 220
 221   my $time_period_vars  = _generate_time_period_variables($config, $period_start_date);
 222
 223   my $invdate           = DateTime->today_local;
 224
 225   my $order   = $config->order;
 226   my $invoice;
 227   if (!$self->{db_obj}->db->with_transaction(sub {
 228     1;                          # make Emacs happy
 229
 230     $invoice = SL::DB::Invoice->new_from($order);
 231
 232     my $tax_point = ($invoice->tax_point // $time_period_vars->{period_end_date}->[0])->clone;
 233
 234     while ($tax_point < $period_start_date) {
 235       $tax_point->add(months => $config->get_billing_period_length);
 236     }
 237
 238     my $intnotes  = $invoice->intnotes ? $invoice->intnotes . "\n\n" : '';
 239     $intnotes    .= "Automatisch am " . $invdate->to_lxoffice . " erzeugte Rechnung";
 240
 241     $invoice->assign_attributes(deliverydate => $period_start_date,
 242                                 tax_point    => $tax_point,
 243                                 intnotes     => $intnotes,
 244                                 employee     => $order->employee, # new_from sets employee to import user
 245                                 direct_debit => $config->direct_debit,
 246                                );
 247
 248     _replace_vars(object => $invoice, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'notes' ? 'html' : 'text')) for qw(notes intnotes transaction_description);
 249
 250     foreach my $item (@{ $invoice->items }) {
 251       _replace_vars(object => $item, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'longdescription' ? 'html' : 'text')) for qw(description longdescription);
 252     }
 253
 254     _adjust_sellprices_for_period_lengths(invoice => $invoice, config => $config, period_start_date => $period_start_date);
 255
 256     $invoice->post(ar_id => $config->ar_chart_id) || die;
 257
 258     $order->link_to_record($invoice);
 259
 260     foreach my $item (@{ $invoice->items }) {
 261       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 262           if ($item->{"converted_from_${_}_id"}) {
 263             die unless $item->{id};
 264             RecordLinks->create_links('mode'       => 'ids',
 265                                       'from_table' => $_,
 266                                       'from_ids'   => $item->{"converted_from_${_}_id"},
 267                                       'to_table'   => 'invoice',
 268                                       'to_id'      => $item->{id},
 269             ) || die;
 270             delete $item->{"converted_from_${_}_id"};
 271          }
 272       }
 273     }
 274
 275     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 276                                  ar_id             => $invoice->id,
 277                                  period_start_date => $period_start_date)
 278       ->save;
 279
 280     _log_msg("_create_invoice created for period start date $period_start_date id " . $invoice->id . " number " . $invoice->invnumber . " netamount " . $invoice->netamount . " amount " . $invoice->amount);
 281
 282     # die $invoice->transaction_description;
 283
 284     1;
 285   })) {
 286     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 287     return undef;
 288   }
 289
 290   return {
 291     config            => $config,
 292     period_start_date => $period_start_date,
 293     invoice           => $invoice,
 294     time_period_vars  => $time_period_vars,
 295   };
 296 }
 297
 298 sub _calculate_dates {
 299   my ($config) = @_;
 300   return $config->calculate_invoice_dates(end_date => DateTime->today_local);
 301 }
 302
 303 sub _send_summary_email {
 304   my ($self) = @_;
 305   my %config = %::lx_office_conf;
 306
 307   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $self->{posted_invoices} };
 308
 309   return if $config{periodic_invoices}->{send_for_errors_only} && !@{ $self->{printed_failed} } && !@{ $self->{emailed_failed} };
 310
 311   my $email = $config{periodic_invoices}->{send_email_to};
 312   if ($email !~ m{\@}) {
 313     my $user = SL::DB::Manager::AuthUser->find_by(login => $email);
 314     $email   = $user ? $user->get_config_value('email') : undef;
 315   }
 316
 317   _log_msg("_send_summary_email: about to send to '" . ($email || '') . "'");
 318
 319   return unless $email;
 320
 321   my $template = Template->new({ 'INTERPOLATE' => 0,
 322                                  'EVAL_PERL'   => 0,
 323                                  'ABSOLUTE'    => 1,
 324                                  'CACHE_SIZE'  => 0,
 325                                });
 326
 327   return unless $template;
 328
 329   my $email_template = $config{periodic_invoices}->{email_template};
 330   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/oe/periodic_invoices_email.txt" );
 331   my %params         = map { (uc($_) => $self->{$_}) } qw(posted_invoices printed_invoices printed_failed emailed_invoices emailed_failed disabled_orders);
 332
 333   my $output;
 334   $template->process($filename, \%params, \$output) || die $template->error;
 335
 336   my $mail              = Mailer->new;
 337   $mail->{from}         = $config{periodic_invoices}->{email_from};
 338   $mail->{to}           = $email;
 339   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 340   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 341   $mail->{message}      = $output;
 342
 343   $mail->send;
 344 }
 345
 346 sub _store_pdf_in_webdav {
 347   my ($self, $pdf_file_name, $invoice) = @_;
 348
 349   return unless $::instance_conf->get_webdav_documents;
 350
 351   my $form = Form->new('');
 352
 353   $form->{cwd}              = SL::System::Process->exe_dir;
 354   $form->{tmpdir}           = ($pdf_file_name =~ m{(.+)/})[0];
 355   $form->{tmpfile}          = ($pdf_file_name =~ m{.+/(.+)})[0];
 356   $form->{format}           = 'pdf';
 357   $form->{formname}         = 'invoice';
 358   $form->{type}             = 'invoice';
 359   $form->{vc}               = 'customer';
 360   $form->{invnumber}        = $invoice->invnumber;
 361   $form->{recipient_locale} = $invoice->language ? $invoice->language->template_code : '';
 362
 363   Common::copy_file_to_webdav_folder($form);
 364 }
 365
 366 sub _store_pdf_in_filemanagement {
 367   my ($self, $pdf_file, $invoice) = @_;
 368
 369   return unless $::instance_conf->get_doc_storage;
 370
 371   # create a form for generate_attachment_filename
 372   my $form = Form->new('');
 373   $form->{invnumber} = $invoice->invnumber;
 374   $form->{type}      = 'invoice';
 375   $form->{format}    = 'pdf';
 376   $form->{formname}  = 'invoice';
 377   $form->{language}  = '_' . $invoice->language->template_code if $invoice->language;
 378   my $doc_name       = $form->generate_attachment_filename();
 379
 380   SL::File->save(object_id   => $invoice->id,
 381                  object_type => 'invoice',
 382                  mime_type   => 'application/pdf',
 383                  source      => 'created',
 384                  file_type   => 'document',
 385                  file_name   => $doc_name,
 386                  file_path   => $pdf_file);
 387 }
 388
 389 sub _print_invoice {
 390   my ($self, $data) = @_;
 391
 392   my $invoice       = $data->{invoice};
 393   my $config        = $data->{config};
 394
 395   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 396
 397   my $form = Form->new;
 398   $invoice->flatten_to_form($form, format_amounts => 1);
 399
 400   $form->{printer_code} = $config->printer->template_code;
 401   $form->{copies}       = $config->copies;
 402   $form->{formname}     = $form->{type};
 403   $form->{format}       = 'pdf';
 404   $form->{media}        = 'printer';
 405   $form->{OUT}          = $config->printer->printer_command;
 406   $form->{OUT_MODE}     = '|-';
 407
 408   $form->{TEMPLATE_DRIVER_OPTIONS} = { };
 409   $form->{TEMPLATE_DRIVER_OPTIONS}->{variable_content_types} = $form->get_variable_content_types();
 410
 411   $form->prepare_for_printing;
 412
 413   $form->throw_on_error(sub {
 414     eval {
 415       $form->parse_template(\%::myconfig);
 416       push @{ $self->{printed_invoices} }, $invoice;
 417       1;
 418     } or do {
 419       push @{ $self->{job_errors} }, $EVAL_ERROR->error;
 420       push @{ $self->{printed_failed} }, [ $invoice, $EVAL_ERROR->error ];
 421     };
 422   });
 423 }
 424
 425 sub _email_invoice {
 426   my ($self, $data) = @_;
 427
 428   $data->{config}->load;
 429
 430   return unless $data->{config}->send_email;
 431
 432   my @recipients =
 433     uniq
 434     map  { lc       }
 435     grep { $_       }
 436     map  { trim($_) }
 437     (split(m{,}, $data->{config}->email_recipient_address),
 438      $data->{config}->email_recipient_contact   ? ($data->{config}->email_recipient_contact->cp_email) : (),
 439      $data->{invoice}->{customer}->invoice_mail ? ($data->{invoice}->{customer}->invoice_mail) : ()
 440     );
 441
 442   return unless @recipients;
 443
 444   my $language      = $data->{invoice}->language ? $data->{invoice}->language->template_code : undef;
 445   my %create_params = (
 446     template               => scalar($self->find_template(name => 'invoice', language => $language)),
 447     variables              => Form->new(''),
 448     return                 => 'file_name',
 449     record                 => $data->{invoice},
 450     variable_content_types => {
 451       longdescription => 'html',
 452       partnotes       => 'html',
 453       notes           => 'html',
 454     },
 455   );
 456
 457   $data->{invoice}->flatten_to_form($create_params{variables}, format_amounts => 1);
 458   $create_params{variables}->prepare_for_printing;
 459
 460   my $pdf_file_name;
 461   my $label = $language && Locale::is_supported($language) ? Locale->new($language)->text('Invoice') : $::locale->text('Invoice');
 462
 463   eval {
 464     $pdf_file_name = $self->create_pdf(%create_params);
 465
 466     $self->_store_pdf_in_webdav        ($pdf_file_name, $data->{invoice});
 467     $self->_store_pdf_in_filemanagement($pdf_file_name, $data->{invoice});
 468
 469     for (qw(email_subject email_body)) {
 470       _replace_vars(
 471         object           => $data->{config},
 472         invoice          => $data->{invoice},
 473         vars             => $data->{time_period_vars},
 474         attribute        => $_,
 475         attribute_format => 'text'
 476       );
 477     }
 478
 479     my $global_bcc = SL::DB::Default->get->global_bcc;
 480     my $overall_error;
 481
 482     for my $recipient (@recipients) {
 483       my $mail             = Mailer->new;
 484       $mail->{record_id}   = $data->{invoice}->id,
 485       $mail->{record_type} = 'invoice',
 486       $mail->{from}        = $data->{config}->email_sender || $::lx_office_conf{periodic_invoices}->{email_from};
 487       $mail->{to}          = $recipient;
 488       $mail->{bcc}         = $global_bcc;
 489       $mail->{subject}     = $data->{config}->email_subject;
 490       $mail->{message}     = $data->{config}->email_body;
 491       $mail->{attachments} = [{
 492         path     => $pdf_file_name,
 493         name     => sprintf('%s %s.pdf', $label, $data->{invoice}->invnumber),
 494       }];
 495
 496       my $error        = $mail->send;
 497
 498       if ($error) {
 499         push @{ $self->{job_errors} }, $error;
 500         push @{ $self->{emailed_failed} }, [ $data->{invoice}, $error ];
 501         $overall_error = 1;
 502       }
 503     }
 504
 505     push @{ $self->{emailed_invoices} }, $data->{invoice} unless $overall_error;
 506
 507     1;
 508
 509   } or do {
 510     push @{ $self->{job_errors} }, $EVAL_ERROR;
 511     push @{ $self->{emailed_failed} }, [ $data->{invoice}, $EVAL_ERROR ];
 512   };
 513
 514   unlink $pdf_file_name if $pdf_file_name;
 515 }
 516
 517 1;
 518
 519 __END__
 520
 521 =pod
 522
 523 =encoding utf8
 524
 525 =head1 NAME
 526
 527 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 528 invoices for orders
 529
 530 =head1 SYNOPSIS
 531
 532 Iterate over all periodic invoice configurations, extend them if
 533 applicable, calculate the dates for which invoices have to be posted
 534 and post those invoices by converting the order into an invoice for
 535 each date.
 536
 537 =head1 TOTO
 538
 539 =over 4
 540
 541 =item *
 542
 543 Strings like month names are hardcoded to German in this file.
 544
 545 =back
 546
 547 =head1 AUTHOR
 548
 549 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 550
 551 =cut