[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.
This commit is contained in:
Christopher Lam 2023-02-13 23:04:26 +08:00
parent 2b32382c78
commit 4953cf94fa
3 changed files with 48 additions and 20 deletions

View File

@ -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)))))

View File

@ -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

View File

@ -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)