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