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