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