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                            $::locale->text('January'), $::locale->text('February'), $::locale->text('March'),     $::locale->text('April'),   $::locale->text('May'),      $::locale->text('June'),
  79                            $::locale->text('July'),    $::locale->text('August'),   $::locale->text('September'), $::locale->text('October'), $::locale->text('November'), $::locale->text('December'));
  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   $form->{OUT_MODE}     = '|-';
 237
 238   $form->prepare_for_printing;
 239
 240   $form->throw_on_error(sub {
 241     eval {
 242       $form->parse_template(\%::myconfig);
 243       1;
 244     } || die $EVAL_ERROR->getMessage;
 245   });
 246 }
 247
 248 1;
 249
 250 __END__
 251
 252 =pod
 253
 254 =encoding utf8
 255
 256 =head1 NAME
 257
 258 SL::BackgroundJob::CleanBackgroundJobHistory - Create periodic
 259 invoices for orders
 260
 261 =head1 SYNOPSIS
 262
 263 Iterate over all periodic invoice configurations, extend them if
 264 applicable, calculate the dates for which invoices have to be posted
 265 and post those invoices by converting the order into an invoice for
 266 each date.
 267
 268 =head1 TOTO
 269
 270 =over 4
 271
 272 =item *
 273
 274 Strings like month names are hardcoded to German in this file.
 275
 276 =back
 277
 278 =head1 AUTHOR
 279
 280 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 281
 282 =cut