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::Order;
  12 use SL::DB::Invoice;
  13 use SL::DB::PeriodicInvoice;
  14 use SL::DB::PeriodicInvoicesConfig;
  15 use SL::Mailer;
  16
  17 sub create_job {
  18   $_[0]->create_standard_job('0 3 1 * *'); # first day of month at 3:00 am
  19 }
  20
  21 sub run {
  22   my $self        = shift;
  23   $self->{db_obj} = shift;
  24
  25   my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(query => [ active => 1 ]);
  26
  27   foreach my $config (@{ $configs }) {
  28     my $new_end_date = $config->handle_automatic_extension;
  29     _log_msg("Periodic invoice configuration ID " . $config->id . " extended through " . $new_end_date->strftime('%d.%m.%Y') . "\n") if $new_end_date;
  30   }
  31
  32   my (@new_invoices, @invoices_to_print);
  33
  34   _log_msg("Number of configs: " . scalar(@{ $configs}));
  35
  36   foreach my $config (@{ $configs }) {
  37     # A configuration can be set to inactive by
  38     # $config->handle_automatic_extension. Therefore the check in
  39     # ...->get_all() does not suffice.
  40     _log_msg("Config " . $config->id . " active " . $config->active);
  41     next unless $config->active;
  42
  43     my @dates = _calculate_dates($config);
  44
  45     _log_msg("Dates: " . join(' ', map { $_->to_lxoffice } @dates));
  46
  47     foreach my $date (@dates) {
  48       my $invoice = $self->_create_periodic_invoice($config, $date);
  49       next unless $invoice;
  50
  51       _log_msg("Invoice " . $invoice->invnumber . " posted for config ID " . $config->id . ", period start date " . $::locale->format_date(\%::myconfig, $date) . "\n");
  52       push @new_invoices,      $invoice;
  53       push @invoices_to_print, [ $invoice, $config ] if $config->print;
  54
  55       # last;
  56     }
  57   }
  58
  59   map { _print_invoice(@{ $_ }) } @invoices_to_print;
  60
  61   _send_email(\@new_invoices, [ map { $_->[0] } @invoices_to_print ]) if @new_invoices;
  62
  63   return 1;
  64 }
  65
  66 sub _log_msg {
  67   # my $message  = join('', @_);
  68   # $message    .= "\n" unless $message =~ m/\n$/;
  69   # $::lxdebug->message(0, $message);
  70 }
  71
  72 sub _generate_time_period_variables {
  73   my $config            = shift;
  74   my $period_start_date = shift;
  75   my $period_end_date   = $period_start_date->clone->truncate(to => 'month')->add(months => $config->get_period_length)->subtract(days => 1);
  76
  77   my @month_names       = ('',
  78                            'Januar', 'Februar', 'März',      'April',   'Mai',      'Juni',
  79                            'Juli',   'August',  'September', 'Oktober', 'November', 'Dezember');
  80
  81   my $vars = { current_quarter     => $period_start_date->quarter,
  82                previous_quarter    => $period_start_date->clone->subtract(months => 3)->quarter,
  83                next_quarter        => $period_start_date->clone->add(     months => 3)->quarter,
  84
  85                current_month       => $period_start_date->month,
  86                previous_month      => $period_start_date->clone->subtract(months => 1)->month,
  87                next_month          => $period_start_date->clone->add(     months => 1)->month,
  88
  89                current_year        => $period_start_date->year,
  90                previous_year       => $period_start_date->year - 1,
  91                next_year           => $period_start_date->year + 1,
  92
  93                period_start_date   => $::locale->format_date(\%::myconfig, $period_start_date),
  94                period_end_date     => $::locale->format_date(\%::myconfig, $period_end_date),
  95              };
  96
  97   map { $vars->{"${_}_month_long"} = $month_names[ $vars->{"${_}_month"} ] } qw(current previous next);
  98
  99   return $vars;
 100 }
 101
 102 sub _replace_vars {
 103   my $object = shift;
 104   my $vars   = shift;
 105   my $sub    = shift;
 106   my $str    = $object->$sub;
 107
 108   my ($key, $value);
 109   $str =~ s|<\%${key}\%>|$value|g while ($key, $value) = each %{ $vars };
 110   $object->$sub($str);
 111 }
 112
 113 sub _create_periodic_invoice {
 114   my $self              = shift;
 115   my $config            = shift;
 116   my $period_start_date = shift;
 117
 118   my $time_period_vars  = _generate_time_period_variables($config, $period_start_date);
 119
 120   my $invdate           = DateTime->today_local;
 121
 122   my $order   = $config->order;
 123   my $invoice;
 124   if (!$self->{db_obj}->db->do_transaction(sub {
 125     1;                          # make Emacs happy
 126
 127     $invoice = SL::DB::Invoice->new_from($order);
 128
 129     my $intnotes  = $invoice->intnotes ? $invoice->intnotes . "\n\n" : '';
 130     $intnotes    .= "Automatisch am " . $invdate->to_lxoffice . " erzeugte Rechnung";
 131
 132     $invoice->assign_attributes(deliverydate => $period_start_date,
 133                                 intnotes     => $intnotes,
 134                                );
 135
 136     map { _replace_vars($invoice, $time_period_vars, $_) } qw(notes intnotes transaction_description);
 137
 138     foreach my $item (@{ $invoice->items }) {
 139       map { _replace_vars($item, $time_period_vars, $_) } qw(description longdescription);
 140     }
 141
 142     $invoice->post(ar_id => $config->ar_chart_id) || die;
 143
 144     $order->link_to_record($invoice);
 145
 146     SL::DB::PeriodicInvoice->new(config_id         => $config->id,
 147                                  ar_id             => $invoice->id,
 148                                  period_start_date => $period_start_date)
 149       ->save;
 150
 151     # die $invoice->transaction_description;
 152   })) {
 153     $::lxdebug->message(LXDebug->WARN(), "_create_invoice failed: " . join("\n", (split(/\n/, $self->{db_obj}->db->error))[0..2]));
 154     return undef;
 155   }
 156
 157   return $invoice;
 158 }
 159
 160 sub _calculate_dates {
 161   my $config     = shift;
 162
 163   my $cur_date   = $config->start_date;
 164   my $start_date = $config->get_previous_invoice_date || DateTime->new(year => 1970, month => 1, day => 1);
 165   my $end_date   = $config->end_date                  || DateTime->new(year => 2100, month => 1, day => 1);
 166   my $tomorrow   = DateTime->today_local->add(days => 1);
 167   my $period_len = $config->get_period_length;
 168
 169   $end_date      = $tomorrow if $end_date > $tomorrow;
 170
 171   my @dates;
 172
 173   while (1) {
 174     last if $cur_date >= $end_date;
 175
 176     push @dates, $cur_date->clone if $cur_date > $start_date;
 177
 178     $cur_date->add(months => $period_len);
 179   }
 180
 181   return @dates;
 182 }
 183
 184 sub _send_email {
 185   my ($posted_invoices, $printed_invoices) = @_;
 186
 187   my %config = %::lx_office_conf;
 188
 189   return if !$config{periodic_invoices} || !$config{periodic_invoices}->{send_email_to} || !scalar @{ $posted_invoices };
 190
 191   my $user  = SL::DB::Manager::AuthUser->find_by(login => $config{periodic_invoices}->{send_email_to});
 192   my $email = $user ? $user->get_config_value('email') : undef;
 193
 194   return unless $email;
 195
 196   my $template = Template->new({ 'INTERPOLATE' => 0,
 197                                  'EVAL_PERL'   => 0,
 198                                  'ABSOLUTE'    => 1,
 199                                  'CACHE_SIZE'  => 0,
 200                                });
 201
 202   return unless $template;
 203
 204   my $email_template = $config{periodic_invoices}->{email_template};
 205   my $filename       = $email_template || ( ($user->get_config_value('templates') || "templates/webpages") . "/periodic_invoices_email.txt" );
 206   my %params         = ( POSTED_INVOICES  => $posted_invoices,
 207                          PRINTED_INVOICES => $printed_invoices );
 208
 209   my $output;
 210   $template->process($filename, \%params, \$output);
 211
 212   my $mail              = Mailer->new;
 213   $mail->{from}         = $config{periodic_invoices}->{email_from};
 214   $mail->{to}           = $email;
 215   $mail->{subject}      = $config{periodic_invoices}->{email_subject};
 216   $mail->{content_type} = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
 217   $mail->{message}      = $output;
 218
 219   $mail->send;
 220 }
 221
 222 sub _print_invoice {
 223   my ($invoice, $config) = @_;
 224
 225   return unless $config->print && $config->printer_id && $config->printer->printer_command;
 226
 227   my $form = Form->new;
 228   $invoice->flatten_to_form($form, format_amounts => 1);
 229
 230   $form->{printer_code} = $config->printer->template_code;
 231   $form->{copies}       = $config->copies;
 232   $form->{formname}     = $form->{type};
 233   $form->{format}       = 'pdf';
 234   $form->{media}        = 'printer';
 235   $form->{OUT}          = "| " . $config->printer->printer_command;
 236
 237   $form->prepare_for_printing;
 238
 239   $form->throw_on_error(sub {
 240     eval {
 241       $form->parse_template(\%::myconfig);
 242       1;
 243     } || die $EVAL_ERROR->getMessage;
 244   });
 245 }
 246
 247 1;
 248
 249 __END__
 250
 251 =pod
 252
 253 =encoding utf8
 254
 255 =head1 NAME
 256
 257 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 258 invoices for orders
 259
 260 =head1 SYNOPSIS
 261
 262 Iterate over all periodic invoice configurations, extend them if
 263 applicable, calculate the dates for which invoices have to be posted
 264 and post those invoices by converting the order into an invoice for
 265 each date.
 266
 267 =head1 TOTO
 268
 269 =over 4
 270
 271 =item *
 272
 273 Strings like month names are hardcoded to German in this file.
 274
 275 =back
 276
 277 =head1 AUTHOR
 278
 279 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 280
 281 =cut