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

Annotation of pta/pta.pl, Revision 1.5

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

CVSweb