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      $data->{invoice}->{customer}->invoice_mail ? ($data->{invoice}->{customer}->invoice_mail) : ()
 381     );
 382
 383   return unless @recipients;
 384
 385   my %create_params = (
 386     template               => $self->find_template(name => 'invoice'),
 387     variables              => Form->new(''),
 388     return                 => 'file_name',
 389     variable_content_types => {
 390       longdescription => 'html',
 391       partnotes       => 'html',
 392       notes           => 'html',
 393     },
 394   );
 395
 396   $data->{invoice}->flatten_to_form($create_params{variables}, format_amounts => 1);
 397   $create_params{variables}->prepare_for_printing;
 398
 399   my $pdf_file_name;
 400
 401   eval {
 402     $pdf_file_name = $self->create_pdf(%create_params);
 403
 404     for (qw(email_subject email_body)) {
 405       _replace_vars(
 406         object           => $data->{config},
 407         vars             => $data->{time_period_vars},
 408         attribute        => $_,
 409         attribute_format => 'text'
 410       );
 411     }
 412
 413     my $global_bcc = SL::DB::Default->get->global_bcc;
 414
 415     for my $recipient (@recipients) {
 416       my $mail             = Mailer->new;
 417       $mail->{record_id}   = $data->{invoice}->id,
 418       $mail->{record_type} = 'invoice',
 419       $mail->{from}        = $data->{config}->email_sender || $::lx_office_conf{periodic_invoices}->{email_from};
 420       $mail->{to}          = $recipient;
 421       $mail->{bcc}         = $global_bcc;
 422       $mail->{subject}     = $data->{config}->email_subject;
 423       $mail->{message}     = $data->{config}->email_body;
 424       $mail->{attachments} = [{
 425         path     => $pdf_file_name,
 426         name     => sprintf('%s %s.pdf', $::locale->text('Invoice'), $data->{invoice}->invnumber),
 427       }];
 428
 429       my $error        = $mail->send;
 430
 431       push @{ $self->{job_errors} }, $error if $error;
 432     }
 433
 434     1;
 435
 436   } or do {
 437     push @{ $self->{job_errors} }, $EVAL_ERROR;
 438   };
 439
 440   unlink $pdf_file_name if $pdf_file_name;
 441 }
 442
 443 1;
 444
 445 __END__
 446
 447 =pod
 448
 449 =encoding utf8
 450
 451 =head1 NAME
 452
 453 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 454 invoices for orders
 455
 456 =head1 SYNOPSIS
 457
 458 Iterate over all periodic invoice configurations, extend them if
 459 applicable, calculate the dates for which invoices have to be posted
 460 and post those invoices by converting the order into an invoice for
 461 each date.
 462
 463 =head1 TOTO
 464
 465 =over 4
 466
 467 =item *
 468
 469 Strings like month names are hardcoded to German in this file.
 470
 471 =back
 472
 473 =head1 AUTHOR
 474
 475 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 476
 477 =cut