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