From 4953cf94fa95e904b0e484f01193f1af86dff2da Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Mon, 13 Feb 2023 23:04:26 +0800 Subject: [PATCH] [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. --- bindings/guile/business-core.scm | 35 ++++++++++++++++++- gnucash/report/reports/standard/new-aging.scm | 21 +++++------ .../reports/standard/new-owner-report.scm | 12 +++---- 3 files changed, 48 insertions(+), 20 deletions(-) diff --git a/bindings/guile/business-core.scm b/bindings/guile/business-core.scm index b88acc313f..742bbd5aef 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 40d9ce9d2d..68ef5d3fc8 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 490e434831..e95f016370 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)