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