SL/LiquidityProjection.pm

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