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