cash-flow.scm report problems
Ed Warnicke
hagbard@physics.rutgers.edu
Sun, 29 Dec 2002 17:03:41 -0500
This is a multi-part message in MIME format.
--------------070902010005050905060607
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
The cash-flow.scm report was not handling transactions containing
multiple splits
correctly. A transaction like:
Description Account Amount
Salary Income:Salary 100
401k contrib Assets:401k 50
Check Deposit Assets:Checking 50
which terminates in two Asset accounts would contribute
twice to the money-in and money-out totals, because we no
check was being made as to whether a split had been counted once or not.
I've attached a patch to cash-flow.scm which fixes this problem.
Please review it and either check it in, or complain about what I did
wrong :)
Ed
--------------070902010005050905060607
Content-Type: text/plain;
name="cash-flow.scm.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="cash-flow.scm.patch"
--- cash-flow.scm.orig 2002-12-23 23:35:16.000000000 -0500
+++ cash-flow.scm 2002-12-29 16:51:04.000000000 -0500
@@ -153,6 +153,9 @@
(define (same-account? a1 a2)
(string=? (gnc:account-get-guid a1) (gnc:account-get-guid a2)))
+ (define (same-split? s1 s2)
+ (string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2)))
+
(define account-in-list?
(lambda (account accounts)
(cond
@@ -160,10 +163,17 @@
((same-account? (car accounts) account) #t)
(else (account-in-list? account (cdr accounts))))))
+ (define split-in-list?
+ (lambda (split splits)
+ (cond
+ ((null? splits) #f)
+ ((same-split? (car splits) split) #t)
+ (else (split-in-list? split (cdr splits))))))
+
(define account-in-alist
(lambda (account alist)
(cond
- ((null? alist) #f)
+ ((null? alist) #f)
((same-account? (caar alist) account) (car alist))
(else (account-in-alist account (cdr alist))))))
@@ -223,11 +233,11 @@
(money-out-collector (gnc:make-commodity-collector))
(money-diff-collector (gnc:make-commodity-collector))
- (splits-to-do (gnc:accounts-count-splits accounts)))
+ (splits-to-do (gnc:accounts-count-splits accounts))
+ (seen-split-list '()))
;; function to add inflow and outflow of money
(define (calc-money-in-out accounts)
-
(define (calc-money-in-out-internal accounts-internal)
(if (not (null? accounts-internal))
(let* ((current (car accounts-internal))
@@ -236,7 +246,7 @@
(curr-commodity (gnc:account-get-commodity current))
)
- ;(gnc:debug "---" name "---" (gnc:commodity-get-printname curr-commodity))
+ ;(gnc:debug "calc-money-in-out-internal---" name "---" (gnc:commodity-get-printname curr-commodity))
(for-each
(lambda (split)
@@ -258,45 +268,50 @@
(s-commodity (gnc:account-get-commodity s-account)))
;(gnc:debug (gnc:account-get-name s-account))
(if (not (account-in-list? s-account accounts))
- (if (gnc:numeric-negative-p (gnc:split-get-value s))
- (let ((pair (account-in-alist s-account money-in-alist)))
- ;(gnc:debug "in:" (gnc:commodity-get-printname s-commodity)
- ; (gnc:numeric-to-double s-amount)
- ; (gnc:commodity-get-printname curr-commodity)
- ; (gnc:numeric-to-double s-value))
- (if (not pair)
- (begin
- (set! pair (list s-account (gnc:make-commodity-collector)))
- (set! money-in-alist (cons pair money-in-alist))
- (set! money-in-accounts (cons s-account money-in-accounts))
- ;(gnc:debug money-in-alist)
- )
- )
- (let ((s-account-in-collector (cadr pair)))
- (money-in-collector 'add parent-currency (gnc:numeric-neg s-value))
- (s-account-in-collector 'add parent-currency (gnc:numeric-neg s-value)))
- )
- (let ((pair (account-in-alist s-account money-out-alist)))
- ;(gnc:debug "out:" (gnc:commodity-get-printname s-commodity)
- ; (gnc:numeric-to-double s-amount)
- ; (gnc:commodity-get-printname curr-commodity)
- ; (gnc:numeric-to-double s-value))
- (if (not pair)
- (begin
- (set! pair (list s-account (gnc:make-commodity-collector)))
- (set! money-out-alist (cons pair money-out-alist))
- (set! money-out-accounts (cons s-account money-out-accounts))
- ;(gnc:debug money-out-alist)
- )
- )
- (let ((s-account-out-collector (cadr pair)))
- (money-out-collector 'add parent-currency s-value)
- (s-account-out-collector 'add parent-currency s-value))
- )
- )
- )
- )
- )
+ (if (not (split-in-list? s seen-split-list))
+ (begin
+ (set! seen-split-list (cons s seen-split-list))
+ (if (gnc:numeric-negative-p (gnc:split-get-value s))
+ (let ((pair (account-in-alist s-account money-in-alist)))
+ ;(gnc:debug "in:" (gnc:commodity-get-printname s-commodity)
+ ; (gnc:numeric-to-double s-amount)
+ ; (gnc:commodity-get-printname curr-commodity)
+ ; (gnc:numeric-to-double s-value))
+ (if (not pair)
+ (begin
+ (set! pair (list s-account (gnc:make-commodity-collector)))
+ (set! money-in-alist (cons pair money-in-alist))
+ (set! money-in-accounts (cons s-account money-in-accounts))
+ ;(gnc:debug money-in-alist)
+ )
+ )
+ (let ((s-account-in-collector (cadr pair)))
+ (money-in-collector 'add parent-currency (gnc:numeric-neg s-value))
+ (s-account-in-collector 'add parent-currency (gnc:numeric-neg s-value)))
+ )
+ (let ((pair (account-in-alist s-account money-out-alist)))
+ ;(gnc:debug "out:" (gnc:commodity-get-printname s-commodity)
+ ; (gnc:numeric-to-double s-amount)
+ ; (gnc:commodity-get-printname curr-commodity)
+ ; (gnc:numeric-to-double s-value))
+ (if (not pair)
+ (begin
+ (set! pair (list s-account (gnc:make-commodity-collector)))
+ (set! money-out-alist (cons pair money-out-alist))
+ (set! money-out-accounts (cons s-account money-out-accounts))
+ ;(gnc:debug money-out-alist)
+ )
+ )
+ (let ((s-account-out-collector (cadr pair)))
+ (money-out-collector 'add parent-currency s-value)
+ (s-account-out-collector 'add parent-currency s-value))
+ )
+ )
+ )
+ )
+ )
+ )
+ )
(gnc:transaction-get-splits parent)
)
)
--------------070902010005050905060607--