Parse negative numbers better.
[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 < 2) {
49   print STDERR "usage: $0 <END_DATE> <OTHER_LEDGER_OPTS>\n";
50   exit 1;
51 }
52
53 my($endDate, @otherLedgerOpts) = @ARGV;
54
55 my(@accountOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s',
56                             '-e', $endDate, @otherLedgerOpts, 'reg');
57
58 my %externalBalances;
59 while (my $line = <STDIN>) {
60   chomp $line;
61   $line =~ s/^\s*//;   $line =~ s/\s*$//;
62
63   next unless $line =~
64     /^\s*(\S+\:.+)\s+[\(\d].+\s+([\(?\s*\d\.\,]+)\s*\)?\s*$/;
65   my($acct, $value) = ($1, $2);
66   $acct =~ s/^\s*//;   $acct =~ s/\s*$//;
67   $acct =~ s/\s{3,}[\(\)\d,\.\s]+$//;
68   $externalBalances{$acct} = ParseNumber($value);
69 }
70
71 open(ACCT_DATA, "-|", $LEDGER_CMD, @accountOptions)
72   or die "Unable to run $LEDGER_CMD @accountOptions: $!";
73
74 my %internalBalances;
75 while (my $line = <ACCT_DATA>) {
76   chomp $line;
77   $line =~ s/^\s*//;   $line =~ s/\s*$//;
78   die "Strange line, \"$line\" found in ledger output" unless
79     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/;
80
81   my($acct, $value) = ($1, $2);
82   $acct =~ s/^\s*//;   $acct =~ s/\s*$//;
83
84   $internalBalances{$acct} = ParseNumber($value);
85
86 }
87 close(ACCT_DATA); die "error reading ledger output for chart of accounts: $!" unless $? == 0;
88
89 print "EXTERNAL: \n";
90 foreach my $acct (sort keys %externalBalances) {
91   print "$acct: $externalBalances{$acct}\n";
92 }
93
94 print "INTERNAL: \n";
95 foreach my $acct (sort keys %internalBalances) {
96   print "$acct: $internalBalances{$acct}\n";
97 }
98 ###############################################################################
99 #
100 # Local variables:
101 # compile-command: "perl -c external-account-totals-reconcile.plx"
102 # End:
103