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
  11 use SL::DB::AuthUser;
  12 use SL::DB::Default;
  13 use SL::DB::Order;
  14 use SL::DB::Invoice;
  15 use SL::DB::PeriodicInvoice;
  16 use SL::DB::PeriodicInvoicesConfig;
  17 use SL::Mailer;
  18
  19 sub create_job {
  20   $_[0]->create_standard_job('0 3 1 * *'); # first day of month at 3:00 am
  21 }
  22
  23 sub run {
  24   my $self        = shift;
  25   $self->{db_obj} = shift;
  26
  27   my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(query => [ active => 1 ]);
  28
  29   foreach my $config (@{ $configs }) {
  30     my $new_end_date = $config->handle_automatic_extension;
  31     _log_msg("Periodic invoice configuration ID " . $config->id . " extended through " . $new_end_date->strftime('%d.%m.%Y') . "\n") if $new_end_date;
  32   }
  33
  34   my (@new_invoices, @invoices_to_print);
  35
  36   _log_msg("Number of configs: " . scalar(@{ $configs}));
  37
  38   foreach my $config (@{ $configs }) {
  39     # A configuration can be set to inactive by
  40     # $config->handle_automatic_extension. Therefore the check in
  41     # ...->get_all() does not suffice.
  42     _log_msg("Config " . $config->id . " active " . $config->active);
  43     next unless $config->active;
  44
  45     my @dates = _calculate_dates($config);
  46
  47     _log_msg("Dates: " . join(' ', map { $_->to_lxoffice } @dates));
  48
  49     foreach my $date (@dates) {
  50       my $invoice = $self->_create_periodic_invoice($config, $date);
  51       next unless $invoice;
  52
  53       _log_msg("Invoice " . $invoice->invnumber . " posted for config ID " . $config->id . ", period start date " . $::locale->format_date(\%::myconfig, $date) . "\n");
  54       push @new_invoices,      $invoice;
  55       push @invoices_to_print, [ $invoice, $config ] if $config->print;
  56
  57       # last;
  58     }
  59   }
  60
  61   _print_invoice(@{ $_ }) for @invoices_to_print;
  62
  63   _send_email(\@new_invoices, [ map { $_->[0] } @invoices_to_print ]) if @new_invoices;
  64
  65   return 1;
  66 }
  67
  68 sub _log_msg {
  69   my $message  = join('', 'SL::BackgroundJob::CreatePeriodicInvoices: ', @_);
  70   $message    .= "\n" unless $message =~ m/\n$/;
  71   $::lxdebug->message(LXDebug::DEBUG1(), $message);
  72 }
  73
  74 sub _generate_time_period_variables {
  75   my $config            = shift;
  76   my $period_start_date = shift;
  77   my $period_end_date   = $period_start_date->clone->truncate(to => 'month')->add(months => $config->get_billing_period_length)->subtract(days => 1);
  78
  79   my @month_names       = ('',
  80                            $::locale->text('January'), $::locale->text('February'), $::locale->text('March'),     $::locale->text('April'),   $::locale->text('May'),      $::locale->text('June'),
  81                            $::locale->text('July'),    $::locale->text('August'),   $::locale->text('September'), $::locale->text('October'), $::locale->text('November'), $::locale->text('December'));
  82
  83   my $vars = {
  84     current_quarter     => [ $period_start_date->clone->truncate(to => 'month'),                        sub { $_[0]->quarter } ],
  85     previous_quarter    => [ $period_start_date->clone->truncate(to => 'month')->subtract(months => 3), sub { $_[0]->quarter } ],
  86     next_quarter        => [ $period_start_date->clone->truncate(to => 'month')->add(     months => 3), sub { $_[0]->quarter } ],
  87
  88     current_month       => [ $period_start_date->clone->truncate(to => 'month'),                        sub { $_[0]->month } ],
  89     previous_month      => [ $period_start_date->clone->truncate(to => 'month')->subtract(months => 1), sub { $_[0]->month } ],
  90     next_month          => [ $period_start_date->clone->truncate(to => 'month')->add(     months => 1), sub { $_[0]->month } ],
  91
  92     current_month_long  => [ $period_start_date->clone->truncate(to => 'month'),                        sub { $month_names[ $_[0]->month ] } ],
  93     previous_month_long => [ $period_start_date->clone->truncate(to => 'month')->subtract(months => 1), sub { $month_names[ $_[0]->month ] } ],
  94     next_month_long     => [ $period_start_date->clone->truncate(to => 'month')->add(     months => 1), sub { $month_names[ $_[0]->month ] } ],
  95
  96     current_year        => [ $period_start_date->clone->truncate(to => 'year'),                         sub { $_[0]->year } ],
  97     previous_year       => [ $period_start_date->clone->truncate(to => 'year')->subtract(years => 1),   sub { $_[0]->year } ],
  98     next_year           => [ $period_start_date->clone->truncate(to => 'year')->add(     years => 1),   sub { $_[0]->year } ],
  99
 100     period_start_date   => [ $period_start_date->clone->truncate(to => 'month'), sub { $::locale->format_date(\%::myconfig, $_[0]) } ],
 101     period_end_date     => [ $period_end_date,                                   sub { $::locale->format_date(\%::myconfig, $_[0]) } ],
 102   };
 103
 104   return $vars;
 105 }
 106
 107 sub _replace_vars {
 108   my (%params) = @_;
 109   my $sub      = $params{attribute};
 110   my $str      = $params{object}->$sub;
 111   my $sub_fmt  = lc($params{attribute_format} // 'text');
 112
 113   my ($start_tag, $end_tag) = $sub_fmt eq 'html' ? ('&lt;%', '%&gt;') : ('<%', '%>');
 114
 115   $str =~ s{ ${start_tag} ([a-z0-9_]+) ( \s+ format \s*=\s* (.*?) \s* )? ${end_tag} }{
 116     my ($key, $format) = ($1, $3);
 117     $key               = $::locale->unquote_special_chars('html', $key) if $sub_fmt eq 'html';
 118     my $new_value;
 119
 120     if (!$params{vars}->{$key}) {
 121       $new_value = '';
 122
 123     } elsif ($format) {
 124       $format    = $::locale->unquote_special_chars('html', $format) if $sub_fmt eq 'html';
 125
 126       $new_value = DateTime::Format::Strptime->new(
 127         pattern     => $format,
 128         locale      => 'de_DE',
 129         time_zone   => 'local',
 130       )->format_datetime($params{vars}->{$key}->[0]);
 131
 132     } else {
 133       $new_value = $params{vars}->{$1}->[1]->($params{vars}->{$1}->[0]);
 134     }
 135
 136     $new_value = $::locale->quote_special_chars('html', $new_value) if $sub_fmt eq 'html';
 137
 138     $new_value;
 139
 140   }eigx;
 141
 142   $params{object}->$sub($str);
 143 }
 144
 145 sub _adjust_sellprices_for_period_lengths {
 146   my (%params) = @_;
 147
 148   my $billing_len     = $params{config}->get_billing_period_length;
 149   my $order_value_len = $params{config}->get_order_value_period_length;
 150
 151   return if $billing_len == $order_value_len;
 152
 153   my $is_last_invoice_in_cycle = $params{config}->is_last_bill_date_in_order_value_cycle(date => $params{period_start_date});
 154
 155   _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");
 156
 157   if ($order_value_len < $billing_len) {
 158     my $num_orders_per_invoice = $billing_len / $order_value_len;
 159
 160     $_->sellprice($_->sellprice * $num_orders_per_invoice) for @{ $params{invoice}->items };
 161
 162     return;
 163   }
 164
 165   my $num_invoices_in_cycle = $order_value_len / $billing_len;
 166
 167   foreach my $item (@{ $params{invoice}->items }) {
 168     my $sellprice_one_invoice = $::form->round_amount($item->sellprice * $billing_len / $order_value_len, 2);
 169
 170     if ($is_last_invoice_in_cycle) {
 171       $item->sellprice($item->sellprice - ($num_invoices_in_cycle - 1) * $sellprice_one_invoice);
 172
 173     } else {
 174       $item->sellprice($sellprice_one_invoice);
 175     }
 176   }
 177 }
 178
 179 sub _create_periodic_invoice {
 180   $main::lxdebug->enter_sub();
 181
 182   my $self              = shift;
 183   my $config            = shift;
 184   my $period_start_date = shift;
 185
 186   my $time_period_vars  = _generate_time_period_variables($config, $period_start_date);
 187
 188   my $invdate           = DateTime->today_local;
 189
 190   my $order   = $config->order;
 191   my $invoice;
 192   if (!$self->{db_obj}->db->do_transaction(sub {
 193     1;                          # make Emacs happy
 194
 195     $invoice = SL::DB::Invoice->new_from($order);
 196
 197     my $intnotes  = $invoice->intnotes ? $invoice->intnotes . "\n\n" : '';
 198     $intnotes    .= "Automatisch am " . $invdate->to_lxoffice . " erzeugte Rechnung";
 199
 200     $invoice->assign_attributes(deliverydate => $period_start_date,
 201                                 intnotes     => $intnotes,
 202                                 employee     => $order->employee, # new_from sets employee to import user
 203                                );
 204
 205     _replace_vars(object => $invoice, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'notes' ? 'html' : 'text')) for qw(notes intnotes transaction_description);
 206
 207     foreach my $item (@{ $invoice->items }) {
 208       _replace_vars(object => $item, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'longdescription' ? 'html' : 'text')) for qw(description longdescription);
 209     }
 210
 211     _adjust_sellprices_for_period_lengths(invoice => $invoice, config => $config, period_start_date => $period_start_date);
 212
 213     $invoice->post(ar_id => $config->ar_chart_id) || die;
 214
 215     # like $form->add_shipto, but we don't need to check for a manual exception,
 216     # because we can already assume this (otherwise no shipto_id from order)
 217     if ($order->shipto_id) {
 218
 219       my $shipto_oe = SL::DB::Manager::Shipto->find_by(shipto_id => $order->shipto_id);
 220       my $shipto_ar = $shipto_oe->clone_and_reset;
 221
 222       $shipto_ar->module('AR');            # alter module OE -> AR
 223       $shipto_ar->trans_id($invoice->id);  # alter trans_id -> new id from invoice
 224       $shipto_ar->save;
 225     }
 226
 227     $order->link_to_record($invoice);
 228
 229     foreach my $item (@{ $invoice->items }) {
 230       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 231           if ($item->{"converted_from_${_}_id"}) {
 232             die unless $item->{id};
 233             RecordLinks->create_links('mode'       => 'ids',
 234                                       'from_table' => $_,
 235                                       'from_ids'   => $item->{"converted_from_${_}_id"},
 236                                       'to_table'   => 'invoice',
 237                                       'to_id'      => $item->{id},
 238             ) || die;
 239             delete $item->{"converted_from_${_}_id"};
 240          }
 241       }
 242     }
 243
 244     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 245                                  ar_id             => $invoice->id,
 246                                  period_start_date => $period_start_date)
 247       ->save;
 248
 249     _log_msg("_create_invoice created for period start date $period_start_date id " . $invoice->id . " number " . $invoice->invnumber . " netamount " . $invoice->netamount . " amount " . $invoice->amount);
 250
 251     # die $invoice->transaction_description;
 252   })) {
 253     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 254     return undef;
 255   }
 256   $main::lxdebug->leave_sub();
 257   return $invoice;
 258 }
 259
 260 sub _calculate_dates {
 261   my ($config) = @_;
 262   return $config->calculate_invoice_dates(end_date => DateTime->today_local);
 263 }
 264
 265 sub _send_email {
 266   my ($posted_invoices, $printed_invoices) = @_;
 267
 268   my %config = %::lx_office_conf;
 269
 270   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $posted_invoices };
 271
 272   my $user  = SL::DB::Manager::AuthUser->find_by(login => $config{periodic_invoices}->{send_email_to});
 273   my $email = $user ? $user->get_config_value('email') : undef;
 274
 275   return unless $email;
 276
 277   my $template = Template->new({ 'INTERPOLATE' => 0,
 278                                  'EVAL_PERL'   => 0,
 279                                  'ABSOLUTE'    => 1,
 280                                  'CACHE_SIZE'  => 0,
 281                                });
 282
 283   return unless $template;
 284
 285   my $email_template = $config{periodic_invoices}->{email_template};
 286   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/oe/periodic_invoices_email.txt" );
 287   my %params         = ( POSTED_INVOICES  => $posted_invoices,
 288                          PRINTED_INVOICES => $printed_invoices );
 289
 290   my $output;
 291   $template->process($filename, \%params, \$output);
 292
 293   my $mail              = Mailer->new;
 294   $mail->{from}         = $config{periodic_invoices}->{email_from};
 295   $mail->{to}           = $email;
 296   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 297   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 298   $mail->{message}      = $output;
 299
 300   $mail->send;
 301 }
 302
 303 sub _print_invoice {
 304   my ($invoice, $config) = @_;
 305
 306   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 307
 308   my $form = Form->new;
 309   $invoice->flatten_to_form($form, format_amounts => 1);
 310
 311   $form->{printer_code} = $config->printer->template_code;
 312   $form->{copies}       = $config->copies;
 313   $form->{formname}     = $form->{type};
 314   $form->{format}       = 'pdf';
 315   $form->{media}        = 'printer';
 316   $form->{OUT}          = $config->printer->printer_command;
 317   $form->{OUT_MODE}     = '|-';
 318
 319   $form->prepare_for_printing;
 320
 321   $form->throw_on_error(sub {
 322     eval {
 323       $form->parse_template(\%::myconfig);
 324       1;
 325     } || die $EVAL_ERROR->getMessage;
 326   });
 327 }
 328
 329 1;
 330
 331 __END__
 332
 333 =pod
 334
 335 =encoding utf8
 336
 337 =head1 NAME
 338
 339 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 340 invoices for orders
 341
 342 =head1 SYNOPSIS
 343
 344 Iterate over all periodic invoice configurations, extend them if
 345 applicable, calculate the dates for which invoices have to be posted
 346 and post those invoices by converting the order into an invoice for
 347 each date.
 348
 349 =head1 TOTO
 350
 351 =over 4
 352
 353 =item *
 354
 355 Strings like month names are hardcoded to German in this file.
 356
 357 =back
 358
 359 =head1 AUTHOR
 360
 361 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 362
 363 =cut