[BACK]Return to pta.pl CVS log [TXT][DIR] Up to [cvsweb.bsd.lv] / pta

Annotation of pta/pta.pl, Revision 1.8

1.1       schwarze    1: #!/usr/bin/perl
                      2: #
                      3: # Copyright (c) 2020 Ingo Schwarze <schwarze@openbsd.org>
                      4: #
                      5: # Permission to use, copy, modify, and distribute this software for any
                      6: # purpose with or without fee is hereby granted, provided that the above
                      7: # copyright notice and this permission notice appear in all copies.
                      8: #
                      9: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
                     10: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
                     11: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
                     12: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
                     13: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
                     14: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
                     15: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
                     16:
                     17: use warnings;
                     18: use strict;
                     19:
                     20: use Getopt::Std qw(getopts);
1.7       schwarze   21: use Time::Local qw(timegm);
1.1       schwarze   22:
1.8     ! schwarze   23: our ($opt_a, $opt_b, $opt_c, $opt_D, $opt_L, $opt_n, $opt_p, $opt_s);
1.1       schwarze   24:
                     25: my %accounts;  # {ano}{type, text}; from pta-accounts(5)
                     26: my %alist;     # {ano}{subname, ''}[]; contains lists of entries
1.8     ! schwarze   27: my %cclist;    # {cc}{ano}[]; contains lists of entries
        !            28: my %entry;     # {year, month, day, date, daynum, id, contra,
1.1       schwarze   29:                #  amount, rel, old, days, skip, cc, text, sum}
1.8     ! schwarze   30: my %prices;    # {cc}{year, month, day, date, daynum, price}
        !            31: my %profit;    # {cc}[]; contains lists of profit entries
        !            32: my %ptot;      # {cc}{profit, percent, capital, pcpa, days}
        !            33: my $startday;  # Initialized by the first journal line.
        !            34: my $endday   = (timegm 0, 0, 0, 31, 11,  99999) / 86400;
1.1       schwarze   35:
                     36: my %atypes = (
                     37:     A => 'Assets',
                     38:     Q => 'Equity',
                     39:     L => 'Liabilities',
                     40:     R => 'Revenue',
                     41:     S => 'Statistical accounts',
                     42:     X => 'Expenses',
                     43: );
                     44:
                     45: my $translations = {
1.4       schwarze   46:     en => {},
1.1       schwarze   47:     de => {
                     48:        'Account list'          => 'Kontenblatt',
                     49:        'Assets'                => 'Aktiva',
                     50:        'Balance sheet'         => 'Bilanz',
                     51:        'change in price'       => 'Kursaenderung',
                     52:        'Cost center'           => 'Kostenstelle',
                     53:        'current period'        => 'aktuelle Periode',
                     54:        'Equity'                => 'Eigenkapital',
                     55:        'Expenses'              => 'Aufwand',
                     56:        'Liabilities'           => 'Fremdkapital',
                     57:        'loss'                  => 'Verlust',
                     58:        'mismatch'              => 'Diskrepanz',
                     59:        'Partial balance sheet' => 'Teilbilanz',
                     60:        'previous years'        => 'Vorjahre',
                     61:        'profit'                => 'Gewinn',
                     62:        'Profits and losses'    => 'Gewinne und Verluste',
                     63:        'Revenue'               => 'Ertrag',
                     64:        'since'                 => 'seit',
                     65:        'Statistical accounts'  => 'Statistische Konten',
                     66:        'Subaccount list'       => 'Unterkontenblatt',
                     67:        'total'                 => 'Summe',
                     68:        'total assets'          => 'Bilanzsumme',
                     69:        'total loss'            => 'Gesamtverlust',
                     70:        'total profit'          => 'Gesamtgewinn',
                     71:     }
                     72: };
                     73:
                     74: # === SUBROUTINES  =====================================================
                     75:
                     76: sub translate ($) {
                     77:        my $en = shift;
1.4       schwarze   78:        return $translations->{$en} || $en;
1.1       schwarze   79: }
                     80:
                     81: sub translate_type ($) {
                     82:        my $type = shift;
1.4       schwarze   83:        my $en = $atypes{substr $type, 0, 1};
                     84:        return $en ? translate $en : $type;
1.1       schwarze   85: }
                     86:
                     87: # Handles account entries (not journal entries) with respect to
                     88: # subaccounts, running totals, cost centers,
                     89: # and realized profits and losses in the profit table,
                     90: # but does not handle unrealized profits and losses.
                     91: sub make_entry (\%$) {
                     92:        my ($entry, $ano) = @_;
1.8     ! schwarze   93:        return if $entry->{daynum} > $endday;
1.1       schwarze   94:        my $sub = $accounts{$ano}{type} =~ /[RX]/ &&
                     95:            $entry->{text} =~ s/\((.*?)\) *// ? $1 : '';
                     96:        my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0;
                     97:        push @{$alist{$ano}{$sub}}, {%$entry, sum => $old + $entry->{amount}};
                     98:        my $cc = $entry->{cc} or return;
                     99:        $old = $cclist{$cc}{$ano} ? $cclist{$cc}{$ano}[-1]{sum} : 0;
                    100:        push @{$cclist{$cc}{$ano}}, {%$entry, sum => $old + $entry->{amount}};
                    101:        push @{$profit{$cc}}, {
                    102:            %$entry,
                    103:            old    => $prices{$cc}{price},
                    104:            amount => -$entry->{amount},
                    105:            rel    => -$entry->{amount} / $prices{$cc}{price},
                    106:        } if $accounts{$ano}{type} =~ /p/;
                    107: }
                    108:
                    109: # For account lists, not for balance sheets.
                    110: sub print_amount ($) {
                    111:        my $amount = shift;
                    112:        if ($amount < 0) {
                    113:                printf "%9s %9.2f", '', -$amount;
                    114:        } else {
                    115:                printf "%9.2f %9s", $amount, '';
                    116:        }
                    117: }
                    118:
                    119: sub print_amount_text ($$) {
                    120:        my ($entry, $account) = @_;
                    121:        print_amount $entry->{amount};
                    122:        printf " %10.2f %s\n",
                    123:            $entry->{sum} * ($account->{type} =~ /[ASX]/ ? 1 : -1),
                    124:            $entry->{text};
                    125: }
                    126:
                    127: # For balance sheets, not for account lists.
                    128: sub print_sum ($$$$$) {
                    129:        my ($list, $ano, $indent, $debit, $credit) = @_;
                    130:        my $type = $accounts{$ano}{type};
                    131:        my $amount = $list->[-1]{sum};
                    132:        printf "%*s%05u ", $indent, '', $ano;
                    133:        if ($type =~ /[AX]/ || ($type eq 'S' && $amount >= 0)) {
                    134:                printf "%9.2f %9s", $amount, '';
                    135:                $$debit += $amount;
                    136:        } else {
                    137:                printf "%9s %9.2f", '', -$amount;
                    138:                $$credit -= $amount;
                    139:        }
                    140:        printf " %s\n", $accounts{$ano}{text};
                    141: }
                    142:
                    143: sub usage () {
                    144:        printf STDERR "usage: %s [-abcnps] [-L de]\n", $0;
                    145:        exit 1;
                    146: }
                    147:
                    148: # === MAIN PROGRAM =====================================================
                    149:
1.8     ! schwarze  150: getopts 'abcD:L:nps' or usage;
1.1       schwarze  151: $opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1
                    152:     unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s;
1.8     ! schwarze  153: if ($opt_D) {
        !           154:        $opt_D =~ /^(?:(\d{4})(\d{2})(\d{2}):)?(?:(\d{4})(\d{2})(\d{2}))?$/
        !           155:            or die "-D parse error: $opt_D";
        !           156:        $startday = (timegm 0, 0, 0, $3, $2 - 1, $1) / 86400 if $1;
        !           157:        $endday = (timegm 0, 0, 0, $6, $5 - 1, $4) / 86400 if $4;
        !           158: }
1.4       schwarze  159: unless ($translations = $translations->{$opt_L || 'en'}) {
                    160:        printf STDERR "unsupported language: -L %s\n", $opt_L;
1.1       schwarze  161:        usage;
                    162: }
                    163:
                    164: my $fn = 'accounts.txt';
                    165: open my $in, $fn or die "$fn: $!";
                    166: while (<$in>) {
                    167:        chomp;
                    168:        next if /^(?:#|$)/;
                    169:        my $line = $_;
                    170:        s/^(\d+) +// or die "$fn account number parse error: $line";
                    171:        my $account = {};
                    172:        $accounts{$1} = $account;
                    173:        s/^([ALQRSX]p?) +// or die "$fn account type parse error: $line";
                    174:        $account->{type} = $1;
                    175:        $account->{text} = $_;
                    176: }
                    177: close $in;
                    178:
                    179: # === JOURNAL PARSER ===================================================
                    180:
                    181: $fn = 'journal.txt';
                    182: open $in, $fn or die "$fn: $!";
                    183: while (<$in>) {
                    184:        chomp;
                    185:        next if /^(?:#|$)/;
                    186:        my $line = $_;
                    187:
                    188:        # --- Subsequent line of a split entry. ------------------------
                    189:
                    190:        if (%entry) {
                    191:                s/^ *(\d+) +// or die "$fn split account parse error: $line";
                    192:                my $ano = $1;
                    193:                /^(-?\d+\.\d+) +(.*)/
                    194:                    or die "$fn split amount parse error: $line";
                    195:                my ($amount, $text) = ($1, $2);
                    196:                my $cc = $1 if $text =~ s/\[(.*?)\] *//;
                    197:                $accounts{$ano} or die "unknown account $ano: $line";
1.5       schwarze  198:                ($accounts{$ano}{type} =~ /S/) ==
                    199:                    ($accounts{$entry{contra}}{type} =~ /S/)
                    200:                    or die "statistical vs. non-statistical account: " .
                    201:                    "$entry{contra} split $line";
1.1       schwarze  202:                $amount *= $entry{amount} < 0 ? -1 : +1;
                    203:
1.8     ! schwarze  204:                if ($entry{daynum} <= $endday) {
        !           205:                        # Combine the text on the split side.
        !           206:                        my $newentry = {
        !           207:                            %entry,
        !           208:                            amount => $amount,
        !           209:                            text   => "$entry{text} $text",
        !           210:                        };
        !           211:                        if ($cc) {
        !           212:                                $newentry->{cc} = $cc;
        !           213:                                $newentry->{text} = "[$cc] $newentry->{text}";
        !           214:                        }
        !           215:                        make_entry %$newentry, $ano;
        !           216:
        !           217:                        # Append split account numbers on the combined side.
        !           218:                        my $contra = $entry{contra};
        !           219:                        $alist{$contra}{''}[-1]{text} .= " $ano"
        !           220:                            unless $alist{$contra}{''}[-1]{text} =~ / $ano/;
        !           221:
        !           222:                        # If the split side specifies a cost center,
        !           223:                        # manually create the cost center entry
        !           224:                        # on the combined side because make_entry()
        !           225:                        # was only called once there.
        !           226:                        if ($cc) {
        !           227:                                my $old = $cclist{$cc}{$contra} ?
        !           228:                                    $cclist{$cc}{$contra}[-1]{sum} : 0;
        !           229:                                $newentry->{contra} = $ano;
        !           230:                                $newentry->{amount} *= -1;
        !           231:                                $newentry->{sum} = $old - $amount;
        !           232:                                push @{$cclist{$cc}{$contra}}, $newentry;
        !           233:                        }
1.1       schwarze  234:                }
                    235:
                    236:                # Keep track of the remaining amount.
                    237:                $entry{amount} -= $amount;
                    238:                %entry = () if abs($entry{amount}) < 0.005;
                    239:                next;
                    240:        }
                    241:
                    242:        # --- Parse a normal journal entry or a price line. ------------
                    243:
                    244:        s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line";
                    245:        my ($year, $month, $day) = ($1, $2, $3);
1.8     ! schwarze  246:        my $daynum = (timegm 0, 0, 0, $day, $month-1, $year) / 86400;
        !           247:        $startday //= $daynum;
1.6       schwarze  248:        s/^(\S+) +// or die "$fn ID parse error: $line";
1.1       schwarze  249:        my $id = $1;
                    250:        s/^(\d+) +// or die "$fn debit account number parse error: $line";
                    251:        my $debit = $1;
                    252:        my ($credit, $oldpc, $newpc);
                    253:        if (s/^(\d+)#(\d+) +//) {
                    254:                $oldpc = $1;
                    255:                $newpc = $2;
                    256:        } elsif (s/^(\d+) +//) {
                    257:                $credit = $1;
                    258:        } else {
                    259:                die "$fn credit account number parse error: $line";
                    260:        }
                    261:        /^(\d+\.\d+) +(.*)/ or die "$fn amount parse error: $line";
                    262:        my ($amount, $text) = ($1, $2);
                    263:        my $cc = $1 if $text =~ /\[(.*?)\]/;
                    264:
                    265:        # --- Handle a price line. -------------------------------------
                    266:
                    267:        if ($oldpc || $newpc) {
                    268:                defined $cc or die "$fn price without cost center: $line";
                    269:                my $old = $prices{$cc};
                    270:                my $new = {
                    271:                    year    => $year,
                    272:                    month   => $month,
                    273:                    day     => $day,
                    274:                    date    => "$year-$month-$day",
1.8     ! schwarze  275:                    daynum  => $daynum,
1.1       schwarze  276:                    price   => $newpc * $amount,
                    277:                };
1.8     ! schwarze  278:                next if $new->{daynum} > $endday;
1.1       schwarze  279:                $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;
                    280:                next unless $oldpc;
                    281:
                    282:                # --- Some units were already held. --------------------
                    283:
                    284:                my $oldval = $old ? $old->{price} :
                    285:                    $cclist{$cc}{$debit}[-1]{sum};
                    286:                my $diff = $oldpc * $amount - $oldval;
                    287:                my $newprofit = {
                    288:                    year    => $year,
                    289:                    month   => $month,
                    290:                    day     => $day,
                    291:                    date    => $new->{date},
                    292:                    id      => $id,
                    293:                    amount  => $diff,
                    294:                    old     => $oldval,
                    295:                    rel     => $diff / $oldval,
                    296:                    text    => (sprintf "[%s] %s", $cc,
                    297:                                (translate 'change in price')),
                    298:                };
                    299:                if ($old) {
                    300:                        # Record a gain or loss in this period.
                    301:                        $newprofit->{olddate} = $old->{date};
1.8     ! schwarze  302:                        $newprofit->{days} = $new->{daynum} - $old->{daynum};
1.1       schwarze  303:                        $newprofit->{text} .= sprintf " %s %s (%dd)",
                    304:                            (translate 'since'), $old->{date},
                    305:                            $newprofit->{days};
                    306:                } else {
                    307:                        # Record a gain or loss before this period.
                    308:                        $newprofit->{skip} = 1;
                    309:                        $newprofit->{text} .= sprintf " (%s)",
                    310:                            (translate 'previous years');
                    311:                }
                    312:                push @{$profit{$cc}}, $newprofit;
                    313:
                    314:                # --- Obsolete one previous line, if needed. -----------
                    315:
                    316:                for (my $i = $#{$profit{$cc}} - 1; $i >= 0; $i--) {
                    317:                        my $oldprofit = $profit{$cc}[$i];
                    318:                        next unless $oldprofit->{olddate};
                    319:                        $oldprofit->{skip} = 1
                    320:                            if $oldprofit->{olddate} eq $old->{date};
                    321:                        last;
                    322:                }
                    323:                next;
                    324:        }
                    325:
                    326:        # --- Handle a normal journal entry. ---------------------------
                    327:
                    328:        %entry = (
                    329:            year   => $year,
                    330:            month  => $month,
                    331:            day    => $day,
1.8     ! schwarze  332:            date   => "$year-$month-$day",
        !           333:            daynum => (timegm 0, 0, 0, $day, $month - 1, $year) / 86400,
1.1       schwarze  334:            id     => $id,
                    335:            text   => $text,
                    336:            cc     => $cc,
                    337:        );
                    338:        if ($debit) {
                    339:                $accounts{$debit} or die "unknown debit account $debit: $line";
1.5       schwarze  340:                # The credit side may or may not be split.
1.1       schwarze  341:                my %newentry = (%entry, contra => $credit, amount => $amount);
                    342:                make_entry %newentry, $debit;
                    343:        } else {
                    344:                $credit or die "splitting both sides: $line";
1.5       schwarze  345:                # The debit side is split, remember the entry.
1.1       schwarze  346:                $entry{contra} = $credit;
                    347:                $entry{amount} = $amount;
                    348:        }
                    349:        if ($credit) {
                    350:                $accounts{$credit}
                    351:                    or die "unknown credit account $credit: $line";
1.5       schwarze  352:                $debit && ($accounts{$debit}{type} =~ /S/) !=
                    353:                    ($accounts{$credit}{type} =~ /S/)
                    354:                    and die "statistical vs. non-statistical account: $line";
                    355:                # The debit side may or may not be split.
1.1       schwarze  356:                my %newentry = (%entry, contra => $debit, amount => -$amount);
                    357:                make_entry %newentry, $credit;
                    358:                # This entry is not split: clear it after processing.
                    359:                %entry = () if $debit;
                    360:        } else {
1.5       schwarze  361:                # The credit side is split, remember the entry.
1.1       schwarze  362:                $entry{contra} = $debit;
                    363:                $entry{amount} = -$amount;
                    364:        }
                    365: }
                    366: # The last journal entry is an incomplete split.
                    367: die "$fn split parse error: EOF" if %entry;
                    368: close $in;
                    369:
                    370: # === OUTPUT ===========================================================
                    371:
                    372: for my $ano (sort keys %accounts) {
                    373:        next unless $alist{$ano};
                    374:
                    375:        # --- Subaccount lists. ----------------------------------------
                    376:
                    377:        if ($opt_s) {
                    378:                for my $sub (sort keys %{$alist{$ano}}) {
                    379:                        next if $sub eq '';
                    380:                        printf "\n%s %s %s (%s) %s\n",
                    381:                            (translate 'Subaccount list'),
                    382:                            $ano, $accounts{$ano}{text},
                    383:                            (translate_type $accounts{$ano}{type}), $sub;
                    384:                        for my $entry (@{$alist{$ano}{$sub}}) {
                    385:                                printf "%10s %6s %5s ", $entry->{date},
                    386:                                    $entry->{id}, $entry->{contra};
                    387:                                print_amount_text $entry, $accounts{$ano};
                    388:                        }
                    389:                }
                    390:        }
                    391:
                    392:        # --- Account lists. -------------------------------------------
                    393:
                    394:        my ($sum, $hassub);
                    395:        if ($alist{$ano}{''}) {
                    396:                $sum = $alist{$ano}{''}[-1]{sum};
                    397:        } else {
                    398:                $alist{$ano}{''} = [];
                    399:                $sum = 0;
                    400:        }
                    401:
                    402:        # Entries outside any subaccount.
                    403:        if ($opt_a) {
                    404:                printf "\n%s %s %s (%s)\n", (translate 'Account list'),
                    405:                    $ano, $accounts{$ano}{text},
                    406:                    (translate_type $accounts{$ano}{type});
                    407:                for my $entry (@{$alist{$ano}{''}}) {
                    408:                        printf "%10s %6s %5s ",
                    409:                            $entry->{date}, $entry->{id}, $entry->{contra};
                    410:                        print_amount_text $entry, $accounts{$ano};
                    411:                }
                    412:        }
                    413:
                    414:        # Subaccount balances.
                    415:        for my $sub (sort {
                    416:                $alist{$ano}{$b}[-1]{sum} <=> $alist{$ano}{$a}[-1]{sum}
                    417:            } grep { $_ ne '' } keys %{$alist{$ano}}) {
                    418:                $hassub = 1;
                    419:                $sum += $alist{$ano}{$sub}[-1]{sum};
                    420:                if ($opt_a) {
                    421:                        printf "%24s", '';
                    422:                        print_amount $alist{$ano}{$sub}[-1]{sum};
                    423:                        printf " %10.2f %s\n",
                    424:                            $sum * ($accounts{$ano}{type} =~ /[ASX]/ ? 1 : -1),
                    425:                            $sub;
                    426:                }
                    427:        }
                    428:        push @{$alist{$ano}{''}}, {sum => $sum} if $hassub;
                    429: }
                    430:
                    431: # --- Balance sheet. ---------------------------------------------------
                    432:
                    433: if ($opt_b) {
                    434:        my $debit = 0;
                    435:        my $credit = 0;
                    436:        my $stat;
                    437:        printf "\n%s\n", (translate 'Balance sheet');;
                    438:        for my $ano (sort keys %accounts) {
                    439:                $alist{$ano} or next;
                    440:                if ($accounts{$ano}{type} =~ /S/) {
                    441:                        $stat = 1;
                    442:                } else {
                    443:                        print_sum $alist{$ano}{''},
                    444:                            $ano, 18, \$debit, \$credit;
                    445:                }
                    446:        }
                    447:        printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
                    448:            (translate 'total assets');
                    449:        printf "%33s %9.2f %s\n", '', $credit - $debit, (translate 'mismatch')
                    450:            if abs($credit - $debit) > 0.005;
                    451:
                    452:        # --- Statistical accounts. ------------------------------------
                    453:
                    454:        if ($stat) {
                    455:                $debit = $credit = 0;
                    456:                printf "\n%s\n", (translate 'Statistical accounts');;
                    457:                for my $ano (sort keys %accounts) {
                    458:                        $alist{$ano} && $accounts{$ano}{type} =~ /S/ or next;
                    459:                        print_sum $alist{$ano}{''},
                    460:                            $ano, 18, \$debit, \$credit;
                    461:                }
                    462:                printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
                    463:                    (translate 'total');
                    464:                printf "%33s %9.2f %s\n", '',
                    465:                    $credit - $debit, (translate 'mismatch')
                    466:                    if abs($credit - $debit) > 0.005;
                    467:        }
                    468: }
                    469:
                    470: # --- Cost centers. ----------------------------------------------------
                    471:
                    472: for my $cc (sort keys %cclist) {
                    473:        if ($opt_c) {
                    474:
                    475:                # --- Cost center account lists. -----------------------
                    476:
                    477:                printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
                    478:                    (translate 'Account list');
                    479:                for my $ano (sort keys %accounts) {
                    480:                        next unless $cclist{$cc}{$ano};
                    481:                        printf "%19s %5s %30s *** %s (%s)\n",
                    482:                            '', $ano, '', $accounts{$ano}{text},
                    483:                            (translate_type $accounts{$ano}{type});
                    484:                        for my $entry (@{$cclist{$cc}{$ano}}) {
                    485:                                printf "  %10s %6s %5s ", $entry->{date},
                    486:                                    $entry->{id}, $entry->{contra};
                    487:                                print_amount_text $entry, $accounts{$ano};
                    488:                        }
                    489:                }
                    490:
                    491:                # --- Partial balance sheet. ---------------------------
                    492:
                    493:                my $debit = 0;
                    494:                my $credit = 0;
                    495:                my $stat;
                    496:                printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
                    497:                    (translate 'Partial balance sheet');
                    498:                for my $ano (sort keys %accounts) {
                    499:                        $cclist{$cc}{$ano} or next;
                    500:                        if ($accounts{$ano}{type} =~ /S/) {
                    501:                                $stat = 1;
                    502:                        } else {
                    503:                                print_sum $cclist{$cc}{$ano},
                    504:                                    $ano, 20, \$debit, \$credit;
                    505:                        }
                    506:                }
                    507:                printf "%25s %9.2f %9.2f %s\n", '', $debit, $credit,
                    508:                    (translate 'total assets');
                    509:
                    510:                # --- Cost center statistical accounts. ----------------
                    511:
                    512:                if ($stat) {
                    513:                        $debit = $credit = 0;
                    514:                        printf "\n%s [%s] %s\n",
                    515:                            (translate 'Cost center'), $cc,
                    516:                            (translate 'Statistical accounts');
                    517:                        for my $ano (sort keys %accounts) {
                    518:                                $cclist{$cc}{$ano} &&
                    519:                                    $accounts{$ano}{type} =~ /S/ or next;
                    520:                                print_sum $cclist{$cc}{$ano},
                    521:                                    $ano, 20, \$debit, \$credit;
                    522:                        }
                    523:                        printf "%25s %9.2f %9.2f %s\n", '',
                    524:                            $debit, $credit, (translate 'total');
                    525:                }
                    526:        }
                    527:
                    528:        # --- Cost center profits and losses. --------------------------
                    529:
1.3       schwarze  530:        if ($opt_p && $profit{$cc}) {
1.1       schwarze  531:                printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
                    532:                    (translate 'Profits and losses');
                    533:                my $pr = 0;
                    534:                my $days = 0;
                    535:                my $capital = 0;
                    536:                for my $i (0 .. $#{$profit{$cc}}) {
                    537:                        my $entry = $profit{$cc}[$i];
                    538:                        printf "  %s %6s %8.2f %5.1f%% of %8.2f ",
                    539:                            $entry->{date}, $entry->{id}, $entry->{amount},
                    540:                            100.0 * $entry->{rel}, $entry->{old};
                    541:                        if ($entry->{days}) {
                    542:                                printf "%5.1f%% p.a.",
1.7       schwarze  543:                                    36524.5 * $entry->{rel} / $entry->{days};
1.1       schwarze  544:                        } else {
                    545:                                printf "%11s", '';
                    546:                        }
                    547:                        printf " %s", $entry->{text};
                    548:                        if ($entry->{skip}) {
                    549:                                print " --\n";
                    550:                                next;
                    551:                        } else {
                    552:                                print "\n";
                    553:                        }
                    554:                        $pr += $entry->{amount};
                    555:                        next unless $entry->{days};
                    556:                        $days += $entry->{days};
                    557:                        $capital += $entry->{old} * $entry->{days};
                    558:                }
1.8     ! schwarze  559:                next unless $days;
1.1       schwarze  560:                my $entry = {
                    561:                    profit  => $pr,
                    562:                    percent => 100.0 * $pr / $capital * $days,
                    563:                    capital => $capital / $days,
                    564:                    pcpa    => 36000.0 * $pr / $capital,
                    565:                    days    => $days,
                    566:                };
                    567:                printf "%19s %8.2f %5.1f%% of %8.2f %5.1f%% p.a. " .
                    568:                    "[%s] %s (%s, %dd)\n", '', $pr, $entry->{percent},
                    569:                    $entry->{capital}, $entry->{pcpa}, $cc,
                    570:                    translate($pr < 0 ? 'total loss' : 'total profit'),
                    571:                    (translate 'current period'), $days;
                    572:                $ptot{$cc} = $entry;
                    573:        }
                    574: }
                    575:
                    576: # --- Global list of profits and losses. -------------------------------
                    577:
1.2       schwarze  578: if ($opt_p && %ptot) {
1.1       schwarze  579:        my $pr = 0;
                    580:        my $capital = 0;
                    581:        my $maxd = 0;
                    582:        printf "\n%s\n", (translate 'Profits and losses');
                    583:        for my $cc (sort keys %ptot) {
                    584:                printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd [%s]\n",
                    585:                    $ptot{$cc}{profit}, $ptot{$cc}{percent},
                    586:                    $ptot{$cc}{capital}, $ptot{$cc}{pcpa},
                    587:                    $ptot{$cc}{days}, $cc;
                    588:                $pr += $ptot{$cc}{profit};
1.8     ! schwarze  589:                $capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 365.245;
1.1       schwarze  590:                $maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days};
                    591:        }
                    592:        printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n",
                    593:            $pr, 100.0 * $pr / $capital * $maxd / 360.0,
                    594:            360.0 * $capital / $maxd, 100.0 * $pr / $capital, $maxd,
                    595:            translate($pr < 0 ? 'total loss' : 'total profit');
                    596: }
                    597: exit 0;

CVSweb