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   $form->{TEMPLATE_DRIVER_OPTIONS}->{variable_content_types} = $form->get_variable_content_types();
 342
 343   $form->prepare_for_printing;
 344
 345   $form->throw_on_error(sub {
 346     eval {
 347       $form->parse_template(\%::myconfig);
 348       1;
 349     } or do {
 350       push @{ $self->{job_errors} }, $EVAL_ERROR->getMessage;
 351     };
 352   });
 353 }
 354
 355 sub _email_invoice {
 356   my ($self, $data) = @_;
 357
 358   $data->{config}->load;
 359
 360   return unless $data->{config}->send_email;
 361
 362   my @recipients =
 363     uniq
 364     map  { lc       }
 365     grep { $_       }
 366     map  { trim($_) }
 367     (split(m{,}, $data->{config}->email_recipient_address),
 368      $data->{config}->email_recipient_contact ? ($data->{config}->email_recipient_contact->cp_email) : ());
 369
 370   return unless @recipients;
 371
 372   my %create_params = (
 373     template               => $self->find_template(name => 'invoice'),
 374     variables              => Form->new(''),
 375     return                 => 'file_name',
 376     variable_content_types => {
 377       longdescription => 'html',
 378       partnotes       => 'html',
 379       notes           => 'html',
 380     },
 381   );
 382
 383   $data->{invoice}->flatten_to_form($create_params{variables}, format_amounts => 1);
 384   $create_params{variables}->prepare_for_printing;
 385
 386   my $pdf_file_name;
 387
 388   eval {
 389     $pdf_file_name = $self->create_pdf(%create_params);
 390
 391     for (qw(email_subject email_body)) {
 392       _replace_vars(
 393         object           => $data->{config},
 394         vars             => $data->{time_period_vars},
 395         attribute        => $_,
 396         attribute_format => 'text'
 397       );
 398     }
 399
 400     for my $recipient (@recipients) {
 401       my $mail             = Mailer->new;
 402       $mail->{from}        = $data->{config}->email_sender || $::lx_office_conf{periodic_invoices}->{email_from};
 403       $mail->{to}          = $recipient;
 404       $mail->{subject}     = $data->{config}->email_subject;
 405       $mail->{message}     = $data->{config}->email_body;
 406       $mail->{attachments} = [{
 407         filename => $pdf_file_name,
 408         name     => sprintf('%s %s.pdf', $::locale->text('Invoice'), $data->{invoice}->invnumber),
 409       }];
 410
 411       my $error        = $mail->send;
 412
 413       push @{ $self->{job_errors} }, $error if $error;
 414     }
 415
 416     1;
 417
 418   } or do {
 419     push @{ $self->{job_errors} }, $EVAL_ERROR;
 420   };
 421
 422   unlink $pdf_file_name if $pdf_file_name;
 423 }
 424
 425 1;
 426
 427 __END__
 428
 429 =pod
 430
 431 =encoding utf8
 432
 433 =head1 NAME
 434
 435 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 436 invoices for orders
 437
 438 =head1 SYNOPSIS
 439
 440 Iterate over all periodic invoice configurations, extend them if
 441 applicable, calculate the dates for which invoices have to be posted
 442 and post those invoices by converting the order into an invoice for
 443 each date.
 444
 445 =head1 TOTO
 446
 447 =over 4
 448
 449 =item *
 450
 451 Strings like month names are hardcoded to German in this file.
 452
 453 =back
 454
 455 =head1 AUTHOR
 456
 457 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 458
 459 =cut