mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[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:
parent
2b32382c78
commit
4953cf94fa
@ -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)))))
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user