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