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

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

version 1.3, 2020/10/18 23:47:35 version 1.7, 2020/11/18 12:55:44
Line 18  use warnings;
Line 18  use warnings;
 use strict;  use strict;
   
 use Getopt::Std qw(getopts);  use Getopt::Std qw(getopts);
   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_L, $opt_n, $opt_p, $opt_s);
   
Line 40  my %atypes = (
Line 41  my %atypes = (
 );  );
   
 my $translations = {  my $translations = {
       en => {},
     de => {      de => {
         'Account list'          => 'Kontenblatt',          'Account list'          => 'Kontenblatt',
         'Assets'                => 'Aktiva',          'Assets'                => 'Aktiva',
Line 71  my $translations = {
Line 73  my $translations = {
   
 sub translate ($) {  sub translate ($) {
         my $en = shift;          my $en = shift;
         return $translations ? $translations->{$en} : $en;          return $translations->{$en} || $en;
 }  }
   
 sub translate_type ($) {  sub translate_type ($) {
         my $type = shift;          my $type = shift;
         my $en = $atypes{substr $type, 0, 1} || '?';          my $en = $atypes{substr $type, 0, 1};
         return translate $en || $type;          return $en ? translate $en : $type;
 }  }
   
 # Handles account entries (not journal entries) with respect to  # Handles account entries (not journal entries) with respect to
Line 145  sub usage () {
Line 147  sub usage () {
 getopts 'abcL:nps' or usage;  getopts 'abcL: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;
 $opt_L ||= 'en';  unless ($translations = $translations->{$opt_L || 'en'}) {
 if ($opt_L eq 'de') {          printf STDERR "unsupported language: -L %s\n", $opt_L;
         $translations = $translations->{$opt_L};  
 } elsif ($opt_L eq 'en') {  
         undef $opt_L;  
         undef $translations;  
 } else {  
         printf STDERR "unsupported language %s\n", $opt_L;  
         usage;          usage;
 }  }
   
Line 190  while (<$in>) {
Line 186  while (<$in>) {
                 my ($amount, $text) = ($1, $2);                  my ($amount, $text) = ($1, $2);
                 my $cc = $1 if $text =~ s/\[(.*?)\] *//;                  my $cc = $1 if $text =~ s/\[(.*?)\] *//;
                 $accounts{$ano} or die "unknown account $ano: $line";                  $accounts{$ano} or die "unknown account $ano: $line";
                   ($accounts{$ano}{type} =~ /S/) ==
                       ($accounts{$entry{contra}}{type} =~ /S/)
                       or die "statistical vs. non-statistical account: " .
                       "$entry{contra} split $line";
                 $amount *= $entry{amount} < 0 ? -1 : +1;                  $amount *= $entry{amount} < 0 ? -1 : +1;
   
                 # Combine the text on the split side.                  # Combine the text on the split side.
Line 231  while (<$in>) {
Line 231  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);
         s/^([A-Z]+(?:\d+\/\d+)?) +// 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";
         my $debit = $1;          my $debit = $1;
Line 258  while (<$in>) {
Line 258  while (<$in>) {
                     month   => $month,                      month   => $month,
                     day     => $day,                      day     => $day,
                     date    => "$year-$month-$day",                      date    => "$year-$month-$day",
                     days    => ($month - 1) * 30 + ($day - 1),                      days    => (timegm 0,0,0, $day, $month-1, $year) / 86400,
                     price   => $newpc * $amount,                      price   => $newpc * $amount,
                 };                  };
                 $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;                  $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;
Line 284  while (<$in>) {
Line 284  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->{days} - $old->{days};
                             ($new->{year} - $old->{year}) * 360;  
                         $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 322  while (<$in>) {
Line 321  while (<$in>) {
         );          );
         if ($debit) {          if ($debit) {
                 $accounts{$debit} or die "unknown debit account $debit: $line";                  $accounts{$debit} or die "unknown debit account $debit: $line";
                   # The credit side may or may not be split.
                 my %newentry = (%entry, contra => $credit, amount => $amount);                  my %newentry = (%entry, contra => $credit, amount => $amount);
                 make_entry %newentry, $debit;                  make_entry %newentry, $debit;
         } else {          } else {
                 $credit or die "splitting both sides: $line";                  $credit or die "splitting both sides: $line";
                 # Remember a credit side split.                  # The debit side is split, remember the entry.
                 $entry{contra} = $credit;                  $entry{contra} = $credit;
                 $entry{amount} = $amount;                  $entry{amount} = $amount;
         }          }
         if ($credit) {          if ($credit) {
                 $accounts{$credit}                  $accounts{$credit}
                     or die "unknown credit account $credit: $line";                      or die "unknown credit account $credit: $line";
                   $debit && ($accounts{$debit}{type} =~ /S/) !=
                       ($accounts{$credit}{type} =~ /S/)
                       and die "statistical vs. non-statistical account: $line";
                   # The debit side may or may not be split.
                 my %newentry = (%entry, contra => $debit, amount => -$amount);                  my %newentry = (%entry, contra => $debit, amount => -$amount);
                 make_entry %newentry, $credit;                  make_entry %newentry, $credit;
                 # This entry is not split: clear it after processing.                  # This entry is not split: clear it after processing.
                 %entry = () if $debit;                  %entry = () if $debit;
         } else {          } else {
                 # Remember a debit side split.                  # The credit side is split, remember the entry.
                 $entry{contra} = $debit;                  $entry{contra} = $debit;
                 $entry{amount} = -$amount;                  $entry{amount} = -$amount;
         }          }
Line 520  for my $cc (sort keys %cclist) {
Line 524  for my $cc (sort keys %cclist) {
                             100.0 * $entry->{rel}, $entry->{old};                              100.0 * $entry->{rel}, $entry->{old};
                         if ($entry->{days}) {                          if ($entry->{days}) {
                                 printf "%5.1f%% p.a.",                                  printf "%5.1f%% p.a.",
                                     36000.0 * $entry->{rel} / $entry->{days};                                      36524.5 * $entry->{rel} / $entry->{days};
                         } else {                          } else {
                                 printf "%11s", '';                                  printf "%11s", '';
                         }                          }
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.7
CVSweb