IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'bug799258-cpp' into stable #1920

Browse Source
This commit is contained in:
Christopher Lam 2024-04-22 19:34:19 +08:00
commit 5dab612d1b
5 changed files with 142 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
bindings/engine.i
View File

@ -41,6 +41,7 @@
#include "gnc-kvp-guile.h"
#include "glib-guile.h"
#include "Account.hpp"
#include "gncAddress.h"
#include "gncBillTerm.h"
#include "gncCustomer.h"
@ -56,6 +57,13 @@
%}
#if defined(SWIGGUILE) //Always C++
%{
using SplitsVec = std::vector<Split*>;
using AccountVec = std::vector<Account*>;
SplitsVec gnc_get_match_commodity_splits (AccountVec accounts, bool use_end_date,
time64 end_date, gnc_commodity *comm, bool sort);
extern "C"
{
SCM scm_init_sw_engine_module (void);
@ -73,6 +81,8 @@ GLIST_HELPER_INOUT(AccountList, SWIGTYPE_p_Account);
GLIST_HELPER_INOUT(PriceList, SWIGTYPE_p_GNCPrice);
// TODO: free PriceList?
GLIST_HELPER_INOUT(CommodityList, SWIGTYPE_p_gnc_commodity);
VECTOR_HELPER_INOUT(SplitsVec, SWIGTYPE_p_Split, Split);
VECTOR_HELPER_INOUT(AccountVec, SWIGTYPE_p_Account, Account);
%typemap(newfree) char * "g_free($1);"
@ -115,6 +125,28 @@ static const GncGUID * gncPriceGetGUID(GNCPrice *x)
{ return qof_instance_get_guid(QOF_INSTANCE(x)); }
static const GncGUID * gncBudgetGetGUID(GncBudget *x)
{ return qof_instance_get_guid(QOF_INSTANCE(x)); }
SplitsVec gnc_get_match_commodity_splits (AccountVec accounts, bool use_end_date,
time64 end_date, gnc_commodity *comm, bool sort)
{
auto match = [use_end_date, end_date, comm](const Split* s) -> bool
{
if (xaccSplitGetReconcile (s) == VREC) return false;
auto trans{xaccSplitGetParent (s)};
if (use_end_date && xaccTransGetDate(trans) > end_date) return false;
auto txn_comm{xaccTransGetCurrency (trans)};
auto acc_comm{xaccAccountGetCommodity (xaccSplitGetAccount (s))};
return (txn_comm != acc_comm) && (!comm || comm == txn_comm || comm == acc_comm);
};
std::vector<Split*> rv;
auto maybe_accumulate_split = [&rv, match](auto s){ if (match(s)) rv.push_back (s); };
for (const auto acc : accounts)
gnc_account_foreach_split (acc, maybe_accumulate_split, true);
if (sort)
std::sort (rv.begin(), rv.end(), [](auto a, auto b){ return xaccSplitOrder (a, b) < 0; });
return rv;
}
%}
/* NB: The object ownership annotations should already cover all the

23
common/base-typemaps.i
View File

@ -162,6 +162,29 @@ typedef char gchar;
$result = scm_reverse(list);
}
%enddef
%define VECTOR_HELPER_INOUT(VectorType, ElemSwigType, ElemType)
%typemap(in) VectorType {
std::vector<ElemType*> accum;
for (auto node = $input; !scm_is_null (node); node = scm_cdr (node))
{
auto p_scm = scm_car (node);
auto p = (scm_is_false (p_scm) || scm_is_null (p_scm)) ? static_cast<ElemType*>(nullptr) :
static_cast<ElemType*>(SWIG_MustGetPtr(p_scm, ElemSwigType, 1, 0));
accum.push_back (p);
}
accum.swap ($1);
}
%typemap(out) VectorType {
SCM list = SCM_EOL;
std::for_each ($1.rbegin(), $1.rend(), [&list](auto n)
{ list = scm_cons(SWIG_NewPointerObj(n, ElemSwigType, 0), list); });
$result = list;
}
%enddef
#elif defined(SWIGPYTHON) /* Typemaps for Python */
%import "glib.h"

152
gnucash/report/commodity-utilities.scm
View File

@ -61,18 +61,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get splits with interesting data from accounts.
;; helper function. queries book for all splits in accounts before
;; end-date (end-date can be #f)
(define (get-all-splits accounts end-date)
(let ((query (qof-query-create-for-splits)))
(qof-query-set-book query (gnc-get-current-book))
(xaccQueryAddClearedMatch
query (logand CLEARED-ALL (lognot CLEARED-VOIDED)) QOF-QUERY-AND)
(xaccQueryAddAccountMatch query accounts QOF-GUID-MATCH-ANY QOF-QUERY-AND)
(xaccQueryAddDateMatchTT query #f 0 (and end-date #t) (or end-date 0) QOF-QUERY-AND)
(let ((splits (qof-query-run query)))
(qof-query-destroy query)
splits)))
(define (get-all-commodity-splits currency-accounts end-date commodity sort?)
(gnc-get-match-commodity-splits currency-accounts (and end-date #t)
(or end-date 0) (or commodity '()) sort?))
;; Returns a list of all splits in the 'currency-accounts' up to
;; 'end-date' which have two different commodities involved, one of
@ -80,15 +72,7 @@
;; 'commodity' != #f ).
(define (gnc:get-match-commodity-splits
currency-accounts end-date commodity)
(filter
(lambda (s)
(let ((txn-comm (xaccTransGetCurrency (xaccSplitGetParent s)))
(acc-comm (xaccAccountGetCommodity (xaccSplitGetAccount s))))
(and (not (gnc-commodity-equiv txn-comm acc-comm))
(or (not commodity)
(gnc-commodity-equiv commodity txn-comm)
(gnc-commodity-equiv commodity acc-comm)))))
(get-all-splits currency-accounts end-date)))
(get-all-commodity-splits currency-accounts end-date commodity #f))
;; Returns a sorted list of all splits in the 'currency-accounts' up
;; to 'end-date' which have the 'commodity' and one other commodity
@ -96,12 +80,7 @@
(define (gnc:get-match-commodity-splits-sorted currency-accounts
end-date
commodity)
(sort (gnc:get-match-commodity-splits currency-accounts
end-date commodity)
(lambda (a b)
(<
(xaccTransGetDate (xaccSplitGetParent a))
(xaccTransGetDate (xaccSplitGetParent b))))))
(get-all-commodity-splits currency-accounts end-date commodity #t))
;; Returns a list of all splits in the currency-accounts up to
@ -145,10 +124,12 @@
(gnc:get-commodity-totalavg-prices-internal
currency-accounts end-date price-commodity report-currency
(gnc:get-match-commodity-splits-sorted
currency-accounts end-date price-commodity)))
currency-accounts end-date price-commodity)
#f))
(define (gnc:get-commodity-totalavg-prices-internal
currency-accounts end-date price-commodity report-currency commodity-splits)
currency-accounts end-date price-commodity report-currency commodity-splits
hide-warnings?)
(let loop ((tot-foreign 0)
(tot-domestic 0)
(commodity-splits commodity-splits)
@ -194,16 +175,17 @@
(cons (list txn-date (/ new-domestic new-foreign)) result)))))
(else
(warn "gnc:get-commodity-totalavg-prices: "
"Sorry, currency exchange not yet implemented:"
(gnc:monetary->string
(gnc:make-gnc-monetary txn-comm value-amt))
" (buying "
(gnc:monetary->string
(gnc:make-gnc-monetary price-commodity share-amt))
") =? "
(gnc:monetary->string
(gnc:make-gnc-monetary report-currency 0)))
(unless hide-warnings?
(warn "gnc:get-commodity-totalavg-prices: "
"Sorry, currency exchange not yet implemented:"
(gnc:monetary->string
(gnc:make-gnc-monetary txn-comm value-amt))
" (buying "
(gnc:monetary->string
(gnc:make-gnc-monetary price-commodity share-amt))
") =? "
(gnc:monetary->string
(gnc:make-gnc-monetary report-currency 0))))
(loop tot-foreign
tot-domestic
(cdr commodity-splits)
@ -215,9 +197,9 @@
;; extended to a commodity-list. Returns an alist. Each pair consists
;; of the foreign-currency and the appropriate list from
;; gnc:get-commodity-totalavg-prices, see there.
(define (gnc:get-commoditylist-totalavg-prices
commodity-list report-currency end-date
start-percent delta-percent)
(define* (gnc:get-commoditylist-totalavg-prices
commodity-list report-currency end-date
start-percent delta-percent #:key hide-warnings?)
(let* ((currency-accounts
(gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
(interesting-splits (gnc:get-match-commodity-splits-sorted currency-accounts end-date #f))
@ -234,7 +216,8 @@
(cons c
(gnc:get-commodity-totalavg-prices-internal
currency-accounts end-date c report-currency
(filter split-has-commodity? interesting-splits))))
(filter split-has-commodity? interesting-splits)
hide-warnings?)))
commodity-list
(iota work-to-do))))
@ -327,7 +310,7 @@
;; (described in gnc:get-exchange-totals) and returns a report-list, This
;; resulting alist can immediately be plugged into gnc:make-exchange-alist.
(define (gnc:resolve-unknown-comm sumlist report-commodity)
(define* (gnc:resolve-unknown-comm sumlist report-commodity #:key hide-warnings?)
;; reportlist contains all known transactions with the
;; report-commodity, and now the transactions with unknown
;; currencies should be added to that list (with an appropriate
@ -402,28 +385,30 @@
;; If neither the currency of (car sumlist) nor of pair
;; was found in reportlist then we can't resolve the
;; exchange rate to this currency.
(warn "gnc:resolve-unknown-comm:"
"can't calculate rate for "
(gnc:monetary->string
(gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
(gnc:monetary->string
(gnc:make-gnc-monetary (caar sumlist) ((cdadr pair) 'total #f)))
" to "
(gnc:monetary->string (gnc:make-gnc-monetary report-commodity 0)))
(unless hide-warnings?
(warn "gnc:resolve-unknown-comm:"
"can't calculate rate for "
(gnc:monetary->string
(gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
(gnc:monetary->string
(gnc:make-gnc-monetary (caar sumlist) ((cdadr pair) 'total #f)))
" to "
(gnc:monetary->string (gnc:make-gnc-monetary report-commodity 0))))
(innerloop (cdr pairs) reportlist))
((and pair-a pair-b)
;; If both currencies are found then something went
;; wrong inside gnc:get-exchange-totals. FIXME: Find a
;; better thing to do in this case.
(warn "gnc:resolve-unknown-comm:"
"Oops - exchange rate ambiguity error: "
(gnc:monetary->string
(gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
(gnc:monetary->string
(gnc:make-gnc-monetary (caar sumlist) ((cdadr pair) 'total #f))))
(unless hide-warnings?
(warn "gnc:resolve-unknown-comm:"
"Oops - exchange rate ambiguity error: "
(gnc:monetary->string
(gnc:make-gnc-monetary (car pair) ((caadr pair) 'total #f)))
" = "
(gnc:monetary->string
(gnc:make-gnc-monetary (caar sumlist) ((cdadr pair) 'total #f)))))
(innerloop (cdr pairs) reportlist))
;; Usual case: one of pair-{a,b} was found in reportlist,
@ -532,7 +517,7 @@
;; Sum the net amounts and values in the report commodity, including booked
;; gains and losses, of each commodity across all accounts. Returns a
;; report-list.
(define (gnc:get-exchange-cost-totals report-commodity end-date)
(define* (gnc:get-exchange-cost-totals report-commodity end-date #:key hide-warnings?)
(let ((curr-accounts (gnc-account-get-descendants-sorted
(gnc-get-current-root-account))))
@ -540,7 +525,7 @@
(sumlist (list (list report-commodity '()))))
(cond
((null? comm-splits)
(gnc:resolve-unknown-comm sumlist report-commodity))
(gnc:resolve-unknown-comm sumlist report-commodity #:hide-warnings? hide-warnings?))
;; However skip splits in trading accounts as these counterbalance
;; the actual value and share amounts back to zero
@ -621,7 +606,7 @@
(list comm (abs (/ (foreign 'total #f) (domestic 'total #f))))))
(gnc:get-exchange-totals report-commodity end-date)))
(define (gnc:make-exchange-cost-alist report-commodity end-date)
(define* (gnc:make-exchange-cost-alist report-commodity end-date #:key hide-warnings?)
;; This returns the alist with the actual exchange rates, i.e. the
;; total balances from get-exchange-totals are divided by each
;; other.
@ -630,7 +615,7 @@
((comm (domestic . foreign))
(let ((denom (domestic 'total #f)))
(list comm (if (zero? denom) 0 (abs (/ (foreign 'total #f) denom)))))))
(gnc:get-exchange-cost-totals report-commodity end-date)))
(gnc:get-exchange-cost-totals report-commodity end-date #:hide-warnings? hide-warnings?)))
@ -844,19 +829,38 @@
(define (gnc:case-exchange-time-fn
source-option report-currency commodity-list to-date-tp
start-percent delta-percent)
(define date-hash (make-hash-table))
(define-syntax-rule (memoize date expensive-fn)
(or (hash-ref date-hash date) (hashv-set! date-hash date expensive-fn)))
;; call the expensive function ONCE with the warnings enabled. this
;; will log any warnings related to impossible currency conversions
;; for splits upto the report-date
(case source-option
((average-cost) (memoize to-date-tp
(gnc:make-exchange-function
(gnc:make-exchange-cost-alist
report-currency to-date-tp))))
((weighted-average) (memoize to-date-tp
(gnc:get-commoditylist-totalavg-prices
commodity-list report-currency to-date-tp
start-percent delta-percent))))
(case source-option
;; Make this the same as gnc:case-exchange-fn
((average-cost) (let* ((exchange-fn (gnc:make-exchange-function
(gnc:make-exchange-cost-alist
report-currency to-date-tp))))
(lambda (foreign domestic date)
((average-cost) (lambda (foreign domestic date)
(let* ((end-day (gnc:time64-end-day-time date))
(exchange-fn (memoize end-day
(gnc:make-exchange-function
(gnc:make-exchange-cost-alist
report-currency end-day
#:hide-warnings? #t)))))
(exchange-fn foreign domestic))))
((weighted-average) (let ((pricealist
(gnc:get-commoditylist-totalavg-prices
commodity-list report-currency to-date-tp
start-percent delta-percent)))
(gnc:debug "weighted-average pricealist " pricealist)
(lambda (foreign domestic date)
((weighted-average) (lambda (foreign domestic date)
(let* ((end-day (gnc:time64-end-day-time date))
(pricealist (memoize end-day
(gnc:get-commoditylist-totalavg-prices
commodity-list report-currency end-day
start-percent delta-percent
#:hide-warnings? #t))))
(gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date))))
((pricedb-before) gnc:exchange-by-pricedb-nearest-before)

18
gnucash/report/reports/standard/balsheet-pnl.scm
View File

@ -736,17 +736,10 @@ also show overall period profit & loss."))
(cons acc (map col-datum-get-split-balance-with-closing cols-data))))
accounts-cols-data))
;; generate an exchange-fn for date, and cache its result.
(get-date-exchange-fn
(let ((h (make-hash-table))
(commodities (gnc:accounts-get-commodities accounts #f)))
(lambda (date)
(or (hashv-ref h date)
(let ((exchangefn (gnc:case-exchange-time-fn
price-source common-currency commodities
date #f #f)))
(hashv-set! h date exchangefn)
exchangefn)))))
;; generate an exchange-fn
(exchange-fn (gnc:case-exchange-time-fn price-source common-currency
(gnc:accounts-get-commodities accounts #f)
#f #f #f))
;; from col-idx, find effective date to retrieve pricedb
;; entry or to limit transactions to calculate average-cost
@ -772,8 +765,7 @@ also show overall period profit & loss."))
(gnc:gnc-monetary-commodity monetary)
common-currency))
(has-price? (gnc:gnc-monetary-commodity monetary))
(let* ((col-date (col-idx->price-date col-idx))
(exchange-fn (get-date-exchange-fn col-date)))
(let ((col-date (col-idx->price-date col-idx)))
(exchange-fn monetary common-currency col-date)))))
;; the following function generates an gnc:html-text object

8
gnucash/report/test/test-commodity-utils.scm
View File

@ -655,7 +655,7 @@
(gnc-dmy2time64-neutral 20 02 2016)
#f #f)))
(test-equal "gnc:case-exchange-time-fn weighted-average 20/02/2012"
307/5
0
(gnc:gnc-monetary-amount
(exchange-fn
(gnc:make-gnc-monetary AAPL 1)
@ -663,7 +663,7 @@
(gnc-dmy2time64-neutral 20 02 2012))))
(test-equal "gnc:case-exchange-time-fn weighted-average 20/02/2014"
9366/125
307/5
(gnc:gnc-monetary-amount
(exchange-fn
(gnc:make-gnc-monetary AAPL 1)
@ -687,7 +687,7 @@
(gnc-dmy2time64-neutral 11 08 2014))))
(test-equal "gnc:case-exchange-time-fn weighted-average 22/10/2015"
27663/325
9366/125
(gnc:gnc-monetary-amount
(exchange-fn
(gnc:make-gnc-monetary AAPL 1)
@ -708,7 +708,7 @@
(gnc-dmy2time64-neutral 20 02 2016)
#f #f)))
(test-equal "gnc:case-exchange-time-fn average-cost 20/02/2012"
14127/175
0
(gnc:gnc-monetary-amount
(exchange-fn
(gnc:make-gnc-monetary AAPL 1)