gnucash maint: [reports] use gnc:make-split->owner with guardian
Christopher Lam
clam at code.gnucash.org
Mon Feb 13 10:18:17 EST 2023
Updated via https://github.com/Gnucash/gnucash/commit/4953cf94 (commit)
from https://github.com/Gnucash/gnucash/commit/2b32382c (commit)
commit 4953cf94fa95e904b0e484f01193f1af86dff2da
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Feb 13 23:04:26 2023 +0800
[reports] use gnc:make-split->owner with guardian
Instead of a gnc:split->owner, use gnc:make-split->owner instead which
generates a split->owner function with its own hashtable. This
function (and its hash table) will be garbage collected in due course,
triggering the gncOwnerFreeing of all owners.
This is a better approach than gnc:split->owner which maintains a
single hash table. It could be buggy: a report calls gnc:split->owner
to query a split, fails to reset its hashtable via #f; the split's
owner is assigned or modified, and the next call to gnc:split->owner
will return the incorrect cached owner.
diff --git a/bindings/guile/business-core.scm b/bindings/guile/business-core.scm
index b88acc313..742bbd5ae 100644
--- a/bindings/guile/business-core.scm
+++ b/bindings/guile/business-core.scm
@@ -32,6 +32,7 @@
(export gnc:owner-get-owner-id)
(export gnc:owner-from-split)
(export gnc:split->owner)
+(export gnc:make-split->owner)
(define (gnc:owner-get-address owner)
(let ((type (gncOwnerGetType owner)))
@@ -114,7 +115,7 @@
(define (gnc:owner-from-split split result-owner)
(define (notnull x) (and (not (null? x)) x))
(issue-deprecation-warning
- "gnc:owner-from-split is deprecated in 4.x. use gnc:split->owner instead.")
+ "gnc:owner-from-split is deprecated in 4.x. use gnc:make-split->owner instead.")
(let* ((trans (xaccSplitGetParent split))
(invoice (notnull (gncInvoiceGetInvoiceFromTxn trans)))
(temp (gncOwnerNew))
@@ -139,6 +140,8 @@
(define gnc:split->owner
(let ((ht (make-hash-table)))
(lambda (split)
+ (issue-deprecation-warning
+ "gnc:split->owner is deprecated in 4.x. use gnc:make-split->owner instead.")
(cond
((not split)
(hash-for-each (lambda (k v) (gncOwnerFree v)) ht)
@@ -154,3 +157,33 @@
owner))
(hash-set! ht (gncSplitGetGUID split) owner)
owner))))))
+
+(define owner-guardian (make-guardian))
+
+(define (reclaim-owners)
+ (let ((owner (owner-guardian)))
+ (when owner
+ (gncOwnerFree owner)
+ (reclaim-owners))))
+
+(add-hook! after-gc-hook reclaim-owners)
+
+;; Create a function which helps find a split's gncOwner. It will
+;; allocate and memoize the owners in a hash table because
+;; gncOwnerGetOwnerFromLot is slow. When the function is out of scope,
+;; and gc is run, the hash table is destroyed and the above hook will
+;; run, releasing the owners via gncOwnerFree.
+(define (gnc:make-split->owner)
+ (let ((ht (make-hash-table)))
+ (lambda (split)
+ (or (hash-ref ht (gncSplitGetGUID split))
+ (let ((lot (xaccSplitGetLot split))
+ (owner (gncOwnerNew)))
+ (unless (gncOwnerGetOwnerFromLot lot owner)
+ (gncOwnerCopy (gncOwnerGetEndOwner
+ (gncInvoiceGetOwner
+ (gncInvoiceGetInvoiceFromLot lot)))
+ owner))
+ (hash-set! ht (gncSplitGetGUID split) owner)
+ (owner-guardian owner)
+ owner)))))
diff --git a/gnucash/report/reports/standard/new-aging.scm b/gnucash/report/reports/standard/new-aging.scm
index 40d9ce9d2..68ef5d3fc 100644
--- a/gnucash/report/reports/standard/new-aging.scm
+++ b/gnucash/report/reports/standard/new-aging.scm
@@ -157,12 +157,6 @@ exist but have no suitable transactions."))
(not (or (eqv? type TXN-TYPE-INVOICE)
(eqv? type TXN-TYPE-PAYMENT)))))
-(define (split-has-owner? split owner)
- (gncOwnerEqual (gnc:split->owner split) owner))
-
-(define (split-owner-is-invalid? split)
- (not (gncOwnerIsValid (gnc:split->owner split))))
-
(define (split-from-acct? split acct)
(equal? acct (xaccSplitGetAccount split)))
@@ -175,6 +169,14 @@ exist but have no suitable transactions."))
(define (op-value section name)
(gnc:option-value (gnc:lookup-option options section name)))
+ (define split->owner (gnc:make-split->owner))
+
+ (define (split-has-owner? split owner)
+ (gncOwnerEqual (split->owner split) owner))
+
+ (define (split-owner-is-invalid? split)
+ (not (gncOwnerIsValid (split->owner split))))
+
(define make-heading-list
(list (G_ "Company")
(G_ "Pre-Payment")
@@ -231,10 +233,6 @@ exist but have no suitable transactions."))
(let* ((splits (xaccQueryGetSplitsUniqueTrans query)))
(qof-query-destroy query)
- ;; split->owner hashtable should be empty at the start of
- ;; report renderer. clear it anyway.
- (gnc:split->owner #f)
-
;; loop into each APAR account
(let loop ((accounts accounts)
(splits splits)
@@ -316,7 +314,6 @@ exist but have no suitable transactions."))
acc-totals)))))
(reverse accounts-and-owners))
- (gnc:split->owner #f) ;free the gncOwners
(gnc:html-document-add-object! document table)
(unless (null? invalid-splits)
@@ -373,7 +370,7 @@ exist but have no suitable transactions."))
owners-and-aging))
((this . _)
- (match-let* ((owner (gnc:split->owner this))
+ (match-let* ((owner (split->owner this))
((owner-splits . other-owner-splits)
(list-split acc-splits split-has-owner? owner))
(aging (gnc:owner-splits->aging-list
diff --git a/gnucash/report/reports/standard/new-owner-report.scm b/gnucash/report/reports/standard/new-owner-report.scm
index 490e43483..e95f01637 100644
--- a/gnucash/report/reports/standard/new-owner-report.scm
+++ b/gnucash/report/reports/standard/new-owner-report.scm
@@ -1246,13 +1246,11 @@ and do not match the transaction."))))))))
(define (gnc:owner-report-create-internal
account split query journal? double? title debit-string credit-string)
-
- (let* ((owner (gnc:split->owner split))
- (res (if (gncOwnerIsValid owner)
- (owner-report-create-with-enddate owner account #f)
- -1)))
- (gnc:split->owner #f)
- res))
+ (let ((split->owner (gnc:make-split->owner))
+ (owner (split->owner split)))
+ (if (gncOwnerIsValid owner)
+ (owner-report-create-with-enddate owner account #f)
+ -1)))
(gnc:register-report-hook ACCT-TYPE-RECEIVABLE #t gnc:owner-report-create-internal)
(gnc:register-report-hook ACCT-TYPE-PAYABLE #t gnc:owner-report-create-internal)
Summary of changes:
bindings/guile/business-core.scm | 35 +++++++++++++++++++++-
gnucash/report/reports/standard/new-aging.scm | 21 ++++++-------
.../report/reports/standard/new-owner-report.scm | 12 ++++----
3 files changed, 48 insertions(+), 20 deletions(-)
More information about the gnucash-changes
mailing list