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