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

Annotation of pta/pta.pl, Revision 1.1

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:
        !           557: if ($opt_p) {
        !           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