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