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