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