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

Annotation of pta/pta.pl, Revision 1.4

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";
                    188:                $amount *= $entry{amount} < 0 ? -1 : +1;
                    189:
                    190:                # Combine the text on the split side.
                    191:                my $newentry = {
                    192:                    %entry,
                    193:                    amount => $amount,
                    194:                    text   => "$entry{text} $text",
                    195:                };
                    196:                if ($cc) {
                    197:                        $newentry->{cc} = $cc;
                    198:                        $newentry->{text} = "[$cc] $newentry->{text}";
                    199:                }
                    200:                make_entry %$newentry, $ano;
                    201:
                    202:                # Append split account numbers on the combined side.
                    203:                my $contra = $entry{contra};
                    204:                $alist{$contra}{''}[-1]{text} .= " $ano"
                    205:                    unless $alist{$contra}{''}[-1]{text} =~ / $ano/;
                    206:
                    207:                # If the split side specifies a cost center,
                    208:                # manually create the cost center entry on the combined
                    209:                # side because make_entry was only called once there.
                    210:                if ($cc) {
                    211:                        my $old = $cclist{$cc}{$contra} ?
                    212:                            $cclist{$cc}{$contra}[-1]{sum} : 0;
                    213:                        $newentry->{contra} = $ano;
                    214:                        $newentry->{amount} *= -1;
                    215:                        $newentry->{sum} = $old - $amount;
                    216:                        push @{$cclist{$cc}{$contra}}, $newentry;
                    217:                }
                    218:
                    219:                # Keep track of the remaining amount.
                    220:                $entry{amount} -= $amount;
                    221:                %entry = () if abs($entry{amount}) < 0.005;
                    222:                next;
                    223:        }
                    224:
                    225:        # --- Parse a normal journal entry or a price line. ------------
                    226:
                    227:        s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line";
                    228:        my ($year, $month, $day) = ($1, $2, $3);
                    229:        s/^([A-Z]+(?:\d+\/\d+)?) +// or die "$fn ID parse error: $line";
                    230:        my $id = $1;
                    231:        s/^(\d+) +// or die "$fn debit account number parse error: $line";
                    232:        my $debit = $1;
                    233:        my ($credit, $oldpc, $newpc);
                    234:        if (s/^(\d+)#(\d+) +//) {
                    235:                $oldpc = $1;
                    236:                $newpc = $2;
                    237:        } elsif (s/^(\d+) +//) {
                    238:                $credit = $1;
                    239:        } else {
                    240:                die "$fn credit account number parse error: $line";
                    241:        }
                    242:        /^(\d+\.\d+) +(.*)/ or die "$fn amount parse error: $line";
                    243:        my ($amount, $text) = ($1, $2);
                    244:        my $cc = $1 if $text =~ /\[(.*?)\]/;
                    245:
                    246:        # --- Handle a price line. -------------------------------------
                    247:
                    248:        if ($oldpc || $newpc) {
                    249:                defined $cc or die "$fn price without cost center: $line";
                    250:                my $old = $prices{$cc};
                    251:                my $new = {
                    252:                    year    => $year,
                    253:                    month   => $month,
                    254:                    day     => $day,
                    255:                    date    => "$year-$month-$day",
                    256:                    days    => ($month - 1) * 30 + ($day - 1),
                    257:                    price   => $newpc * $amount,
                    258:                };
                    259:                $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;
                    260:                next unless $oldpc;
                    261:
                    262:                # --- Some units were already held. --------------------
                    263:
                    264:                my $oldval = $old ? $old->{price} :
                    265:                    $cclist{$cc}{$debit}[-1]{sum};
                    266:                my $diff = $oldpc * $amount - $oldval;
                    267:                my $newprofit = {
                    268:                    year    => $year,
                    269:                    month   => $month,
                    270:                    day     => $day,
                    271:                    date    => $new->{date},
                    272:                    id      => $id,
                    273:                    amount  => $diff,
                    274:                    old     => $oldval,
                    275:                    rel     => $diff / $oldval,
                    276:                    text    => (sprintf "[%s] %s", $cc,
                    277:                                (translate 'change in price')),
                    278:                };
                    279:                if ($old) {
                    280:                        # Record a gain or loss in this period.
                    281:                        $newprofit->{olddate} = $old->{date};
                    282:                        $newprofit->{days} = $new->{days} - $old->{days} +
                    283:                            ($new->{year} - $old->{year}) * 360;
                    284:                        $newprofit->{text} .= sprintf " %s %s (%dd)",
                    285:                            (translate 'since'), $old->{date},
                    286:                            $newprofit->{days};
                    287:                } else {
                    288:                        # Record a gain or loss before this period.
                    289:                        $newprofit->{skip} = 1;
                    290:                        $newprofit->{text} .= sprintf " (%s)",
                    291:                            (translate 'previous years');
                    292:                }
                    293:                push @{$profit{$cc}}, $newprofit;
                    294:
                    295:                # --- Obsolete one previous line, if needed. -----------
                    296:
                    297:                for (my $i = $#{$profit{$cc}} - 1; $i >= 0; $i--) {
                    298:                        my $oldprofit = $profit{$cc}[$i];
                    299:                        next unless $oldprofit->{olddate};
                    300:                        $oldprofit->{skip} = 1
                    301:                            if $oldprofit->{olddate} eq $old->{date};
                    302:                        last;
                    303:                }
                    304:                next;
                    305:        }
                    306:
                    307:        # --- Handle a normal journal entry. ---------------------------
                    308:
                    309:        %entry = (
                    310:            year   => $year,
                    311:            month  => $month,
                    312:            day    => $day,
                    313:            date  => "$year-$month-$day",
                    314:            id     => $id,
                    315:            text   => $text,
                    316:            cc     => $cc,
                    317:        );
                    318:        if ($debit) {
                    319:                $accounts{$debit} or die "unknown debit account $debit: $line";
                    320:                my %newentry = (%entry, contra => $credit, amount => $amount);
                    321:                make_entry %newentry, $debit;
                    322:        } else {
                    323:                $credit or die "splitting both sides: $line";
                    324:                # Remember a credit side split.
                    325:                $entry{contra} = $credit;
                    326:                $entry{amount} = $amount;
                    327:        }
                    328:        if ($credit) {
                    329:                $accounts{$credit}
                    330:                    or die "unknown credit account $credit: $line";
                    331:                my %newentry = (%entry, contra => $debit, amount => -$amount);
                    332:                make_entry %newentry, $credit;
                    333:                # This entry is not split: clear it after processing.
                    334:                %entry = () if $debit;
                    335:        } else {
                    336:                # Remember a debit side split.
                    337:                $entry{contra} = $debit;
                    338:                $entry{amount} = -$amount;
                    339:        }
                    340: }
                    341: # The last journal entry is an incomplete split.
                    342: die "$fn split parse error: EOF" if %entry;
                    343: close $in;
                    344:
                    345: # === OUTPUT ===========================================================
                    346:
                    347: for my $ano (sort keys %accounts) {
                    348:        next unless $alist{$ano};
                    349:
                    350:        # --- Subaccount lists. ----------------------------------------
                    351:
                    352:        if ($opt_s) {
                    353:                for my $sub (sort keys %{$alist{$ano}}) {
                    354:                        next if $sub eq '';
                    355:                        printf "\n%s %s %s (%s) %s\n",
                    356:                            (translate 'Subaccount list'),
                    357:                            $ano, $accounts{$ano}{text},
                    358:                            (translate_type $accounts{$ano}{type}), $sub;
                    359:                        for my $entry (@{$alist{$ano}{$sub}}) {
                    360:                                printf "%10s %6s %5s ", $entry->{date},
                    361:                                    $entry->{id}, $entry->{contra};
                    362:                                print_amount_text $entry, $accounts{$ano};
                    363:                        }
                    364:                }
                    365:        }
                    366:
                    367:        # --- Account lists. -------------------------------------------
                    368:
                    369:        my ($sum, $hassub);
                    370:        if ($alist{$ano}{''}) {
                    371:                $sum = $alist{$ano}{''}[-1]{sum};
                    372:        } else {
                    373:                $alist{$ano}{''} = [];
                    374:                $sum = 0;
                    375:        }
                    376:
                    377:        # Entries outside any subaccount.
                    378:        if ($opt_a) {
                    379:                printf "\n%s %s %s (%s)\n", (translate 'Account list'),
                    380:                    $ano, $accounts{$ano}{text},
                    381:                    (translate_type $accounts{$ano}{type});
                    382:                for my $entry (@{$alist{$ano}{''}}) {
                    383:                        printf "%10s %6s %5s ",
                    384:                            $entry->{date}, $entry->{id}, $entry->{contra};
                    385:                        print_amount_text $entry, $accounts{$ano};
                    386:                }
                    387:        }
                    388:
                    389:        # Subaccount balances.
                    390:        for my $sub (sort {
                    391:                $alist{$ano}{$b}[-1]{sum} <=> $alist{$ano}{$a}[-1]{sum}
                    392:            } grep { $_ ne '' } keys %{$alist{$ano}}) {
                    393:                $hassub = 1;
                    394:                $sum += $alist{$ano}{$sub}[-1]{sum};
                    395:                if ($opt_a) {
                    396:                        printf "%24s", '';
                    397:                        print_amount $alist{$ano}{$sub}[-1]{sum};
                    398:                        printf " %10.2f %s\n",
                    399:                            $sum * ($accounts{$ano}{type} =~ /[ASX]/ ? 1 : -1),
                    400:                            $sub;
                    401:                }
                    402:        }
                    403:        push @{$alist{$ano}{''}}, {sum => $sum} if $hassub;
                    404: }
                    405:
                    406: # --- Balance sheet. ---------------------------------------------------
                    407:
                    408: if ($opt_b) {
                    409:        my $debit = 0;
                    410:        my $credit = 0;
                    411:        my $stat;
                    412:        printf "\n%s\n", (translate 'Balance sheet');;
                    413:        for my $ano (sort keys %accounts) {
                    414:                $alist{$ano} or next;
                    415:                if ($accounts{$ano}{type} =~ /S/) {
                    416:                        $stat = 1;
                    417:                } else {
                    418:                        print_sum $alist{$ano}{''},
                    419:                            $ano, 18, \$debit, \$credit;
                    420:                }
                    421:        }
                    422:        printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
                    423:            (translate 'total assets');
                    424:        printf "%33s %9.2f %s\n", '', $credit - $debit, (translate 'mismatch')
                    425:            if abs($credit - $debit) > 0.005;
                    426:
                    427:        # --- Statistical accounts. ------------------------------------
                    428:
                    429:        if ($stat) {
                    430:                $debit = $credit = 0;
                    431:                printf "\n%s\n", (translate 'Statistical accounts');;
                    432:                for my $ano (sort keys %accounts) {
                    433:                        $alist{$ano} && $accounts{$ano}{type} =~ /S/ or next;
                    434:                        print_sum $alist{$ano}{''},
                    435:                            $ano, 18, \$debit, \$credit;
                    436:                }
                    437:                printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
                    438:                    (translate 'total');
                    439:                printf "%33s %9.2f %s\n", '',
                    440:                    $credit - $debit, (translate 'mismatch')
                    441:                    if abs($credit - $debit) > 0.005;
                    442:        }
                    443: }
                    444:
                    445: # --- Cost centers. ----------------------------------------------------
                    446:
                    447: for my $cc (sort keys %cclist) {
                    448:        if ($opt_c) {
                    449:
                    450:                # --- Cost center account lists. -----------------------
                    451:
                    452:                printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
                    453:                    (translate 'Account list');
                    454:                for my $ano (sort keys %accounts) {
                    455:                        next unless $cclist{$cc}{$ano};
                    456:                        printf "%19s %5s %30s *** %s (%s)\n",
                    457:                            '', $ano, '', $accounts{$ano}{text},
                    458:                            (translate_type $accounts{$ano}{type});
                    459:                        for my $entry (@{$cclist{$cc}{$ano}}) {
                    460:                                printf "  %10s %6s %5s ", $entry->{date},
                    461:                                    $entry->{id}, $entry->{contra};
                    462:                                print_amount_text $entry, $accounts{$ano};
                    463:                        }
                    464:                }
                    465:
                    466:                # --- Partial balance sheet. ---------------------------
                    467:
                    468:                my $debit = 0;
                    469:                my $credit = 0;
                    470:                my $stat;
                    471:                printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
                    472:                    (translate 'Partial balance sheet');
                    473:                for my $ano (sort keys %accounts) {
                    474:                        $cclist{$cc}{$ano} or next;
                    475:                        if ($accounts{$ano}{type} =~ /S/) {
                    476:                                $stat = 1;
                    477:                        } else {
                    478:                                print_sum $cclist{$cc}{$ano},
                    479:                                    $ano, 20, \$debit, \$credit;
                    480:                        }
                    481:                }
                    482:                printf "%25s %9.2f %9.2f %s\n", '', $debit, $credit,
                    483:                    (translate 'total assets');
                    484:
                    485:                # --- Cost center statistical accounts. ----------------
                    486:
                    487:                if ($stat) {
                    488:                        $debit = $credit = 0;
                    489:                        printf "\n%s [%s] %s\n",
                    490:                            (translate 'Cost center'), $cc,
                    491:                            (translate 'Statistical accounts');
                    492:                        for my $ano (sort keys %accounts) {
                    493:                                $cclist{$cc}{$ano} &&
                    494:                                    $accounts{$ano}{type} =~ /S/ or next;
                    495:                                print_sum $cclist{$cc}{$ano},
                    496:                                    $ano, 20, \$debit, \$credit;
                    497:                        }
                    498:                        printf "%25s %9.2f %9.2f %s\n", '',
                    499:                            $debit, $credit, (translate 'total');
                    500:                }
                    501:        }
                    502:
                    503:        # --- Cost center profits and losses. --------------------------
                    504:
1.3       schwarze  505:        if ($opt_p && $profit{$cc}) {
1.1       schwarze  506:                printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
                    507:                    (translate 'Profits and losses');
                    508:                my $pr = 0;
                    509:                my $days = 0;
                    510:                my $capital = 0;
                    511:                for my $i (0 .. $#{$profit{$cc}}) {
                    512:                        my $entry = $profit{$cc}[$i];
                    513:                        printf "  %s %6s %8.2f %5.1f%% of %8.2f ",
                    514:                            $entry->{date}, $entry->{id}, $entry->{amount},
                    515:                            100.0 * $entry->{rel}, $entry->{old};
                    516:                        if ($entry->{days}) {
                    517:                                printf "%5.1f%% p.a.",
                    518:                                    36000.0 * $entry->{rel} / $entry->{days};
                    519:                        } else {
                    520:                                printf "%11s", '';
                    521:                        }
                    522:                        printf " %s", $entry->{text};
                    523:                        if ($entry->{skip}) {
                    524:                                print " --\n";
                    525:                                next;
                    526:                        } else {
                    527:                                print "\n";
                    528:                        }
                    529:                        $pr += $entry->{amount};
                    530:                        next unless $entry->{days};
                    531:                        $days += $entry->{days};
                    532:                        $capital += $entry->{old} * $entry->{days};
                    533:                }
                    534:                my $entry = {
                    535:                    profit  => $pr,
                    536:                    percent => 100.0 * $pr / $capital * $days,
                    537:                    capital => $capital / $days,
                    538:                    pcpa    => 36000.0 * $pr / $capital,
                    539:                    days    => $days,
                    540:                };
                    541:                printf "%19s %8.2f %5.1f%% of %8.2f %5.1f%% p.a. " .
                    542:                    "[%s] %s (%s, %dd)\n", '', $pr, $entry->{percent},
                    543:                    $entry->{capital}, $entry->{pcpa}, $cc,
                    544:                    translate($pr < 0 ? 'total loss' : 'total profit'),
                    545:                    (translate 'current period'), $days;
                    546:                $ptot{$cc} = $entry;
                    547:        }
                    548: }
                    549:
                    550: # --- Global list of profits and losses. -------------------------------
                    551:
1.2       schwarze  552: if ($opt_p && %ptot) {
1.1       schwarze  553:        my $pr = 0;
                    554:        my $capital = 0;
                    555:        my $maxd = 0;
                    556:        printf "\n%s\n", (translate 'Profits and losses');
                    557:        for my $cc (sort keys %ptot) {
                    558:                printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd [%s]\n",
                    559:                    $ptot{$cc}{profit}, $ptot{$cc}{percent},
                    560:                    $ptot{$cc}{capital}, $ptot{$cc}{pcpa},
                    561:                    $ptot{$cc}{days}, $cc;
                    562:                $pr += $ptot{$cc}{profit};
                    563:                $capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 360.0;
                    564:                $maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days};
                    565:        }
                    566:        printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n",
                    567:            $pr, 100.0 * $pr / $capital * $maxd / 360.0,
                    568:            360.0 * $capital / $maxd, 100.0 * $pr / $capital, $maxd,
                    569:            translate($pr < 0 ? 'total loss' : 'total profit');
                    570: }
                    571: exit 0;

CVSweb