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