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