| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | #!/usr/bin/perl | 
					
						
							|  |  |  | # external-accounts-total-reconcile.plx                                    -*- Perl -*- | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | #    Script to verify that balances listed in an external file all match | 
					
						
							|  |  |  | #    the balances | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Copyright (C) 2011, Bradley M. Kuhn | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # This program gives you software freedom; you can copy, modify, convey, | 
					
						
							|  |  |  | # and/or redistribute it under the terms of the GNU General Public License | 
					
						
							|  |  |  | # as published by the Free Software Foundation; either version 3 of the | 
					
						
							|  |  |  | # License, or (at your option) any later version. | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # This program is distributed in the hope that it will be useful, but | 
					
						
							|  |  |  | # WITHOUT ANY WARRANTY; without even the implied warranty of | 
					
						
							|  |  |  | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU | 
					
						
							|  |  |  | # General Public License for more details. | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # You should have received a copy of the GNU General Public License along | 
					
						
							|  |  |  | # with this program in a file called 'GPLv3'.  If not, write to the: | 
					
						
							|  |  |  | #    Free Software Foundation, Inc., 51 Franklin St, Fifth Floor | 
					
						
							|  |  |  | #                                    Boston, MA 02110-1301, USA. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use strict; | 
					
						
							|  |  |  | use warnings; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use Math::BigFloat; | 
					
						
							|  |  |  | use Date::Manip; | 
					
						
							|  |  |  | use File::Temp qw/tempfile/; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my $LEDGER_CMD = "/usr/bin/ledger"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my $ACCT_WIDTH = 75; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | sub ParseNumber($) { | 
					
						
							| 
									
										
										
										
											2011-12-19 11:42:31 -05:00
										 |  |  |   my($val) = @_; | 
					
						
							|  |  |  |   $val =~ s/,//g; | 
					
						
							|  |  |  |   $val =~ s/\s+//g; | 
					
						
							|  |  |  |   $val = - $val if $val =~ s/^\s*\(//; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   return Math::BigFloat->new($val); | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Math::BigFloat->precision(-2); | 
					
						
							|  |  |  | my $ZERO =  Math::BigFloat->new("0.00"); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | if (@ARGV < 3) { | 
					
						
							|  |  |  |   print STDERR "usage: $0 <START_DATE> <END_DATE> <OTHER_LEDGER_OPTS>\n"; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  |   exit 1; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | my($beginDate, $endDate, @otherLedgerOpts) = @ARGV; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | my(@internalBalancesHistoricalOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s', | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  |                             '-e', $endDate, @otherLedgerOpts, 'reg'); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | my(@internalBalancesPeriodOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s', | 
					
						
							|  |  |  |                             '-b', $beginDate, '-e', $endDate, @otherLedgerOpts, 'reg'); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | my %externalBalances; | 
					
						
							|  |  |  | while (my $line = <STDIN>) { | 
					
						
							| 
									
										
										
										
											2011-12-19 10:40:58 -05:00
										 |  |  |   chomp $line; | 
					
						
							|  |  |  |   $line =~ s/^\s*//;   $line =~ s/\s*$//; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 10:40:18 -05:00
										 |  |  |   next unless $line =~ | 
					
						
							| 
									
										
										
										
											2011-12-19 11:42:31 -05:00
										 |  |  |     /^\s*(\S+\:.+)\s+[\(\d].+\s+([\(?\s*\d\.\,]+)\s*\)?\s*$/; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  |   my($acct, $value) = ($1, $2); | 
					
						
							| 
									
										
										
										
											2011-12-19 10:40:58 -05:00
										 |  |  |   $acct =~ s/^\s*//;   $acct =~ s/\s*$//; | 
					
						
							| 
									
										
										
										
											2011-12-19 11:36:44 -05:00
										 |  |  |   $acct =~ s/\s{3,}[\(\)\d,\.\s]+$//; | 
					
						
							| 
									
										
										
										
											2011-12-19 12:44:59 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  |   $externalBalances{$acct} = $ZERO if (not defined $externalBalances{$acct}); | 
					
						
							|  |  |  |   $externalBalances{$acct} += ParseNumber($value); | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | open(ACCT_DATA, "-|", $LEDGER_CMD, @internalBalancesPeriodOptions) | 
					
						
							|  |  |  |   or die "Unable to run $LEDGER_CMD @internalBalancesPeriodOptions: $!"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my %internalBalancesPeriod; | 
					
						
							|  |  |  | while (my $line = <ACCT_DATA>) { | 
					
						
							|  |  |  |   chomp $line; | 
					
						
							|  |  |  |   $line =~ s/^\s*//;   $line =~ s/\s*$//; | 
					
						
							|  |  |  |   die "Strange line, \"$line\" found in ledger output" unless | 
					
						
							|  |  |  |     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   my($acct, $value) = ($1, $2); | 
					
						
							|  |  |  |   $acct =~ s/^\s*//;   $acct =~ s/\s*$//; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   $internalBalancesPeriod{$acct} = ParseNumber($value); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | close(ACCT_DATA); die "error reading ledger output: $!" unless $? == 0; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:44:59 -05:00
										 |  |  | open(ACCT_DATA, "-|", $LEDGER_CMD, @internalBalancesHistoricalOptions) | 
					
						
							|  |  |  |   or die "Unable to run $LEDGER_CMD @internalBalancesHistoricalOptions: $!"; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | my %internalBalancesHistorical; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | while (my $line = <ACCT_DATA>) { | 
					
						
							|  |  |  |   chomp $line; | 
					
						
							|  |  |  |   $line =~ s/^\s*//;   $line =~ s/\s*$//; | 
					
						
							| 
									
										
										
										
											2011-12-19 11:42:31 -05:00
										 |  |  |   die "Strange line, \"$line\" found in ledger output" unless | 
					
						
							|  |  |  |     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  |   my($acct, $value) = ($1, $2); | 
					
						
							| 
									
										
										
										
											2011-12-19 10:40:58 -05:00
										 |  |  |   $acct =~ s/^\s*//;   $acct =~ s/\s*$//; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  |   $internalBalancesHistorical{$acct} = ParseNumber($value); | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | } | 
					
						
							| 
									
										
										
										
											2011-12-19 12:08:56 -05:00
										 |  |  | close(ACCT_DATA); die "error reading ledger output: $!" unless $? == 0; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my(@laterAccountOptions) = ('--wide-register-format', '%-.150A %22.108t\n',  '-w', '-s', | 
					
						
							|  |  |  |                             @otherLedgerOpts, 'reg'); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | open(LATER_ACCT_DATA, "-|", $LEDGER_CMD, @laterAccountOptions) | 
					
						
							|  |  |  |   or die "Unable to run $LEDGER_CMD @laterAccountOptions: $!"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my %laterInternalBalances; | 
					
						
							|  |  |  | while (my $line = <LATER_ACCT_DATA>) { | 
					
						
							|  |  |  |   chomp $line; | 
					
						
							|  |  |  |   $line =~ s/^\s*//;   $line =~ s/\s*$//; | 
					
						
							|  |  |  |   die "Strange line, \"$line\" found in ledger output" unless | 
					
						
							|  |  |  |     $line =~ /^\s*(\S+\:[^\$]+)\s+\$?\s*([\-\d\.\,]+)\s*$/; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   my($acct, $value) = ($1, $2); | 
					
						
							|  |  |  |   $acct =~ s/^\s*//;   $acct =~ s/\s*$//; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   $laterInternalBalances{$acct} = $value; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | close(LATER_ACCT_DATA); die "error reading ledger output: $!" unless $? == 0; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | foreach my $acct (sort keys %externalBalances) { | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  |   if (not defined $internalBalancesPeriod{$acct}) { | 
					
						
							|  |  |  |     if (not defined $laterInternalBalances{$acct} | 
					
						
							|  |  |  |        and not defined $internalBalancesHistorical{$acct}) { | 
					
						
							| 
									
										
										
										
											2011-12-19 12:44:59 -05:00
										 |  |  |       print "$acct\n", | 
					
						
							|  |  |  |             "    EXISTS in external data, but does not appear in Ledger.\n"; | 
					
						
							|  |  |  |       next; | 
					
						
							| 
									
										
										
										
											2011-12-19 12:08:56 -05:00
										 |  |  |     } else { | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  |       $internalBalancesPeriod{$acct} = $ZERO; | 
					
						
							| 
									
										
										
										
											2011-12-19 12:08:56 -05:00
										 |  |  |     } | 
					
						
							| 
									
										
										
										
											2011-12-19 11:49:26 -05:00
										 |  |  |   } | 
					
						
							| 
									
										
										
										
											2011-12-19 12:44:59 -05:00
										 |  |  |   # if the account is an Asset or a Liability, then we want the historical | 
					
						
							|  |  |  |   # balance ending on the $endDate, which is stored in the %internalBalancesHistorical | 
					
						
							|  |  |  |   $internalBalancesPeriod{$acct} = $internalBalancesHistorical{$acct} | 
					
						
							|  |  |  |     if ($acct =~ /^(?:Assets?|Liabilit(?:ies|y))/); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |   print "$acct\n", | 
					
						
							|  |  |  |         "     Ledger:         $internalBalancesPeriod{$acct}\n", | 
					
						
							|  |  |  |         "     External Report: $externalBalances{$acct}\n" | 
					
						
							|  |  |  |     if ($internalBalancesPeriod{$acct} != $externalBalances{$acct}); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  |   delete $internalBalancesPeriod{$acct}; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-12-19 12:36:31 -05:00
										 |  |  | foreach my $acct (sort keys %internalBalancesPeriod) { | 
					
						
							| 
									
										
										
										
											2011-12-19 11:49:26 -05:00
										 |  |  |   print "$acct EXISTS in Ledger, but does not appear in external data.\n"; | 
					
						
							| 
									
										
										
										
											2011-12-19 10:37:25 -05:00
										 |  |  | } | 
					
						
							|  |  |  | ############################################################################### | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Local variables: | 
					
						
							|  |  |  | # compile-command: "perl -c external-account-totals-reconcile.plx" | 
					
						
							|  |  |  | # End: | 
					
						
							|  |  |  | 
 |