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 $intnotes  = $invoice->intnotes ? $invoice->intnotes . "\n\n" : '';
 228     $intnotes    .= "Automatisch am " . $invdate->to_lxoffice . " erzeugte Rechnung";
 229
 230     $invoice->assign_attributes(deliverydate => $period_start_date,
 231                                 intnotes     => $intnotes,
 232                                 employee     => $order->employee, # new_from sets employee to import user
 233                                 direct_debit => $config->direct_debit,
 234                                );
 235
 236     _replace_vars(object => $invoice, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'notes' ? 'html' : 'text')) for qw(notes intnotes transaction_description);
 237
 238     foreach my $item (@{ $invoice->items }) {
 239       _replace_vars(object => $item, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'longdescription' ? 'html' : 'text')) for qw(description longdescription);
 240     }
 241
 242     _adjust_sellprices_for_period_lengths(invoice => $invoice, config => $config, period_start_date => $period_start_date);
 243
 244     $invoice->post(ar_id => $config->ar_chart_id) || die;
 245
 246     $order->link_to_record($invoice);
 247
 248     foreach my $item (@{ $invoice->items }) {
 249       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 250           if ($item->{"converted_from_${_}_id"}) {
 251             die unless $item->{id};
 252             RecordLinks->create_links('mode'       => 'ids',
 253                                       'from_table' => $_,
 254                                       'from_ids'   => $item->{"converted_from_${_}_id"},
 255                                       'to_table'   => 'invoice',
 256                                       'to_id'      => $item->{id},
 257             ) || die;
 258             delete $item->{"converted_from_${_}_id"};
 259          }
 260       }
 261     }
 262
 263     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 264                                  ar_id             => $invoice->id,
 265                                  period_start_date => $period_start_date)
 266       ->save;
 267
 268     _log_msg("_create_invoice created for period start date $period_start_date id " . $invoice->id . " number " . $invoice->invnumber . " netamount " . $invoice->netamount . " amount " . $invoice->amount);
 269
 270     # die $invoice->transaction_description;
 271
 272     1;
 273   })) {
 274     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 275     return undef;
 276   }
 277
 278   return {
 279     config            => $config,
 280     period_start_date => $period_start_date,
 281     invoice           => $invoice,
 282     time_period_vars  => $time_period_vars,
 283   };
 284 }
 285
 286 sub _calculate_dates {
 287   my ($config) = @_;
 288   return $config->calculate_invoice_dates(end_date => DateTime->today_local);
 289 }
 290
 291 sub _send_summary_email {
 292   my ($self) = @_;
 293   my %config = %::lx_office_conf;
 294
 295   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $self->{posted_invoices} };
 296
 297   return if $config{periodic_invoices}->{send_for_errors_only} && !@{ $self->{printed_failed} } && !@{ $self->{emailed_failed} };
 298
 299   my $email = $config{periodic_invoices}->{send_email_to};
 300   if ($email !~ m{\@}) {
 301     my $user = SL::DB::Manager::AuthUser->find_by(login => $email);
 302     $email   = $user ? $user->get_config_value('email') : undef;
 303   }
 304
 305   _log_msg("_send_summary_email: about to send to '" . ($email || '') . "'");
 306
 307   return unless $email;
 308
 309   my $template = Template->new({ 'INTERPOLATE' => 0,
 310                                  'EVAL_PERL'   => 0,
 311                                  'ABSOLUTE'    => 1,
 312                                  'CACHE_SIZE'  => 0,
 313                                });
 314
 315   return unless $template;
 316
 317   my $email_template = $config{periodic_invoices}->{email_template};
 318   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/oe/periodic_invoices_email.txt" );
 319   my %params         = map { (uc($_) => $self->{$_}) } qw(posted_invoices printed_invoices printed_failed emailed_invoices emailed_failed disabled_orders);
 320
 321   my $output;
 322   $template->process($filename, \%params, \$output) || die $template->error;
 323
 324   my $mail              = Mailer->new;
 325   $mail->{from}         = $config{periodic_invoices}->{email_from};
 326   $mail->{to}           = $email;
 327   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 328   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 329   $mail->{message}      = $output;
 330
 331   $mail->send;
 332 }
 333
 334 sub _store_pdf_in_webdav {
 335   my ($self, $pdf_file_name, $invoice) = @_;
 336
 337   return unless $::instance_conf->get_webdav_documents;
 338
 339   my $form = Form->new('');
 340
 341   $form->{cwd}              = SL::System::Process->exe_dir;
 342   $form->{tmpdir}           = ($pdf_file_name =~ m{(.+)/})[0];
 343   $form->{tmpfile}          = ($pdf_file_name =~ m{.+/(.+)})[0];
 344   $form->{format}           = 'pdf';
 345   $form->{formname}         = 'invoice';
 346   $form->{type}             = 'invoice';
 347   $form->{vc}               = 'customer';
 348   $form->{invnumber}        = $invoice->invnumber;
 349   $form->{recipient_locale} = $invoice->language ? $invoice->language->template_code : '';
 350
 351   Common::copy_file_to_webdav_folder($form);
 352 }
 353
 354 sub _print_invoice {
 355   my ($self, $data) = @_;
 356
 357   my $invoice       = $data->{invoice};
 358   my $config        = $data->{config};
 359
 360   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 361
 362   my $form = Form->new;
 363   $invoice->flatten_to_form($form, format_amounts => 1);
 364
 365   $form->{printer_code} = $config->printer->template_code;
 366   $form->{copies}       = $config->copies;
 367   $form->{formname}     = $form->{type};
 368   $form->{format}       = 'pdf';
 369   $form->{media}        = 'printer';
 370   $form->{OUT}          = $config->printer->printer_command;
 371   $form->{OUT_MODE}     = '|-';
 372
 373   $form->{TEMPLATE_DRIVER_OPTIONS} = { };
 374   $form->{TEMPLATE_DRIVER_OPTIONS}->{variable_content_types} = $form->get_variable_content_types();
 375
 376   $form->prepare_for_printing;
 377
 378   $form->throw_on_error(sub {
 379     eval {
 380       $form->parse_template(\%::myconfig);
 381       push @{ $self->{printed_invoices} }, $invoice;
 382       1;
 383     } or do {
 384       push @{ $self->{job_errors} }, $EVAL_ERROR->error;
 385       push @{ $self->{printed_failed} }, [ $invoice, $EVAL_ERROR->error ];
 386     };
 387   });
 388 }
 389
 390 sub _email_invoice {
 391   my ($self, $data) = @_;
 392
 393   $data->{config}->load;
 394
 395   return unless $data->{config}->send_email;
 396
 397   my @recipients =
 398     uniq
 399     map  { lc       }
 400     grep { $_       }
 401     map  { trim($_) }
 402     (split(m{,}, $data->{config}->email_recipient_address),
 403      $data->{config}->email_recipient_contact   ? ($data->{config}->email_recipient_contact->cp_email) : (),
 404      $data->{invoice}->{customer}->invoice_mail ? ($data->{invoice}->{customer}->invoice_mail) : ()
 405     );
 406
 407   return unless @recipients;
 408
 409   my $language      = $data->{invoice}->language ? $data->{invoice}->language->template_code : undef;
 410   my %create_params = (
 411     template               => scalar($self->find_template(name => 'invoice', language => $language)),
 412     variables              => Form->new(''),
 413     return                 => 'file_name',
 414     record                 => $data->{invoice},
 415     variable_content_types => {
 416       longdescription => 'html',
 417       partnotes       => 'html',
 418       notes           => 'html',
 419     },
 420   );
 421
 422   $data->{invoice}->flatten_to_form($create_params{variables}, format_amounts => 1);
 423   $create_params{variables}->prepare_for_printing;
 424
 425   my $pdf_file_name;
 426   my $label = $language && Locale::is_supported($language) ? Locale->new($language)->text('Invoice') : $::locale->text('Invoice');
 427
 428   eval {
 429     $pdf_file_name = $self->create_pdf(%create_params);
 430
 431     $self->_store_pdf_in_webdav($pdf_file_name, $data->{invoice});
 432
 433     for (qw(email_subject email_body)) {
 434       _replace_vars(
 435         object           => $data->{config},
 436         invoice          => $data->{invoice},
 437         vars             => $data->{time_period_vars},
 438         attribute        => $_,
 439         attribute_format => 'text'
 440       );
 441     }
 442
 443     my $global_bcc = SL::DB::Default->get->global_bcc;
 444     my $overall_error;
 445
 446     for my $recipient (@recipients) {
 447       my $mail             = Mailer->new;
 448       $mail->{record_id}   = $data->{invoice}->id,
 449       $mail->{record_type} = 'invoice',
 450       $mail->{from}        = $data->{config}->email_sender || $::lx_office_conf{periodic_invoices}->{email_from};
 451       $mail->{to}          = $recipient;
 452       $mail->{bcc}         = $global_bcc;
 453       $mail->{subject}     = $data->{config}->email_subject;
 454       $mail->{message}     = $data->{config}->email_body;
 455       $mail->{attachments} = [{
 456         path     => $pdf_file_name,
 457         name     => sprintf('%s %s.pdf', $label, $data->{invoice}->invnumber),
 458       }];
 459
 460       my $error        = $mail->send;
 461
 462       if ($error) {
 463         push @{ $self->{job_errors} }, $error;
 464         push @{ $self->{emailed_failed} }, [ $data->{invoice}, $error ];
 465         $overall_error = 1;
 466       }
 467     }
 468
 469     push @{ $self->{emailed_invoices} }, $data->{invoice} unless $overall_error;
 470
 471     1;
 472
 473   } or do {
 474     push @{ $self->{job_errors} }, $EVAL_ERROR;
 475     push @{ $self->{emailed_failed} }, [ $data->{invoice}, $EVAL_ERROR ];
 476   };
 477
 478   unlink $pdf_file_name if $pdf_file_name;
 479 }
 480
 481 1;
 482
 483 __END__
 484
 485 =pod
 486
 487 =encoding utf8
 488
 489 =head1 NAME
 490
 491 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 492 invoices for orders
 493
 494 =head1 SYNOPSIS
 495
 496 Iterate over all periodic invoice configurations, extend them if
 497 applicable, calculate the dates for which invoices have to be posted
 498 and post those invoices by converting the order into an invoice for
 499 each date.
 500
 501 =head1 TOTO
 502
 503 =over 4
 504
 505 =item *
 506
 507 Strings like month names are hardcoded to German in this file.
 508
 509 =back
 510
 511 =head1 AUTHOR
 512
 513 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 514
 515 =cut