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('', @_);
  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_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 _create_periodic_invoice {
 146   $main::lxdebug->enter_sub();
 147
 148   my $self              = shift;
 149   my $config            = shift;
 150   my $period_start_date = shift;
 151
 152   my $time_period_vars  = _generate_time_period_variables($config, $period_start_date);
 153
 154   my $invdate           = DateTime->today_local;
 155
 156   my $order   = $config->order;
 157   my $invoice;
 158   if (!$self->{db_obj}->db->do_transaction(sub {
 159     1;                          # make Emacs happy
 160
 161     $invoice = SL::DB::Invoice->new_from($order);
 162
 163     my $intnotes  = $invoice->intnotes ? $invoice->intnotes . "\n\n" : '';
 164     $intnotes    .= "Automatisch am " . $invdate->to_lxoffice . " erzeugte Rechnung";
 165
 166     $invoice->assign_attributes(deliverydate => $period_start_date,
 167                                 intnotes     => $intnotes,
 168                                 employee     => $order->employee, # new_from sets employee to import user
 169                                );
 170
 171     _replace_vars(object => $invoice, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'notes' ? 'html' : 'text')) for qw(notes intnotes transaction_description);
 172
 173     foreach my $item (@{ $invoice->items }) {
 174       _replace_vars(object => $item, vars => $time_period_vars, attribute => $_, attribute_format => ($_ eq 'longdescription' ? 'html' : 'text')) for qw(description longdescription);
 175     }
 176
 177     $invoice->post(ar_id => $config->ar_chart_id) || die;
 178
 179     # like $form->add_shipto, but we don't need to check for a manual exception,
 180     # because we can already assume this (otherwise no shipto_id from order)
 181     if ($order->shipto_id) {
 182
 183       my $shipto_oe = SL::DB::Manager::Shipto->find_by(shipto_id => $order->shipto_id);
 184       my $shipto_ar = $shipto_oe->clone_and_reset;
 185
 186       $shipto_ar->module('AR');            # alter module OE -> AR
 187       $shipto_ar->trans_id($invoice->id);  # alter trans_id -> new id from invoice
 188       $shipto_ar->save;
 189     }
 190
 191     $order->link_to_record($invoice);
 192
 193     foreach my $item (@{ $invoice->items }) {
 194       foreach (qw(orderitems)) {    # expand if needed (delivery_order_items)
 195           if ($item->{"converted_from_${_}_id"}) {
 196             die unless $item->{id};
 197             RecordLinks->create_links('mode'       => 'ids',
 198                                       'from_table' => $_,
 199                                       'from_ids'   => $item->{"converted_from_${_}_id"},
 200                                       'to_table'   => 'invoice',
 201                                       'to_id'      => $item->{id},
 202             ) || die;
 203             delete $item->{"converted_from_${_}_id"};
 204          }
 205       }
 206     }
 207
 208     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 209                                  ar_id             => $invoice->id,
 210                                  period_start_date => $period_start_date)
 211       ->save;
 212
 213     # die $invoice->transaction_description;
 214   })) {
 215     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 216     return undef;
 217   }
 218   $main::lxdebug->leave_sub();
 219   return $invoice;
 220 }
 221
 222 sub _calculate_dates {
 223   my ($config) = @_;
 224   return $config->calculate_invoice_dates(end_date => DateTime->today_local);
 225 }
 226
 227 sub _send_email {
 228   my ($posted_invoices, $printed_invoices) = @_;
 229
 230   my %config = %::lx_office_conf;
 231
 232   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $posted_invoices };
 233
 234   my $user  = SL::DB::Manager::AuthUser->find_by(login => $config{periodic_invoices}->{send_email_to});
 235   my $email = $user ? $user->get_config_value('email') : undef;
 236
 237   return unless $email;
 238
 239   my $template = Template->new({ 'INTERPOLATE' => 0,
 240                                  'EVAL_PERL'   => 0,
 241                                  'ABSOLUTE'    => 1,
 242                                  'CACHE_SIZE'  => 0,
 243                                });
 244
 245   return unless $template;
 246
 247   my $email_template = $config{periodic_invoices}->{email_template};
 248   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/oe/periodic_invoices_email.txt" );
 249   my %params         = ( POSTED_INVOICES  => $posted_invoices,
 250                          PRINTED_INVOICES => $printed_invoices );
 251
 252   my $output;
 253   $template->process($filename, \%params, \$output);
 254
 255   my $mail              = Mailer->new;
 256   $mail->{from}         = $config{periodic_invoices}->{email_from};
 257   $mail->{to}           = $email;
 258   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 259   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 260   $mail->{message}      = $output;
 261
 262   $mail->send;
 263 }
 264
 265 sub _print_invoice {
 266   my ($invoice, $config) = @_;
 267
 268   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 269
 270   my $form = Form->new;
 271   $invoice->flatten_to_form($form, format_amounts => 1);
 272
 273   $form->{printer_code} = $config->printer->template_code;
 274   $form->{copies}       = $config->copies;
 275   $form->{formname}     = $form->{type};
 276   $form->{format}       = 'pdf';
 277   $form->{media}        = 'printer';
 278   $form->{OUT}          = $config->printer->printer_command;
 279   $form->{OUT_MODE}     = '|-';
 280
 281   $form->prepare_for_printing;
 282
 283   $form->throw_on_error(sub {
 284     eval {
 285       $form->parse_template(\%::myconfig);
 286       1;
 287     } || die $EVAL_ERROR->getMessage;
 288   });
 289 }
 290
 291 1;
 292
 293 __END__
 294
 295 =pod
 296
 297 =encoding utf8
 298
 299 =head1 NAME
 300
 301 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 302 invoices for orders
 303
 304 =head1 SYNOPSIS
 305
 306 Iterate over all periodic invoice configurations, extend them if
 307 applicable, calculate the dates for which invoices have to be posted
 308 and post those invoices by converting the order into an invoice for
 309 each date.
 310
 311 =head1 TOTO
 312
 313 =over 4
 314
 315 =item *
 316
 317 Strings like month names are hardcoded to German in this file.
 318
 319 =back
 320
 321 =head1 AUTHOR
 322
 323 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 324
 325 =cut