Final adjustments to video download script.
[bkuhn:small-hacks.git] / external-account-totals-reconcile.plx
1 #!/usr/bin/perl
2 # external-accounts-total-reconcile.plx                                    -*- Perl -*-
3 #
4 #    Script to verify that balances listed in an external file all match
5 #    the balances
6 #
7 # Copyright (C) 2011, Bradley M. Kuhn
8 #
9 # This program gives you software freedom; you can copy, modify, convey,
10 # and/or redistribute it under the terms of the GNU General Public License
11 # as published by the Free Software Foundation; either version 3 of the
12 # License, or (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 # General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License along
20 # with this program in a file called 'GPLv3'.  If not, write to the:
21 #    Free Software Foundation, Inc., 51 Franklin St, Fifth Floor
22 #                                    Boston, MA 02110-1301, USA.
23
24 use strict;
25 use warnings;
26
27 use Math::BigFloat;
28 use Date::Manip;
29 use File::Temp qw/tempfile/;
30
31 my $LEDGER_CMD = "/usr/bin/ledger";
32
33 my $ACCT_WIDTH = 75;
34
35 sub ParseNumber($) {
36   my($val) = @_;
37   $val =~ s/,//g;
38   $val =~ s/\s+//g;
39   $val = - $val if $val =~ s/^\s*\(//;
40
41   return Math::BigFloat->new($val);
42 }
43
44
45 Math::BigFloat->precision(-2);
46 my $ZERO =  Math::BigFloat->new("0.00");
47
48 if (@ARGV < 3) {
49   print STDERR "usage: $0 <START_DATE> <END_DATE> <OTHER_LEDGER_OPTS>\n";
50   exit 1;
51 }
52
53 my($beginDate, $endDate, @otherLedgerOpts) = @ARGV;
54
55 my(@internalBalancesHistoricalOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s',
56                             '-e', $endDate, @otherLedgerOpts, 'reg');
57
58 my(@internalBalancesPeriodOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s',
59                             '-b', $beginDate, '-e', $endDate, @otherLedgerOpts, 'reg');
60
61 my %externalBalances;
62 while (my $line = <STDIN>) {
63   chomp $line;
64   $line =~ s/^\s*//;   $line =~ s/\s*$//;
65
66   next unless $line =~
67     /^\s*(\S+\:.+)\s+[\(\d].+\s+([\(?\s*\d\.\,]+)\s*\)?\s*$/;
68   my($acct, $value) = ($1, $2);
69   $acct =~ s/^\s*//;   $acct =~ s/\s*$//;
70   $acct =~ s/\s{3,}[\(\)\d,\.\s]+$//;
71
72   $externalBalances{$acct} = $ZERO if (not defined $externalBalances{$acct});
73   $externalBalances{$acct} += ParseNumber($value);
74 }
75
76 open(ACCT_DATA, "-|", $LEDGER_CMD, @internalBalancesPeriodOptions)
77   or die "Unable to run $LEDGER_CMD @internalBalancesPeriodOptions: $!";
78
79 my %internalBalancesPeriod;
80 while (my $line = <ACCT_DATA>) {
81   chomp $line;
82   $line =~ s/^\s*//;   $line =~ s/\s*$//;
83   die "Strange line, \"$line\" found in ledger output" unless
84     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/;
85
86   my($acct, $value) = ($1, $2);
87   $acct =~ s/^\s*//;   $acct =~ s/\s*$//;
88
89   $internalBalancesPeriod{$acct} = ParseNumber($value);
90
91 }
92 close(ACCT_DATA); die "error reading ledger output: $!" unless $? == 0;
93
94
95 open(ACCT_DATA, "-|", $LEDGER_CMD, @internalBalancesHistoricalOptions)
96   or die "Unable to run $LEDGER_CMD @internalBalancesHistoricalOptions: $!";
97
98 my %internalBalancesHistorical;
99 while (my $line = <ACCT_DATA>) {
100   chomp $line;
101   $line =~ s/^\s*//;   $line =~ s/\s*$//;
102   die "Strange line, \"$line\" found in ledger output" unless
103     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/;
104
105   my($acct, $value) = ($1, $2);
106   $acct =~ s/^\s*//;   $acct =~ s/\s*$//;
107
108   $internalBalancesHistorical{$acct} = ParseNumber($value);
109
110 }
111 close(ACCT_DATA); die "error reading ledger output: $!" unless $? == 0;
112
113 my(@laterAccountOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s',
114                             @otherLedgerOpts, 'reg');
115
116 open(LATER_ACCT_DATA, "-|", $LEDGER_CMD, @laterAccountOptions)
117   or die "Unable to run $LEDGER_CMD @laterAccountOptions: $!";
118
119 my %laterInternalBalances;
120 while (my $line = <LATER_ACCT_DATA>) {
121   chomp $line;
122   $line =~ s/^\s*//;   $line =~ s/\s*$//;
123   die "Strange line, \"$line\" found in ledger output" unless
124     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/;
125
126   my($acct, $value) = ($1, $2);
127   $acct =~ s/^\s*//;   $acct =~ s/\s*$//;
128
129   $laterInternalBalances{$acct} = $value;
130
131 }
132 close(LATER_ACCT_DATA); die "error reading ledger output: $!" unless $? == 0;
133
134 foreach my $acct (sort keys %externalBalances) {
135   if (not defined $internalBalancesPeriod{$acct}) {
136     if (not defined $laterInternalBalances{$acct}
137        and not defined $internalBalancesHistorical{$acct}) {
138       print "$acct\n",
139             "    EXISTS in external data, but does not appear in Ledger.\n";
140       next;
141     } else {
142       $internalBalancesPeriod{$acct} = $ZERO;
143     }
144   }
145   # if the account is an Asset or a Liability, then we want the historical
146   # balance ending on the $endDate, which is stored in the %internalBalancesHistorical
147   $internalBalancesPeriod{$acct} = $internalBalancesHistorical{$acct}
148     if ($acct =~ /^(?:Assets?|Liabilit(?:ies|y))/);
149
150   print "$acct\n",
151         "     Ledger:         $internalBalancesPeriod{$acct}\n",
152         "     External Report: $externalBalances{$acct}\n"
153     if ($internalBalancesPeriod{$acct} != $externalBalances{$acct});
154
155   delete $internalBalancesPeriod{$acct};
156 }
157
158 foreach my $acct (sort keys %internalBalancesPeriod) {
159   print "$acct EXISTS in Ledger, but does not appear in external data.\n";
160 }
161 ###############################################################################
162 #
163 # Local variables:
164 # compile-command: "perl -c external-account-totals-reconcile.plx"
165 # End:
166