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