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

Annotation of pta/pta.pl, Revision 1.2

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

CVSweb