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

Diff for /pta/pta.pl between version 1.7 and 1.8

version 1.7, 2020/11/18 12:55:44 version 1.8, 2020/11/18 16:35:40
Line 20  use strict;
Line 20  use strict;
 use Getopt::Std qw(getopts);  use Getopt::Std qw(getopts);
 use Time::Local qw(timegm);  use Time::Local qw(timegm);
   
 our ($opt_a, $opt_b, $opt_c, $opt_L, $opt_n, $opt_p, $opt_s);  our ($opt_a, $opt_b, $opt_c, $opt_D, $opt_L, $opt_n, $opt_p, $opt_s);
   
 my %accounts;   # {ano}{type, text}; from pta-accounts(5)  my %accounts;   # {ano}{type, text}; from pta-accounts(5)
 my %alist;      # {ano}{subname, ''}[]; contains lists of entries  my %alist;      # {ano}{subname, ''}[]; contains lists of entries
 my %cclist;     # {cc}{ano}[]; contains lists of entries  my %cclist;     # {cc}{ano}[]; contains lists of entries
 my %entry;      # {year, month, day, date, id, contra,  my %entry;      # {year, month, day, date, daynum, id, contra,
                 #  amount, rel, old, days, skip, cc, text, sum}                  #  amount, rel, old, days, skip, cc, text, sum}
 my %prices;     # {cc}{year, month, day, date, days, price}  my %prices;     # {cc}{year, month, day, date, daynum, price}
 my %profit;     # {cc}[]; contains lists of profit entries  my %profit;     # {cc}[]; contains lists of profit entries
 my %ptot;       # {cc}{profit, percent, capital, pcpa, days}  my %ptot;       # {cc}{profit, percent, capital, pcpa, days}
   my $startday;   # Initialized by the first journal line.
   my $endday   =  (timegm 0, 0, 0, 31, 11,  99999) / 86400;
   
 my %atypes = (  my %atypes = (
     A => 'Assets',      A => 'Assets',
Line 88  sub translate_type ($) {
Line 90  sub translate_type ($) {
 # but does not handle unrealized profits and losses.  # but does not handle unrealized profits and losses.
 sub make_entry (\%$) {  sub make_entry (\%$) {
         my ($entry, $ano) = @_;          my ($entry, $ano) = @_;
           return if $entry->{daynum} > $endday;
         my $sub = $accounts{$ano}{type} =~ /[RX]/ &&          my $sub = $accounts{$ano}{type} =~ /[RX]/ &&
             $entry->{text} =~ s/\((.*?)\) *// ? $1 : '';              $entry->{text} =~ s/\((.*?)\) *// ? $1 : '';
         my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0;          my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0;
Line 144  sub usage () {
Line 147  sub usage () {
   
 # === MAIN PROGRAM =====================================================  # === MAIN PROGRAM =====================================================
   
 getopts 'abcL:nps' or usage;  getopts 'abcD:L:nps' or usage;
 $opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1  $opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1
     unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s;      unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s;
   if ($opt_D) {
           $opt_D =~ /^(?:(\d{4})(\d{2})(\d{2}):)?(?:(\d{4})(\d{2})(\d{2}))?$/
               or die "-D parse error: $opt_D";
           $startday = (timegm 0, 0, 0, $3, $2 - 1, $1) / 86400 if $1;
           $endday = (timegm 0, 0, 0, $6, $5 - 1, $4) / 86400 if $4;
   }
 unless ($translations = $translations->{$opt_L || 'en'}) {  unless ($translations = $translations->{$opt_L || 'en'}) {
         printf STDERR "unsupported language: -L %s\n", $opt_L;          printf STDERR "unsupported language: -L %s\n", $opt_L;
         usage;          usage;
Line 192  while (<$in>) {
Line 201  while (<$in>) {
                     "$entry{contra} split $line";                      "$entry{contra} split $line";
                 $amount *= $entry{amount} < 0 ? -1 : +1;                  $amount *= $entry{amount} < 0 ? -1 : +1;
   
                 # Combine the text on the split side.                  if ($entry{daynum} <= $endday) {
                 my $newentry = {                          # Combine the text on the split side.
                     %entry,                          my $newentry = {
                     amount => $amount,                              %entry,
                     text   => "$entry{text} $text",                              amount => $amount,
                 };                              text   => "$entry{text} $text",
                 if ($cc) {                          };
                         $newentry->{cc} = $cc;                          if ($cc) {
                         $newentry->{text} = "[$cc] $newentry->{text}";                                  $newentry->{cc} = $cc;
                 }                                  $newentry->{text} = "[$cc] $newentry->{text}";
                 make_entry %$newentry, $ano;                          }
                           make_entry %$newentry, $ano;
   
                 # Append split account numbers on the combined side.                          # Append split account numbers on the combined side.
                 my $contra = $entry{contra};                          my $contra = $entry{contra};
                 $alist{$contra}{''}[-1]{text} .= " $ano"                          $alist{$contra}{''}[-1]{text} .= " $ano"
                     unless $alist{$contra}{''}[-1]{text} =~ / $ano/;                              unless $alist{$contra}{''}[-1]{text} =~ / $ano/;
   
                 # If the split side specifies a cost center,                          # If the split side specifies a cost center,
                 # manually create the cost center entry on the combined                          # manually create the cost center entry
                 # side because make_entry was only called once there.                          # on the combined side because make_entry()
                 if ($cc) {                          # was only called once there.
                         my $old = $cclist{$cc}{$contra} ?                          if ($cc) {
                             $cclist{$cc}{$contra}[-1]{sum} : 0;                                  my $old = $cclist{$cc}{$contra} ?
                         $newentry->{contra} = $ano;                                      $cclist{$cc}{$contra}[-1]{sum} : 0;
                         $newentry->{amount} *= -1;                                  $newentry->{contra} = $ano;
                         $newentry->{sum} = $old - $amount;                                  $newentry->{amount} *= -1;
                         push @{$cclist{$cc}{$contra}}, $newentry;                                  $newentry->{sum} = $old - $amount;
                                   push @{$cclist{$cc}{$contra}}, $newentry;
                           }
                 }                  }
   
                 # Keep track of the remaining amount.                  # Keep track of the remaining amount.
Line 231  while (<$in>) {
Line 243  while (<$in>) {
   
         s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line";          s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line";
         my ($year, $month, $day) = ($1, $2, $3);          my ($year, $month, $day) = ($1, $2, $3);
           my $daynum = (timegm 0, 0, 0, $day, $month-1, $year) / 86400;
           $startday //= $daynum;
         s/^(\S+) +// or die "$fn ID parse error: $line";          s/^(\S+) +// or die "$fn ID parse error: $line";
         my $id = $1;          my $id = $1;
         s/^(\d+) +// or die "$fn debit account number parse error: $line";          s/^(\d+) +// or die "$fn debit account number parse error: $line";
Line 258  while (<$in>) {
Line 272  while (<$in>) {
                     month   => $month,                      month   => $month,
                     day     => $day,                      day     => $day,
                     date    => "$year-$month-$day",                      date    => "$year-$month-$day",
                     days    => (timegm 0,0,0, $day, $month-1, $year) / 86400,                      daynum  => $daynum,
                     price   => $newpc * $amount,                      price   => $newpc * $amount,
                 };                  };
                   next if $new->{daynum} > $endday;
                 $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;                  $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;
                 next unless $oldpc;                  next unless $oldpc;
   
Line 284  while (<$in>) {
Line 299  while (<$in>) {
                 if ($old) {                  if ($old) {
                         # Record a gain or loss in this period.                          # Record a gain or loss in this period.
                         $newprofit->{olddate} = $old->{date};                          $newprofit->{olddate} = $old->{date};
                         $newprofit->{days} = $new->{days} - $old->{days};                          $newprofit->{days} = $new->{daynum} - $old->{daynum};
                         $newprofit->{text} .= sprintf " %s %s (%dd)",                          $newprofit->{text} .= sprintf " %s %s (%dd)",
                             (translate 'since'), $old->{date},                              (translate 'since'), $old->{date},
                             $newprofit->{days};                              $newprofit->{days};
Line 314  while (<$in>) {
Line 329  while (<$in>) {
             year   => $year,              year   => $year,
             month  => $month,              month  => $month,
             day    => $day,              day    => $day,
             date  => "$year-$month-$day",              date   => "$year-$month-$day",
               daynum => (timegm 0, 0, 0, $day, $month - 1, $year) / 86400,
             id     => $id,              id     => $id,
             text   => $text,              text   => $text,
             cc     => $cc,              cc     => $cc,
Line 540  for my $cc (sort keys %cclist) {
Line 556  for my $cc (sort keys %cclist) {
                         $days += $entry->{days};                          $days += $entry->{days};
                         $capital += $entry->{old} * $entry->{days};                          $capital += $entry->{old} * $entry->{days};
                 }                  }
                   next unless $days;
                 my $entry = {                  my $entry = {
                     profit  => $pr,                      profit  => $pr,
                     percent => 100.0 * $pr / $capital * $days,                      percent => 100.0 * $pr / $capital * $days,
Line 569  if ($opt_p && %ptot) {
Line 586  if ($opt_p && %ptot) {
                     $ptot{$cc}{capital}, $ptot{$cc}{pcpa},                      $ptot{$cc}{capital}, $ptot{$cc}{pcpa},
                     $ptot{$cc}{days}, $cc;                      $ptot{$cc}{days}, $cc;
                 $pr += $ptot{$cc}{profit};                  $pr += $ptot{$cc}{profit};
                 $capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 360.0;                  $capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 365.245;
                 $maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days};                  $maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days};
         }          }
         printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n",          printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n",

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

CVSweb