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                                 direct_debit => $config->direct_debit,
 204                                );
 205
 206     _replace_vars(object => $invoice, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'notes' ? 'html' : 'text')) for qw(notes intnotes transaction_description);
 207
 208     foreach my $item (@{ $invoice->items }) {
 209       _replace_vars(object => $item, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'longdescription' ? 'html' : 'text')) for qw(description longdescription);
 210     }
 211
 212     _adjust_sellprices_for_period_lengths(invoice => $invoice, config => $config, period_start_date => $period_start_date);
 213
 214     $invoice->post(ar_id => $config->ar_chart_id) || die;
 215
 216     # like $form->add_shipto, but we don't need to check for a manual exception,
 217     # because we can already assume this (otherwise no shipto_id from order)
 218     if ($order->shipto_id) {
 219
 220       my $shipto_oe = SL::DB::Manager::Shipto->find_by(shipto_id => $order->shipto_id);
 221       my $shipto_ar = $shipto_oe->clone_and_reset;
 222
 223       $shipto_ar->module('AR');            # alter module OE -> AR
 224       $shipto_ar->trans_id($invoice->id);  # alter trans_id -> new id from invoice
 225       $shipto_ar->save;
 226     }
 227
 228     $order->link_to_record($invoice);
 229
 230     foreach my $item (@{ $invoice->items }) {
 231       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 232           if ($item->{"converted_from_${_}_id"}) {
 233             die unless $item->{id};
 234             RecordLinks->create_links('mode'       => 'ids',
 235                                       'from_table' => $_,
 236                                       'from_ids'   => $item->{"converted_from_${_}_id"},
 237                                       'to_table'   => 'invoice',
 238                                       'to_id'      => $item->{id},
 239             ) || die;
 240             delete $item->{"converted_from_${_}_id"};
 241          }
 242       }
 243     }
 244
 245     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 246                                  ar_id             => $invoice->id,
 247                                  period_start_date => $period_start_date)
 248       ->save;
 249
 250     _log_msg("_create_invoice created for period start date $period_start_date id " . $invoice->id . " number " . $invoice->invnumber . " netamount " . $invoice->netamount . " amount " . $invoice->amount);
 251
 252     # die $invoice->transaction_description;
 253   })) {
 254     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 255     return undef;
 256   }
 257   $main::lxdebug->leave_sub();
 258   return $invoice;
 259 }
 260
 261 sub _calculate_dates {
 262   my ($config) = @_;
 263   return $config->calculate_invoice_dates(end_date => DateTime->today_local);
 264 }
 265
 266 sub _send_email {
 267   my ($posted_invoices, $printed_invoices) = @_;
 268
 269   my %config = %::lx_office_conf;
 270
 271   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $posted_invoices };
 272
 273   my $user  = SL::DB::Manager::AuthUser->find_by(login => $config{periodic_invoices}->{send_email_to});
 274   my $email = $user ? $user->get_config_value('email') : undef;
 275
 276   return unless $email;
 277
 278   my $template = Template->new({ 'INTERPOLATE' => 0,
 279                                  'EVAL_PERL'   => 0,
 280                                  'ABSOLUTE'    => 1,
 281                                  'CACHE_SIZE'  => 0,
 282                                });
 283
 284   return unless $template;
 285
 286   my $email_template = $config{periodic_invoices}->{email_template};
 287   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/oe/periodic_invoices_email.txt" );
 288   my %params         = ( POSTED_INVOICES  => $posted_invoices,
 289                          PRINTED_INVOICES => $printed_invoices );
 290
 291   my $output;
 292   $template->process($filename, \%params, \$output);
 293
 294   my $mail              = Mailer->new;
 295   $mail->{from}         = $config{periodic_invoices}->{email_from};
 296   $mail->{to}           = $email;
 297   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 298   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 299   $mail->{message}      = $output;
 300
 301   $mail->send;
 302 }
 303
 304 sub _print_invoice {
 305   my ($invoice, $config) = @_;
 306
 307   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 308
 309   my $form = Form->new;
 310   $invoice->flatten_to_form($form, format_amounts => 1);
 311
 312   $form->{printer_code} = $config->printer->template_code;
 313   $form->{copies}       = $config->copies;
 314   $form->{formname}     = $form->{type};
 315   $form->{format}       = 'pdf';
 316   $form->{media}        = 'printer';
 317   $form->{OUT}          = $config->printer->printer_command;
 318   $form->{OUT_MODE}     = '|-';
 319
 320   $form->{TEMPLATE_DRIVER_OPTIONS} = {
 321     variable_content_types => {
 322       longdescription => 'html',
 323       partnotes       => 'html',
 324       notes           => 'html',
 325     },
 326   };
 327
 328   $form->prepare_for_printing;
 329
 330   $form->throw_on_error(sub {
 331     eval {
 332       $form->parse_template(\%::myconfig);
 333       1;
 334     } || die $EVAL_ERROR->getMessage;
 335   });
 336 }
 337
 338 1;
 339
 340 __END__
 341
 342 =pod
 343
 344 =encoding utf8
 345
 346 =head1 NAME
 347
 348 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 349 invoices for orders
 350
 351 =head1 SYNOPSIS
 352
 353 Iterate over all periodic invoice configurations, extend them if
 354 applicable, calculate the dates for which invoices have to be posted
 355 and post those invoices by converting the order into an invoice for
 356 each date.
 357
 358 =head1 TOTO
 359
 360 =over 4
 361
 362 =item *
 363
 364 Strings like month names are hardcoded to German in this file.
 365
 366 =back
 367
 368 =head1 AUTHOR
 369
 370 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 371
 372 =cut