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