r17283 - gnucash/branches/2.2/src/report/report-system - [r17266] Bug #460721, bug #521403, bug #538800: Add a reporting price source option of "Average Cost".
Christian Stimming
cstim at cvs.gnucash.org
Mon Jul 7 16:57:36 EDT 2008
Author: cstim
Date: 2008-07-07 16:57:36 -0400 (Mon, 07 Jul 2008)
New Revision: 17283
Trac: http://svn.gnucash.org/trac/changeset/17283
Modified:
gnucash/branches/2.2/src/report/report-system/commodity-utilities.scm
gnucash/branches/2.2/src/report/report-system/options-utilities.scm
gnucash/branches/2.2/src/report/report-system/report-system.scm
Log:
[r17266] Bug #460721, bug #521403, bug #538800: Add a reporting price source option of "Average Cost".
Originally by cedayiv.
Modified: gnucash/branches/2.2/src/report/report-system/commodity-utilities.scm
===================================================================
--- gnucash/branches/2.2/src/report/report-system/commodity-utilities.scm 2008-07-07 20:57:26 UTC (rev 17282)
+++ gnucash/branches/2.2/src/report/report-system/commodity-utilities.scm 2008-07-07 20:57:36 UTC (rev 17283)
@@ -614,6 +614,89 @@
(gnc:resolve-unknown-comm sumlist report-commodity)))
+;; Calculate the volume-weighted average cost of all commodities,
+;; priced in the 'report-commodity'. Uses all transactions up until
+;; the 'end-date'. Returns an alist, see sumlist.
+(define (gnc:get-exchange-cost-totals report-commodity end-date)
+ (let ((curr-accounts
+ ;;(filter gnc:account-has-shares? ))
+ ;; -- use all accounts, not only share accounts, since gnucash-1.7
+ (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+ ;; sumlist: a multilevel alist. Each element has a commodity
+ ;; as key, and another alist as a value. The value-alist's
+ ;; elements consist of a commodity as a key, and a pair of two
+ ;; value-collectors as value, e.g. with only one (the report-)
+ ;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
+ ;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
+ ;; <gnc:commodity> and the numbers are a numeric-collector
+ ;; which in turn store a <gnc:numeric>. In the example, USD
+ ;; 400 were bought for an amount of DEM 1000, FRF 300 were
+ ;; bought for DEM 100. The reason for the outer alist is that
+ ;; there might be commodity transactions which do not involve
+ ;; the report-commodity, but which can still be calculated
+ ;; after *all* transactions are processed.
+ (sumlist (list (list report-commodity '()))))
+
+ (if (not (null? curr-accounts))
+ ;; Go through all splits and add up all value-amounts
+ ;; and share-amounts
+ (for-each
+ (lambda (a)
+ (let* ((transaction-comm (xaccTransGetCurrency
+ (xaccSplitGetParent a)))
+ (account-comm (xaccAccountGetCommodity
+ (xaccSplitGetAccount a)))
+ (share-amount (xaccSplitGetAmount a))
+ (value-amount (xaccSplitGetValue a))
+ (tmp (assoc transaction-comm sumlist))
+ (comm-list (if (not tmp)
+ (assoc account-comm sumlist)
+ tmp)))
+
+ ;; entry exists already in comm-list?
+ (if (not comm-list)
+ ;; no, create sub-alist from scratch
+ (let ((pair (list transaction-comm
+ (cons (gnc:make-numeric-collector)
+ (gnc:make-numeric-collector)))))
+ ((caadr pair) 'add value-amount)
+ ((cdadr pair) 'add share-amount)
+ (set! comm-list (list account-comm (list pair)))
+ ;; and add the new sub-alist to sumlist.
+ (set! sumlist (cons comm-list sumlist)))
+ ;; yes, check for second commodity.
+ (let*
+ ;; Put the amounts in the right place.
+ ((foreignlist
+ (if (gnc-commodity-equiv transaction-comm
+ (car comm-list))
+ (list account-comm
+ share-amount value-amount)
+ (list transaction-comm
+ value-amount share-amount)))
+ ;; second commodity already existing in comm-list?
+ (pair (assoc (car foreignlist) (cadr comm-list))))
+ ;; if not, create a new entry in comm-list.
+ (if (not pair)
+ (begin
+ (set!
+ pair (list (car foreignlist)
+ (cons (gnc:make-numeric-collector)
+ (gnc:make-numeric-collector))))
+ (set!
+ comm-list (list (car comm-list)
+ (cons pair (cadr comm-list))))
+ (set!
+ sumlist (cons comm-list
+ (alist-delete
+ (car comm-list) sumlist)))))
+ ;; And add the balances to the comm-list entry.
+ ((caadr pair) 'add (cadr foreignlist))
+ ((cdadr pair) 'add (caddr foreignlist))))))
+ (gnc:get-all-commodity-splits curr-accounts end-date)))
+
+ (gnc:resolve-unknown-comm sumlist report-commodity)))
+
;; Anybody feel free to reimplement any of these functions, either in
;; scheme or in C. -- cstim
@@ -631,10 +714,24 @@
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
(gnc:get-exchange-totals report-commodity end-date)))
+(define (gnc:make-exchange-cost-alist report-commodity end-date)
+ ;; This returns the alist with the actual exchange rates, i.e. the
+ ;; total balances from get-exchange-totals are divided by each
+ ;; other.
+ (map
+ (lambda (e)
+ (list (car e)
+ (gnc-numeric-abs
+ (gnc-numeric-div ((cdadr e) 'total #f)
+ ((caadr e) 'total #f)
+ GNC-DENOM-AUTO
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
+ (gnc:get-exchange-cost-totals report-commodity end-date)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Actual functions for exchanging amounts.
@@ -826,6 +923,9 @@
(define (gnc:case-exchange-fn
source-option report-currency to-date-tp)
(case source-option
+ ((average-cost) (gnc:make-exchange-function
+ (gnc:make-exchange-cost-alist
+ report-currency to-date-tp)))
((weighted-average) (gnc:make-exchange-function
(gnc:make-exchange-alist
report-currency to-date-tp)))
Modified: gnucash/branches/2.2/src/report/report-system/options-utilities.scm
===================================================================
--- gnucash/branches/2.2/src/report/report-system/options-utilities.scm 2008-07-07 20:57:26 UTC (rev 17282)
+++ gnucash/branches/2.2/src/report/report-system/options-utilities.scm 2008-07-07 20:57:36 UTC (rev 17283)
@@ -171,7 +171,10 @@
(gnc:make-multichoice-option
pagename optname
sort-tag (N_ "The source of price information") default
- (list (vector 'weighted-average
+ (list (vector 'average-cost
+ (N_ "Average Cost")
+ (N_ "The volume-weighted average cost of purchases"))
+ (vector 'weighted-average
(N_ "Weighted Average")
(N_ "The weighted average of all currency transactions of the past"))
(vector 'pricedb-latest
Modified: gnucash/branches/2.2/src/report/report-system/report-system.scm
===================================================================
--- gnucash/branches/2.2/src/report/report-system/report-system.scm 2008-07-07 20:57:26 UTC (rev 17282)
+++ gnucash/branches/2.2/src/report/report-system/report-system.scm 2008-07-07 20:57:36 UTC (rev 17283)
@@ -33,7 +33,9 @@
(export gnc:pricealist-lookup-nearest-in-time)
(export gnc:resolve-unknown-comm)
(export gnc:get-exchange-totals)
+(export gnc:get-exchange-cost-totals)
(export gnc:make-exchange-alist)
+(export gnc:make-exchange-cost-alist)
(export gnc:exchange-by-euro)
(export gnc:exchange-if-same)
(export gnc:make-exchange-function)
More information about the gnucash-changes
mailing list