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 English qw(-no_match_vars);
   9
  10 use SL::DB::AuthUser;
  11 use SL::DB::Default;
  12 use SL::DB::Order;
  13 use SL::DB::Invoice;
  14 use SL::DB::PeriodicInvoice;
  15 use SL::DB::PeriodicInvoicesConfig;
  16 use SL::Mailer;
  17
  18 sub create_job {
  19   $_[0]->create_standard_job('0 3 1 * *'); # first day of month at 3:00 am
  20 }
  21
  22 sub run {
  23   my $self        = shift;
  24   $self->{db_obj} = shift;
  25
  26   my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(query => [ active => 1 ]);
  27
  28   foreach my $config (@{ $configs }) {
  29     my $new_end_date = $config->handle_automatic_extension;
  30     _log_msg("Periodic invoice configuration ID " . $config->id . " extended through " . $new_end_date->strftime('%d.%m.%Y') . "\n") if $new_end_date;
  31   }
  32
  33   my (@new_invoices, @invoices_to_print);
  34
  35   _log_msg("Number of configs: " . scalar(@{ $configs}));
  36
  37   foreach my $config (@{ $configs }) {
  38     # A configuration can be set to inactive by
  39     # $config->handle_automatic_extension. Therefore the check in
  40     # ...->get_all() does not suffice.
  41     _log_msg("Config " . $config->id . " active " . $config->active);
  42     next unless $config->active;
  43
  44     my @dates = _calculate_dates($config);
  45
  46     _log_msg("Dates: " . join(' ', map { $_->to_lxoffice } @dates));
  47
  48     foreach my $date (@dates) {
  49       my $invoice = $self->_create_periodic_invoice($config, $date);
  50       next unless $invoice;
  51
  52       _log_msg("Invoice " . $invoice->invnumber . " posted for config ID " . $config->id . ", period start date " . $::locale->format_date(\%::myconfig, $date) . "\n");
  53       push @new_invoices,      $invoice;
  54       push @invoices_to_print, [ $invoice, $config ] if $config->print;
  55
  56       # last;
  57     }
  58   }
  59
  60   map { _print_invoice(@{ $_ }) } @invoices_to_print;
  61
  62   _send_email(\@new_invoices, [ map { $_->[0] } @invoices_to_print ]) if @new_invoices;
  63
  64   return 1;
  65 }
  66
  67 sub _log_msg {
  68   my $message  = join('', @_);
  69   $message    .= "\n" unless $message =~ m/\n$/;
  70   $::lxdebug->message(LXDebug::DEBUG1(), $message);
  71 }
  72
  73 sub _generate_time_period_variables {
  74   my $config            = shift;
  75   my $period_start_date = shift;
  76   my $period_end_date   = $period_start_date->clone->truncate(to => 'month')->add(months => $config->get_period_length)->subtract(days => 1);
  77
  78   my @month_names       = ('',
  79                            $::locale->text('January'), $::locale->text('February'), $::locale->text('March'),     $::locale->text('April'),   $::locale->text('May'),      $::locale->text('June'),
  80                            $::locale->text('July'),    $::locale->text('August'),   $::locale->text('September'), $::locale->text('October'), $::locale->text('November'), $::locale->text('December'));
  81
  82   my $vars = { current_quarter     => $period_start_date->quarter,
  83                previous_quarter    => $period_start_date->clone->subtract(months => 3)->quarter,
  84                next_quarter        => $period_start_date->clone->add(     months => 3)->quarter,
  85
  86                current_month       => $period_start_date->month,
  87                previous_month      => $period_start_date->clone->subtract(months => 1)->month,
  88                next_month          => $period_start_date->clone->add(     months => 1)->month,
  89
  90                current_year        => $period_start_date->year,
  91                previous_year       => $period_start_date->year - 1,
  92                next_year           => $period_start_date->year + 1,
  93
  94                period_start_date   => $::locale->format_date(\%::myconfig, $period_start_date),
  95                period_end_date     => $::locale->format_date(\%::myconfig, $period_end_date),
  96              };
  97
  98   map { $vars->{"${_}_month_long"} = $month_names[ $vars->{"${_}_month"} ] } qw(current previous next);
  99
 100   return $vars;
 101 }
 102
 103 sub _replace_vars {
 104   my $object = shift;
 105   my $vars   = shift;
 106   my $sub    = shift;
 107   my $str    = $object->$sub;
 108
 109   my ($key, $value);
 110   $str =~ s|<\%${key}\%>|$value|g while ($key, $value) = each %{ $vars };
 111   $object->$sub($str);
 112 }
 113
 114 sub _create_periodic_invoice {
 115   my $self              = shift;
 116   my $config            = shift;
 117   my $period_start_date = shift;
 118
 119   my $time_period_vars  = _generate_time_period_variables($config, $period_start_date);
 120
 121   my $invdate           = DateTime->today_local;
 122
 123   my $order   = $config->order;
 124   my $invoice;
 125   if (!$self->{db_obj}->db->do_transaction(sub {
 126     1;                          # make Emacs happy
 127
 128     $invoice = SL::DB::Invoice->new_from($order);
 129
 130     my $intnotes  = $invoice->intnotes ? $invoice->intnotes . "\n\n" : '';
 131     $intnotes    .= "Automatisch am " . $invdate->to_lxoffice . " erzeugte Rechnung";
 132
 133     $invoice->assign_attributes(deliverydate => $period_start_date,
 134                                 intnotes     => $intnotes,
 135                                );
 136
 137     map { _replace_vars($invoice, $time_period_vars, $_) } qw(notes intnotes transaction_description);
 138
 139     foreach my $item (@{ $invoice->items }) {
 140       map { _replace_vars($item, $time_period_vars, $_) } qw(description longdescription);
 141     }
 142
 143     $invoice->post(ar_id => $config->ar_chart_id) || die;
 144
 145     # like $form->add_shipto, but we don't need to check for a manual exception,
 146     # because we can already assume this (otherwise no shipto_id from order)
 147     if ($order->shipto_id) {
 148
 149       my $shipto_oe = SL::DB::Manager::Shipto->find_by(shipto_id => $order->shipto_id);
 150       my $shipto_ar = $shipto_oe->clone_and_reset;
 151
 152       $shipto_ar->module('AR');            # alter module OE -> AR
 153       $shipto_ar->trans_id($invoice->id);  # alter trans_id -> new id from invoice
 154       $shipto_ar->save;
 155     }
 156
 157     $order->link_to_record($invoice);
 158
 159     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 160                                  ar_id             => $invoice->id,
 161                                  period_start_date => $period_start_date)
 162       ->save;
 163
 164     # die $invoice->transaction_description;
 165   })) {
 166     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 167     return undef;
 168   }
 169
 170   return $invoice;
 171 }
 172
 173 sub _calculate_dates {
 174   my $config     = shift;
 175
 176   my $cur_date   = $config->first_billing_date        || $config->start_date;
 177   my $start_date = $config->get_previous_invoice_date || DateTime->new(year => 1970, month => 1, day => 1);
 178   my $end_date   = $config->end_date                  || DateTime->new(year => 2100, month => 1, day => 1);
 179   my $tomorrow   = DateTime->today_local->add(days => 1);
 180   my $period_len = $config->get_period_length;
 181
 182   $end_date      = $tomorrow if $end_date > $tomorrow;
 183
 184   my @dates;
 185
 186   while (1) {
 187     last if $cur_date >= $end_date;
 188
 189     push @dates, $cur_date->clone if $cur_date > $start_date;
 190
 191     $cur_date->add(months => $period_len);
 192   }
 193
 194   return @dates;
 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") . "/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