SL/LiquidityProjection.pm

   1 package SL::LiquidityProjection;
   2
   3 use strict;
   4
   5 use List::MoreUtils qw(uniq);
   6
   7 use SL::DBUtils;
   8 use SL::DB::PeriodicInvoicesConfig;
   9
  10 sub new {
  11   my $package       = shift;
  12   my $self          = bless {}, $package;
  13
  14   my %params        = @_;
  15
  16   $self->{params}   = \%params;
  17
  18   my @now           = localtime;
  19   my $now_year      = $now[5] + 1900;
  20   my $now_month     = $now[4] + 1;
  21
  22   $self->{min_date} = _the_date($now_year, $now_month);
  23   $self->{max_date} = _the_date($now_year, $now_month + $params{months} - 1);
  24
  25   $self;
  26 }
  27
  28 # Algorithmus:
  29 #
  30 # Für den aktuellen Monat und alle x Folgemonate soll der geplante
  31 # Liquiditätszufluss aufgeschlüsselt werden. Der Zufluss berechnet
  32 # sich dabei aus:
  33 #
  34 # 1. Summe aller offenen Auträge
  35 #
  36 # 2. abzüglich aller zu diesen Aufträgen erstellten Rechnungen
  37 # (Teillieferungen/Teilrechnungen)
  38 #
  39 # 3. zuzüglich alle aktiven Wartungsverträge, die in dem jeweiligen
  40 # Monat ihre Saldierungsperiode haben, außer Wartungsverträgen, die
  41 # für den jeweiligen Monat bereits abgerechnet wurden.
  42 #
  43 # Diese Werte sollen zusätzlich optional nach Verkäufer(in),
  44 # Buchungsgruppe und Warengruppe aufgeschlüsselt werden.
  45 #
  46 # Diese Lösung geht deshalb immer über die Positionen der Belege
  47 # (wegen der Buchungsgruppen & Warengruppen) und berechnet die Summen
  48 # daraus manuell.
  49 #
  50 # Alle Aufträge, deren Lieferdatum leer ist, oder deren Lieferdatum
  51 # vor dem aktuellen Monat liegt, werden in einer Kategorie 'alt'
  52 # zusammengefasst.
  53 #
  54 # Alle Aufträge, deren Lieferdatum nach dem zu betrachtenden Zeitraum
  55 # (aktueller Monat + x Monate) liegen, werden in einer Kategorie
  56 # 'Zukunft' zusammengefasst.
  57 #
  58 # Insgesamt läuft es wie folgt ab:
  59 #
  60 # 1. Es wird das Datum aller periodisch erzeugten Rechnungen innerhalb
  61 # des Betrachtungszeitraumes herausgesucht.
  62 #
  63 # 2. Alle aktiven Wartungsvertragskonfigurationen werden
  64 # ausgelesen. Die Saldierungsmonate werden solange aufaddiert, wie der
  65 # dabei herauskommende Monat nicht nach dem zu betrachtenden Zeitraum
  66 # liegt.
  67 #
  68 # 3. Für jedes Saldierungsintervall, das innerhalb des
  69 # Betrachtungszeitraumes liegt, und für das es für den Monat noch
  70 # keine Rechnung gibt (siehe 1.), wird diese Konfiguration für den
  71 # Monat vorgemerkt.
  72 #
  73 # 4. Es werden für alle offenen Kundenaufträge die Positionen
  74 # ausgelesen und mit Verkäufer(in), Buchungsgruppe, Warengruppe
  75 # verknüpft. Aus Menge, Einzelpreis und Zeilenrabatt wird die
  76 # Zeilensumme berechnet.
  77 #
  78 # 5. Mit den Informationen aus 3. und 4. werden Datenstrukturen
  79 # initialisiert, die für die Gesamtsummen, für alle Verkäufer(innen),
  80 # für alle Buchungsgruppen, für alle Warengruppen, für alle Monate
  81 # Werte enthalten.
  82 #
  83 # 6. Es wird über alle Einträge aus 4. iteriert. Die Zeilensummen
  84 # werden in den entsprechenden Datenstrukturen aus 5. addiert.
  85 #
  86 # 7. Es wird über alle Einträge aus 3. iteriert. Die Zeilensummen
  87 # werden in den entsprechenden Datenstrukturen aus 5. addiert.
  88 #
  89 # 8. Es werden alle Rechnungspositionen ausgelesen, bei denen die
  90 # Auftragsnummer einer der aus 5. ermittelten Aufträge entspricht.
  91 #
  92 # 9. Es wird über alle Einträge aus 8. iteriert. Die Zeilensummen
  93 # werden von den entsprechenden Datenstrukturen aus 5. abgezogen. Als
  94 # Datum wird dabei das Datum des zu der Rechnung gehörenden Auftrages
  95 # genommen. Als Buchungsgruppe wird die Buchungsgruppe der Zeile
  96 # genommen. Falls es passieren sollte, dass diese Buchungsgruppe in
  97 # den Aufträgen nie vorgekommen ist (sprich Rechnung enthält
  98 # Positionen, die im Auftrag nicht enthalten sind, und die komplett
  99 # andere Buchungsgruppen verwenden), so wird schlicht die allererste
 100 # in 4. gefundene Buchungsgruppe damit belastet. Analog passiert dies
 101 # auch für Warengruppen.
 102
 103 sub create {
 104   my ($self)   = @_;
 105   my %params   = %{ $self->{params} };
 106
 107   my $dbh      = $params{dbh} || $::form->get_standard_dbh;
 108   my ($sth, $ref, $query);
 109
 110   $params{months} ||= 6;
 111
 112   # 1. Auslesen aller erzeugten periodischen Rechnungen im
 113   # Betrachtungszeitraum
 114   my $q_min_date = $dbh->quote($self->{min_date} . '-01');
 115   $query         = <<SQL;
 116     SELECT pi.config_id, to_char(pi.period_start_date, 'YYYY-MM') AS period_start_date
 117     FROM periodic_invoices pi
 118     LEFT JOIN periodic_invoices_configs pcfg ON (pi.config_id = pcfg.id)
 119     WHERE pcfg.active
 120       AND NOT pcfg.periodicity = 'o'
 121       AND (pi.period_start_date >= to_date($q_min_date, 'YYYY-MM-DD'))
 122 SQL
 123
 124   my %periodic_invoices;
 125   $sth = prepare_execute_query($::form, $dbh, $query);
 126   while ($ref = $sth->fetchrow_hashref) {
 127     $periodic_invoices{ $ref->{config_id} }                                ||= { };
 128     $periodic_invoices{ $ref->{config_id} }->{ $ref->{period_start_date} }   = 1;
 129   }
 130   $sth->finish;
 131
 132   # 2. Auslesen aktiver Wartungsvertragskonfigurationen
 133   $query = <<SQL;
 134     SELECT (oi.qty * (1 - oi.discount) * oi.sellprice) AS linetotal, oi.recurring_billing_mode,
 135       bg.description AS buchungsgruppe,
 136       pg.partsgroup AS parts_group,
 137       CASE WHEN COALESCE(e.name, '') = '' THEN e.login ELSE e.name END AS salesman,
 138       pcfg.periodicity, pcfg.order_value_periodicity, pcfg.id AS config_id,
 139       EXTRACT(year FROM pcfg.start_date) AS start_year, EXTRACT(month FROM pcfg.start_date) AS start_month
 140     FROM orderitems oi
 141     LEFT JOIN oe                             ON (oi.trans_id                              = oe.id)
 142     LEFT JOIN periodic_invoices_configs pcfg ON (oi.trans_id                              = pcfg.oe_id)
 143     LEFT JOIN parts p                        ON (oi.parts_id                              = p.id)
 144     LEFT JOIN buchungsgruppen bg             ON (p.buchungsgruppen_id                     = bg.id)
 145     LEFT JOIN partsgroup pg                  ON (p.partsgroup_id                          = pg.id)
 146     LEFT JOIN employee e                     ON (COALESCE(oe.salesman_id, oe.employee_id) = e.id)
 147     WHERE pcfg.active
 148       AND (pcfg.periodicity <> 'o')
 149       AND (   (oi.recurring_billing_mode = 'always')
 150            OR (    (oi.recurring_billing_mode = 'once')
 151                AND (oi.recurring_billing_invoice_id IS NULL)))
 152 SQL
 153
 154   # 3. Iterieren über Saldierungsintervalle, vormerken
 155   my @scentries;
 156   $sth = prepare_execute_query($::form, $dbh, $query);
 157   while ($ref = $sth->fetchrow_hashref) {
 158     my ($year, $month) = ($ref->{start_year}, $ref->{start_month});
 159     my $date;
 160
 161     while (($date = _the_date($year, $month)) le $self->{max_date}) {
 162       my $billing_len = $SL::DB::PeriodicInvoicesConfig::PERIOD_LENGTHS{ $ref->{periodicity} } || 1;
 163
 164       if (($date ge $self->{min_date}) && (!$periodic_invoices{ $ref->{config_id} } || !$periodic_invoices{ $ref->{config_id} }->{$date})) {
 165         if ($ref->{recurring_billing_mode} eq 'once') {
 166           push @scentries, { buchungsgruppe => $ref->{buchungsgruppe},
 167                              salesman       => $ref->{salesman},
 168                              linetotal      => $ref->{linetotal},
 169                              date           => $date,
 170                            };
 171           last;
 172         }
 173
 174         my $order_value_periodicity = $ref->{order_value_periodicity} eq 'p' ? $ref->{periodicity} : $ref->{order_value_periodicity};
 175         my $order_value_len         = $SL::DB::PeriodicInvoicesConfig::ORDER_VALUE_PERIOD_LENGTHS{$order_value_periodicity} || 1;
 176
 177         push @scentries, { buchungsgruppe => $ref->{buchungsgruppe},
 178                            salesman       => $ref->{salesman},
 179                            linetotal      => $ref->{linetotal} * $billing_len / $order_value_len,
 180                            date           => $date,
 181                            parts_group    => $ref->{parts_group},
 182                          };
 183       }
 184
 185       ($year, $month) = _fix_date($year, $month + $billing_len);
 186     }
 187   }
 188   $sth->finish;
 189
 190   # 4. Auslesen offener Aufträge
 191   $query = <<SQL;
 192     SELECT (oi.qty * (1 - oi.discount) * oi.sellprice) AS linetotal,
 193       bg.description AS buchungsgruppe,
 194       pg.partsgroup AS parts_group,
 195       CASE WHEN COALESCE(e.name, '') = '' THEN e.login ELSE e.name END AS salesman,
 196       oe.ordnumber, EXTRACT(month FROM oe.reqdate) AS month, EXTRACT(year  FROM oe.reqdate) AS year
 197     FROM orderitems oi
 198     LEFT JOIN oe                 ON (oi.trans_id                              = oe.id)
 199     LEFT JOIN parts p            ON (oi.parts_id                              = p.id)
 200     LEFT JOIN buchungsgruppen bg ON (p.buchungsgruppen_id                     = bg.id)
 201     LEFT JOIN partsgroup pg      ON (p.partsgroup_id                          = pg.id)
 202     LEFT JOIN employee e         ON (COALESCE(oe.salesman_id, oe.employee_id) = e.id)
 203     WHERE oe.record_type = 'sales_order'
 204       AND NOT COALESCE(oe.closed,    FALSE)
 205       AND (oe.id NOT IN (SELECT oe_id FROM periodic_invoices_configs WHERE periodicity <> 'o'))
 206 SQL
 207
 208   # 5. Initialisierung der Datenstrukturen zum Speichern der
 209   # Ergebnisse
 210   my @entries               = selectall_hashref_query($::form, $dbh, $query);
 211   my @salesmen              = uniq map { $_->{salesman}       } (@entries, @scentries);
 212   my @buchungsgruppen       = uniq map { $_->{buchungsgruppe} } (@entries, @scentries);
 213   my @parts_groups          = uniq map { $_->{parts_group}    } (@entries, @scentries);
 214   my @now                   = localtime;
 215   my @dates                 = map { $self->_date_for($now[5] + 1900, $now[4] + $_) } (0..$self->{params}->{months} + 1);
 216   my %dates_by_ordnumber    = map { $_->{ordnumber} => $self->_date_for($_) } @entries;
 217   my %salesman_by_ordnumber = map { $_->{ordnumber} => $_->{salesman}       } @entries;
 218   my %date_sorter           = ( old => '0000-00', future => '9999-99' );
 219
 220   my $projection    = { total          =>               { map { $_ => 0 } @dates },
 221                         order          =>               { map { $_ => 0 } @dates },
 222                         partial        =>               { map { $_ => 0 } @dates },
 223                         support        =>               { map { $_ => 0 } @dates },
 224                         salesman       => { map { $_ => { map { $_ => 0 } @dates } } @salesmen        },
 225                         buchungsgruppe => { map { $_ => { map { $_ => 0 } @dates } } @buchungsgruppen },
 226                         parts_group    => { map { $_ => { map { $_ => 0 } @dates } } @parts_groups    },
 227                         sorted         => { month          => [ sort { ($date_sorter{$a} || $a) cmp ($date_sorter{$b} || $b) } @dates           ],
 228                                             salesman       => [ sort { $a                       cmp $b                       } @salesmen        ],
 229                                             buchungsgruppe => [ sort { $a                       cmp $b                       } @buchungsgruppen ],
 230                                             parts_group    => [ sort { $a                       cmp $b                       } @parts_groups    ],
 231                                             type           => [ qw(order partial support)                                                       ],
 232                                           },
 233                       };
 234
 235   # 6. Aufsummieren der Auftragspositionen
 236   foreach $ref (@entries) {
 237     my $date = $self->_date_for($ref);
 238
 239     $projection->{total}->{$date}                                      += $ref->{linetotal};
 240     $projection->{order}->{$date}                                      += $ref->{linetotal};
 241     $projection->{salesman}->{ $ref->{salesman} }->{$date}             += $ref->{linetotal};
 242     $projection->{buchungsgruppe}->{ $ref->{buchungsgruppe} }->{$date} += $ref->{linetotal};
 243     $projection->{parts_group}->{ $ref->{parts_group} }->{$date}       += $ref->{linetotal};
 244   }
 245
 246   # 7. Aufsummieren der Wartungsvertragspositionen
 247   foreach $ref (@scentries) {
 248     my $date = $ref->{date};
 249
 250     $projection->{total}->{$date}                                      += $ref->{linetotal};
 251     $projection->{support}->{$date}                                    += $ref->{linetotal};
 252     $projection->{salesman}->{ $ref->{salesman} }->{$date}             += $ref->{linetotal};
 253     $projection->{buchungsgruppe}->{ $ref->{buchungsgruppe} }->{$date} += $ref->{linetotal};
 254     $projection->{parts_group}->{ $ref->{parts_group} }->{$date}       += $ref->{linetotal};
 255   }
 256
 257   if (%dates_by_ordnumber) {
 258     # 8. Auslesen von Positionen von Teilrechnungen zu Aufträgen
 259     my $ordnumbers = join ', ', map { $dbh->quote($_) } keys %dates_by_ordnumber;
 260     $query         = <<SQL;
 261       SELECT (i.qty * (1 - i.discount) * i.sellprice) AS linetotal,
 262         bg.description AS buchungsgruppe,
 263         pg.partsgroup AS parts_group,
 264         ar.ordnumber
 265       FROM invoice i
 266       LEFT JOIN ar                 ON (i.trans_id           = ar.id)
 267       LEFT JOIN parts p            ON (i.parts_id           = p.id)
 268       LEFT JOIN buchungsgruppen bg ON (p.buchungsgruppen_id = bg.id)
 269       LEFT JOIN partsgroup pg      ON (p.partsgroup_id      = pg.id)
 270       WHERE (ar.ordnumber IN ($ordnumbers))
 271 SQL
 272
 273     @entries = selectall_hashref_query($::form, $dbh, $query);
 274
 275     # 9. Abziehen der abgerechneten Positionen
 276     foreach $ref (@entries) {
 277       my $date           = $dates_by_ordnumber{    $ref->{ordnumber} } || die;
 278       my $salesman       = $salesman_by_ordnumber{ $ref->{ordnumber} } || die;
 279       my $buchungsgruppe = $projection->{buchungsgruppe}->{ $ref->{buchungsgruppe} } ? $ref->{buchungsgruppe} : $buchungsgruppen[0];
 280       my $parts_group    = $projection->{parts_group}->{    $ref->{parts_group}    } ? $ref->{parts_group}    : $parts_groups[0];
 281
 282       $projection->{partial}->{$date}                           -= $ref->{linetotal};
 283       $projection->{total}->{$date}                             -= $ref->{linetotal};
 284       $projection->{salesman}->{$salesman}->{$date}             -= $ref->{linetotal};
 285       $projection->{buchungsgruppe}->{$buchungsgruppe}->{$date} -= $ref->{linetotal};
 286       $projection->{parts_group}->{$parts_group}->{$date}       -= $ref->{linetotal};
 287     }
 288   }
 289
 290   return $projection;
 291 }
 292
 293 # Skaliert '$year' und '$month' so, dass 1 <= Monat <= 12 gilt. Zum
 294 # Einfachen Addieren gedacht, z.B.
 295 #
 296 # my ($new_year, $new_month) = _fix_date($old_year, $old_month + 6);
 297
 298 sub _fix_date {
 299   my $year   = shift;
 300   my $month  = shift;
 301
 302   $year     += int(($month - 1) / 12);
 303   $month     = (($month - 1) % 12 ) + 1;
 304
 305   ($year, $month);
 306 }
 307
 308 # Formartiert Jahr & Monat wie benötigt.
 309
 310 sub _the_date {
 311   sprintf '%04d-%02d', _fix_date(@_);
 312 }
 313
 314 # Mappt Datum auf Kategorie. Ist das Datum leer, oder liegt es vor dem
 315 # Betrachtungszeitraum, so ist die Kategorie 'old'. Liegt das Datum
 316 # nach dem Betrachtungszeitraum, so ist die Kategorie
 317 # 'future'. Andernfalls ist sie das formartierte Datum selber.
 318
 319 sub _date_for {
 320   my $self = shift;
 321   my $ref  = ref $_[0] eq 'HASH' ? shift : { year => $_[0], month => $_[1] };
 322
 323   return 'old' if !$ref->{year} || !$ref->{month};
 324
 325   my $date = _the_date($ref->{year}, $ref->{month});
 326
 327     $date lt $self->{min_date} ? 'old'
 328   : $date gt $self->{max_date} ? 'future'
 329   :                              $date;
 330 }
 331
 332 sub orders_for_time_period {
 333   my ($class, %params) = @_;
 334
 335   my $dbh = SL::DB::Order->new->db->dbh;
 336
 337   my @recurring_orders;
 338
 339   # 1. Alle aktiven Konfigurationen für wiederkehrende Rechnungen auslesen.
 340
 341   my $configs = SL::DB::Manager::PeriodicInvoicesConfig->get_all(where => [ active => 1 ]);
 342
 343   my %calc_params;
 344   $calc_params{start_date} = $params{after}->clone                   if $params{after};
 345   $calc_params{end_date}   = $params{before}->clone->add(days => -1) if $params{before};
 346   $calc_params{end_date} //= $calc_params{start_date}->clone->add(years => 1);
 347
 348   foreach my $config (@{ $configs }) {
 349     my @dates = $config->calculate_invoice_dates(%calc_params);
 350     next unless @dates;
 351
 352     my $order = SL::DB::Order->new(id => $config->oe_id)->load(with_objects => [ qw(customer employee) ]);
 353     $order->{is_recurring} = 1;
 354
 355     push @recurring_orders, $order;
 356   }
 357
 358   my @where = (
 359     record_type    => 'sales_order',
 360     or             => [ closed    => undef, closed    => 0, ],
 361   );
 362   push @where, (reqdate => { ge => $params{after}->clone })  if $params{after};
 363   push @where, (reqdate => { lt => $params{before}->clone }) if $params{before};
 364   push @where, '!id' => [ map { $_->id } @recurring_orders ] if @recurring_orders;
 365
 366   # 1. Auslesen aller offenen Aufträge, deren Lieferdatum im
 367   # gewünschten Bereich liegt
 368   my $regular_orders = SL::DB::Manager::Order->get_all(
 369     where        => \@where,
 370     with_objects => [ qw(customer employee) ],
 371   );
 372
 373   return sort {
 374          ($a->transdate          <=> $b->transdate)
 375       || ($a->reqdate            <=> $b->reqdate)
 376       || (lc($a->customer->name) cmp lc($b->customer->name))
 377   } (@recurring_orders, @{ $regular_orders });
 378 }
 379
 380 1;