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) = @_;
 192   return $config->calculate_invoice_dates(end_date => DateTime->today_local->add(days => 1));
 193 }
 194
 195 sub _send_email {
 196   my ($posted_invoices, $printed_invoices) = @_;
 197
 198   my %config = %::lx_office_conf;
 199
 200   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $posted_invoices };
 201
 202   my $user  = SL::DB::Manager::AuthUser->find_by(login => $config{periodic_invoices}->{send_email_to});
 203   my $email = $user ? $user->get_config_value('email') : undef;
 204
 205   return unless $email;
 206
 207   my $template = Template->new({ 'INTERPOLATE' => 0,
 208                                  'EVAL_PERL'   => 0,
 209                                  'ABSOLUTE'    => 1,
 210                                  'CACHE_SIZE'  => 0,
 211                                });
 212
 213   return unless $template;
 214
 215   my $email_template = $config{periodic_invoices}->{email_template};
 216   my $filename       = $email_template || ( (SL::DB::Default->get->templates || "templates/webpages") . "/periodic_invoices_email.txt" );
 217   my %params         = ( POSTED_INVOICES  => $posted_invoices,
 218                          PRINTED_INVOICES => $printed_invoices );
 219
 220   my $output;
 221   $template->process($filename, \%params, \$output);
 222
 223   my $mail              = Mailer->new;
 224   $mail->{from}         = $config{periodic_invoices}->{email_from};
 225   $mail->{to}           = $email;
 226   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 227   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 228   $mail->{message}      = $output;
 229
 230   $mail->send;
 231 }
 232
 233 sub _print_invoice {
 234   my ($invoice, $config) = @_;
 235
 236   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 237
 238   my $form = Form->new;
 239   $invoice->flatten_to_form($form, format_amounts => 1);
 240
 241   $form->{printer_code} = $config->printer->template_code;
 242   $form->{copies}       = $config->copies;
 243   $form->{formname}     = $form->{type};
 244   $form->{format}       = 'pdf';
 245   $form->{media}        = 'printer';
 246   $form->{OUT}          = $config->printer->printer_command;
 247   $form->{OUT_MODE}     = '|-';
 248
 249   $form->prepare_for_printing;
 250
 251   $form->throw_on_error(sub {
 252     eval {
 253       $form->parse_template(\%::myconfig);
 254       1;
 255     } || die $EVAL_ERROR->getMessage;
 256   });
 257 }
 258
 259 1;
 260
 261 __END__
 262
 263 =pod
 264
 265 =encoding utf8
 266
 267 =head1 NAME
 268
 269 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 270 invoices for orders
 271
 272 =head1 SYNOPSIS
 273
 274 Iterate over all periodic invoice configurations, extend them if
 275 applicable, calculate the dates for which invoices have to be posted
 276 and post those invoices by converting the order into an invoice for
 277 each date.
 278
 279 =head1 TOTO
 280
 281 =over 4
 282
 283 =item *
 284
 285 Strings like month names are hardcoded to German in this file.
 286
 287 =back
 288
 289 =head1 AUTHOR
 290
 291 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 292
 293 =cut