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   $self->_print_invoice($_) for @invoices_to_print;
  69   $self->_email_invoice($_) for @invoices_to_email;
  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 = @{ $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->do_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     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 259     return undef;
 260   }
 261
 262   return {
 263     config            => $config,
 264     period_start_date => $period_start_date,
 265     invoice           => $invoice,
 266     time_period_vars  => $time_period_vars,
 267   };
 268 }
 269
 270 sub _calculate_dates {
 271   my ($config) = @_;
 272   return $config->calculate_invoice_dates(end_date => DateTime->today_local);
 273 }
 274
 275 sub _send_summary_email {
 276   my ($self, $posted_invoices, $printed_invoices, $emailed_invoices) = @_;
 277
 278   my %config = %::lx_office_conf;
 279
 280   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $posted_invoices };
 281
 282   my $user  = SL::DB::Manager::AuthUser->find_by(login => $config{periodic_invoices}->{send_email_to});
 283   my $email = $user ? $user->get_config_value('email') : undef;
 284
 285   return unless $email;
 286
 287   my $template = Template->new({ 'INTERPOLATE' => 0,
 288                                  'EVAL_PERL'   => 0,
 289                                  'ABSOLUTE'    => 1,
 290                                  'CACHE_SIZE'  => 0,
 291                                });
 292
 293   return unless $template;
 294
 295   my $email_template = $config{periodic_invoices}->{email_template};
 296   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/oe/periodic_invoices_email.txt" );
 297   my %params         = ( POSTED_INVOICES  => $posted_invoices,
 298                          PRINTED_INVOICES => $printed_invoices,
 299                          EMAILED_INVOICES => $emailed_invoices );
 300
 301   my $output;
 302   $template->process($filename, \%params, \$output);
 303
 304   my $mail              = Mailer->new;
 305   $mail->{from}         = $config{periodic_invoices}->{email_from};
 306   $mail->{to}           = $email;
 307   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 308   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 309   $mail->{message}      = $output;
 310
 311   $mail->send;
 312 }
 313
 314 sub _print_invoice {
 315   my ($self, $data) = @_;
 316
 317   my $invoice       = $data->{invoice};
 318   my $config        = $data->{config};
 319
 320   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 321
 322   my $form = Form->new;
 323   $invoice->flatten_to_form($form, format_amounts => 1);
 324
 325   $form->{printer_code} = $config->printer->template_code;
 326   $form->{copies}       = $config->copies;
 327   $form->{formname}     = $form->{type};
 328   $form->{format}       = 'pdf';
 329   $form->{media}        = 'printer';
 330   $form->{OUT}          = $config->printer->printer_command;
 331   $form->{OUT_MODE}     = '|-';
 332
 333   $form->{TEMPLATE_DRIVER_OPTIONS} = {
 334     variable_content_types => {
 335       longdescription => 'html',
 336       partnotes       => 'html',
 337       notes           => 'html',
 338     },
 339   };
 340
 341   $form->prepare_for_printing;
 342
 343   $form->throw_on_error(sub {
 344     eval {
 345       $form->parse_template(\%::myconfig);
 346       1;
 347     } or do {
 348       push @{ $self->{job_errors} }, $EVAL_ERROR->getMessage;
 349     };
 350   });
 351 }
 352
 353 sub _email_invoice {
 354   my ($self, $data) = @_;
 355
 356   $data->{config}->load;
 357
 358   return unless $data->{config}->send_email;
 359
 360   my @recipients =
 361     uniq
 362     map  { lc       }
 363     grep { $_       }
 364     map  { trim($_) }
 365     (split(m{,}, $data->{config}->email_recipient_address),
 366      $data->{config}->email_recipient_contact ? ($data->{config}->email_recipient_contact->cp_email) : ());
 367
 368   return unless @recipients;
 369
 370   my %create_params = (
 371     template               => $self->find_template(name => 'invoice'),
 372     variables              => Form->new(''),
 373     return                 => 'file_name',
 374     variable_content_types => {
 375       longdescription => 'html',
 376       partnotes       => 'html',
 377       notes           => 'html',
 378     },
 379   );
 380
 381   $data->{invoice}->flatten_to_form($create_params{variables}, format_amounts => 1);
 382   $create_params{variables}->prepare_for_printing;
 383
 384   my $pdf_file_name;
 385
 386   eval {
 387     $pdf_file_name = $self->create_pdf(%create_params);
 388
 389     for (qw(email_subject email_body)) {
 390       _replace_vars(
 391         object           => $data->{config},
 392         vars             => $data->{time_period_vars},
 393         attribute        => $_,
 394         attribute_format => 'text'
 395       );
 396     }
 397
 398     for my $recipient (@recipients) {
 399       my $mail             = Mailer->new;
 400       $mail->{from}        = $data->{config}->email_sender || $::lx_office_conf{periodic_invoices}->{email_from};
 401       $mail->{to}          = $recipient;
 402       $mail->{subject}     = $data->{config}->email_subject;
 403       $mail->{message}     = $data->{config}->email_body;
 404       $mail->{attachments} = [{
 405         filename => $pdf_file_name,
 406         name     => sprintf('%s %s.pdf', $::locale->text('Invoice'), $data->{invoice}->invnumber),
 407       }];
 408
 409       my $error        = $mail->send;
 410
 411       push @{ $self->{job_errors} }, $error if $error;
 412     }
 413
 414     1;
 415
 416   } or do {
 417     push @{ $self->{job_errors} }, $EVAL_ERROR;
 418   };
 419
 420   unlink $pdf_file_name if $pdf_file_name;
 421 }
 422
 423 1;
 424
 425 __END__
 426
 427 =pod
 428
 429 =encoding utf8
 430
 431 =head1 NAME
 432
 433 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 434 invoices for orders
 435
 436 =head1 SYNOPSIS
 437
 438 Iterate over all periodic invoice configurations, extend them if
 439 applicable, calculate the dates for which invoices have to be posted
 440 and post those invoices by converting the order into an invoice for
 441 each date.
 442
 443 =head1 TOTO
 444
 445 =over 4
 446
 447 =item *
 448
 449 Strings like month names are hardcoded to German in this file.
 450
 451 =back
 452
 453 =head1 AUTHOR
 454
 455 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 456
 457 =cut