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     record                 => $data->{invoice},
 413     variable_content_types => {
 414       longdescription => 'html',
 415       partnotes       => 'html',
 416       notes           => 'html',
 417     },
 418   );
 419
 420   $data->{invoice}->flatten_to_form($create_params{variables}, format_amounts => 1);
 421   $create_params{variables}->prepare_for_printing;
 422
 423   my $pdf_file_name;
 424   my $label = $language && Locale::is_supported($language) ? Locale->new($language)->text('Invoice') : $::locale->text('Invoice');
 425
 426   eval {
 427     $pdf_file_name = $self->create_pdf(%create_params);
 428
 429     $self->_store_pdf_in_webdav($pdf_file_name, $data->{invoice});
 430
 431     for (qw(email_subject email_body)) {
 432       _replace_vars(
 433         object           => $data->{config},
 434         vars             => $data->{time_period_vars},
 435         attribute        => $_,
 436         attribute_format => 'text'
 437       );
 438     }
 439
 440     my $global_bcc = SL::DB::Default->get->global_bcc;
 441
 442     for my $recipient (@recipients) {
 443       my $mail             = Mailer->new;
 444       $mail->{record_id}   = $data->{invoice}->id,
 445       $mail->{record_type} = 'invoice',
 446       $mail->{from}        = $data->{config}->email_sender || $::lx_office_conf{periodic_invoices}->{email_from};
 447       $mail->{to}          = $recipient;
 448       $mail->{bcc}         = $global_bcc;
 449       $mail->{subject}     = $data->{config}->email_subject;
 450       $mail->{message}     = $data->{config}->email_body;
 451       $mail->{attachments} = [{
 452         path     => $pdf_file_name,
 453         name     => sprintf('%s %s.pdf', $label, $data->{invoice}->invnumber),
 454       }];
 455
 456       my $error        = $mail->send;
 457
 458       push @{ $self->{job_errors} }, $error if $error;
 459     }
 460
 461     1;
 462
 463   } or do {
 464     push @{ $self->{job_errors} }, $EVAL_ERROR;
 465   };
 466
 467   unlink $pdf_file_name if $pdf_file_name;
 468 }
 469
 470 1;
 471
 472 __END__
 473
 474 =pod
 475
 476 =encoding utf8
 477
 478 =head1 NAME
 479
 480 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 481 invoices for orders
 482
 483 =head1 SYNOPSIS
 484
 485 Iterate over all periodic invoice configurations, extend them if
 486 applicable, calculate the dates for which invoices have to be posted
 487 and post those invoices by converting the order into an invoice for
 488 each date.
 489
 490 =head1 TOTO
 491
 492 =over 4
 493
 494 =item *
 495
 496 Strings like month names are hardcoded to German in this file.
 497
 498 =back
 499
 500 =head1 AUTHOR
 501
 502 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 503
 504 =cut