gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sat Dec 14 11:05:35 EST 2019
Updated via https://github.com/Gnucash/gnucash/commit/3eef8841 (commit)
via https://github.com/Gnucash/gnucash/commit/a513140e (commit)
via https://github.com/Gnucash/gnucash/commit/cbb0c36a (commit)
from https://github.com/Gnucash/gnucash/commit/e4ac6b48 (commit)
commit 3eef884100b2d18aa8ccce6f0b55a338d1047dfb
Merge: e4ac6b480 a513140e1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Dec 15 00:04:51 2019 +0800
Merge branch 'maint' and fix test-owner-report
diff --cc gnucash/report/reports/standard/new-owner-report.scm
index 5cc8e54a0,48ea481c4..aa7299c68
--- a/gnucash/report/reports/standard/new-owner-report.scm
+++ b/gnucash/report/reports/standard/new-owner-report.scm
@@@ -31,11 -31,14 +31,12 @@@
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-8))
(use-modules (srfi srfi-11)) ;for let-values
+ (use-modules (ice-9 match))
-(use-modules (gnucash gnc-module))
+(use-modules (gnucash engine))
(use-modules (gnucash utilities)) ; for gnc:debug
-(use-modules (gnucash gettext))
-
-(gnc:module-load "gnucash/report/report-system" 0)
-(use-modules (gnucash report standard-reports))
-(use-modules (gnucash report business-reports))
+(use-modules (gnucash core-utils))
+(use-modules (gnucash app-utils))
+(use-modules (gnucash report))
;; Option names
(define optname-from-date (N_ "From"))
diff --cc gnucash/report/reports/standard/test/test-owner-report.scm
index 2d5fa9f03,8e4ae507a..46f70568c
--- a/gnucash/report/reports/standard/test/test-owner-report.scm
+++ b/gnucash/report/reports/standard/test/test-owner-report.scm
@@@ -1,14 -1,13 +1,13 @@@
-(use-modules (gnucash gnc-module))
-(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
-(use-modules (gnucash engine test test-extras))
-(use-modules (gnucash report invoice))
-(use-modules (gnucash report stylesheets))
-(use-modules (gnucash report report-system))
-(use-modules (gnucash report report-system test test-extras))
+(use-modules (gnucash engine))
+(use-modules (gnucash app-utils))
+(use-modules (tests test-engine-extras))
- (use-modules (gnucash reports standard owner-report))
- (use-modules (gnucash reports standard job-report))
++(use-modules (gnucash reports))
+(use-modules (gnucash report stylesheets plain))
+(use-modules (gnucash report))
+(use-modules (tests test-report-extras))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-64))
-(use-modules (gnucash engine test srfi64-extras))
+(use-modules (tests srfi64-extras))
(use-modules (sxml simple))
(use-modules (sxml xpath))
(use-modules (system vm coverage))
commit a513140e15e0a154c2c010c7170a6412d05784df
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Dec 13 23:42:08 2019 +0800
[new-owner-report] use gnc-lot API for searching business links
Previous would search invoices->payments and payment->invoices during
the report by analysing each posting and payment txn.
This change will remove the splits searching and use gnc-lot API to
find these links.
* also use ice-9 match for easier matching
* also use global gnc:multiline-to-html-text
* also remove some duplicate sanity checks
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index 9366b889c..48ea481c4 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -31,6 +31,7 @@
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-8))
(use-modules (srfi srfi-11)) ;for let-values
+(use-modules (ice-9 match))
(use-modules (gnucash gnc-module))
(use-modules (gnucash utilities)) ; for gnc:debug
(use-modules (gnucash gettext))
@@ -306,97 +307,104 @@
(add-row table odd-row? used-columns start-date #f "" (_ "Balance") ""
currency total #f #f #f #f (list (make-list link-cols #f))))
- (define (make-invoice->payments-table invoice invoice-splits currency txn)
- (let lp ((invoice-splits invoice-splits) (result '()))
- (cond
- ((null? invoice-splits)
- (reverse
- (if (gncInvoiceIsPaid invoice)
- result
- (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
- (make-cell
- (gnc:make-gnc-monetary
- currency
- (AP-negate (gnc-lot-get-balance
- (gncInvoiceGetPostedLot invoice))))))
- result))))
- (else
- (let* ((lot-split (car invoice-splits))
- (lot-txn (xaccSplitGetParent lot-split))
- (tfr-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
- (let lp1 ((tfr-splits tfr-splits) (result result))
- (cond
- ((equal? lot-txn txn) (lp (cdr invoice-splits) result))
- ((null? tfr-splits) (lp (cdr invoice-splits) result))
- (else
- (let* ((tfr-split (car tfr-splits))
- (tfr-acct (xaccSplitGetAccount tfr-split))
- (tfr-curr (xaccAccountGetCommodity tfr-acct))
- (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
- (lp1 (cdr tfr-splits)
- (cons (list
- (qof-print-date (xaccTransGetDate lot-txn))
- (let ((num (gnc-get-num-action lot-txn lot-split)))
- (if (string-null? num) (_ "Payment") num))
- (make-cell
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:split-anchor-text tfr-split)
- (gnc:make-gnc-monetary tfr-curr tfr-amt)))))
- result)))))))))))
-
- (define (make-payment->invoices-list invoice payment-splits)
+ (define (make-invoice->payments-table invoice)
+ (define lot (gncInvoiceGetPostedLot invoice))
+ (let lp ((invoice-splits (delete (gnc-lot-get-earliest-split lot)
+ (gnc-lot-get-split-list lot)))
+ (result '()))
+ (match invoice-splits
+ ;; finished. test for underpayment and add outstanding balance
+ (() (reverse
+ (if (gncInvoiceIsPaid invoice)
+ result
+ (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Outstanding"))
+ (make-cell
+ (gnc:make-gnc-monetary
+ currency (AP-negate (gnc-lot-get-balance lot)))))
+ result))))
+
+ ;; invoice's lot's payment splits
+ ((lot-split . rest-lot-splits)
+ (let* ((lot-txn (xaccSplitGetParent lot-split))
+ (tfr-splits (xaccTransGetPaymentAcctSplitList lot-txn)))
+ (let lp1 ((tfr-splits tfr-splits) (result result))
+ (match tfr-splits
+ (() (lp rest-lot-splits result))
+ ((tfr-split . rest-tfr-splits)
+ (let* ((tfr-acct (xaccSplitGetAccount tfr-split))
+ (tfr-curr (xaccAccountGetCommodity tfr-acct))
+ (tfr-amt (AP-negate (xaccSplitGetAmount tfr-split))))
+ (lp1 rest-tfr-splits
+ (cons (list
+ (qof-print-date (xaccTransGetDate lot-txn))
+ (let ((num (gnc-get-num-action lot-txn lot-split)))
+ (if (string-null? num) (_ "Payment") num))
+ (make-cell
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:split-anchor-text tfr-split)
+ (gnc:make-gnc-monetary tfr-curr tfr-amt)))))
+ result)))))))))))
+
+ (define (payment-txn->overpayment-and-invoices txn)
+ (let lp ((splits (xaccTransGetAPARAcctSplitList txn #f))
+ (overpayment 0)
+ (invoices '()))
+ (match splits
+ (() (cons (AP-negate overpayment) invoices))
+ ((split . rest)
+ (let ((invoice (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot split))))
+ (if (null? invoice)
+ (lp rest
+ (- overpayment (xaccSplitGetAmount split))
+ invoices)
+ (lp rest
+ overpayment
+ (cons invoice invoices))))))))
+
+ (define (make-payment->invoices-list txn)
(list
(list
(apply
gnc:make-html-text
(map
- (lambda (inv-splits)
+ (lambda (inv)
(gnc:html-markup-anchor
- (gnc:invoice-anchor-text (car inv-splits))
+ (gnc:invoice-anchor-text inv)
(gnc-get-num-action
- (gncInvoiceGetPostedTxn (car inv-splits))
+ (gncInvoiceGetPostedTxn inv)
#f)))
- payment-splits)))))
+ (cdr (payment-txn->overpayment-and-invoices txn)))))))
- (define (make-payment->invoices-table txn payment-splits currency)
- (let lp ((payment-splits payment-splits)
+ (define (make-payment->invoices-table txn)
+ (define overpayment-and-invoices (payment-txn->overpayment-and-invoices txn))
+ (let lp ((invoices (cdr overpayment-and-invoices))
(result '()))
- (cond
- ((null? payment-splits)
- (let ((overpayment
- (fold
- (lambda (a b)
- (if (null? (gncInvoiceGetInvoiceFromLot (xaccSplitGetLot a)))
- (- b (xaccSplitGetAmount a))
- b))
- 0 (xaccTransGetAPARAcctSplitList txn #f))))
- (reverse
- (if (positive? overpayment)
- (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Prepayments"))
- (make-cell (gnc:make-gnc-monetary currency overpayment)))
- result)
- result))))
- (else
- (let* ((payment-split (car payment-splits))
- (inv (car payment-split))
- (inv-amount (gncInvoiceGetTotal inv)))
- (lp (cdr payment-splits)
- (cons (list
- (qof-print-date (gncInvoiceGetDatePosted inv))
- (gnc:make-html-text
- (gnc:html-markup-anchor
- (gnc:invoice-anchor-text inv)
- (gnc-get-num-action (gncInvoiceGetPostedTxn inv) #f)))
- (make-cell (gnc:make-gnc-monetary currency inv-amount)))
- result)))))))
+ (match invoices
+ (()
+ (let ((overpayment (car overpayment-and-invoices)))
+ (reverse
+ (if (zero? overpayment)
+ result
+ (cons (list (gnc:make-html-table-cell/size 1 2 (_ "Prepayments"))
+ (make-cell (gnc:make-gnc-monetary currency overpayment)))
+ result)))))
+ ((inv . rest)
+ (lp rest
+ (cons (list
+ (qof-print-date (gncInvoiceGetDatePosted inv))
+ (gnc:make-html-text
+ (gnc:html-markup-anchor
+ (gnc:invoice-anchor-text inv)
+ (gnc-get-num-action (gncInvoiceGetPostedTxn inv) #f)))
+ (make-cell (gnc:make-gnc-monetary currency (invoice->total inv))))
+ result))))))
(define (split->type-str split)
(let* ((txn (xaccSplitGetParent split))
(invoice (gncInvoiceGetInvoiceFromTxn txn)))
(cond
- ((and (txn-is-invoice? txn)
- (not (null? invoice)))
+ ((txn-is-invoice? txn)
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:invoice-anchor-text invoice)
@@ -420,6 +428,11 @@
((if (gncInvoiceGetIsCreditNote invoice) - identity)
(gncInvoiceGetTotalTax invoice))))
+ (define (invoice->total invoice)
+ (and (not (null? invoice))
+ ((if (gncInvoiceGetIsCreditNote invoice) - identity)
+ (gncInvoiceGetTotal invoice))))
+
(define (invoice->due-date invoice)
(and (not (null? invoice))
(gncInvoiceIsPosted invoice)
@@ -432,8 +445,7 @@
(debit 0)
(credit 0)
(tax 0)
- (sale 0)
- (links '()))
+ (sale 0))
(cond
((null? splits)
@@ -452,7 +464,7 @@
;; not an invoice/payment. skip transaction.
((not (or (txn-is-invoice? (xaccSplitGetParent (car splits)))
(txn-is-payment? (xaccSplitGetParent (car splits)))))
- (lp printed? odd-row? (cdr splits) total debit credit tax sale links))
+ (lp printed? odd-row? (cdr splits) total debit credit tax sale))
;; invalid case: txn-type-invoice but no associated invoice, nor lot
((let* ((txn (xaccSplitGetParent (car splits)))
@@ -461,26 +473,15 @@
(or (null? invoice)
(null? (gncInvoiceGetPostedLot invoice)))))
(gnc:warn "sanity check fail" txn)
- (lp printed? odd-row? (cdr splits) total debit credit tax sale links))
+ (lp printed? odd-row? (cdr splits) total debit credit tax sale))
;; start printing txns.
(else
(let* ((split (car splits))
(txn (xaccSplitGetParent split))
(date (xaccTransGetDate txn))
- (value (xaccTransGetAccountAmount txn acc))
- (value (if payable? (- value) value))
- (invoice (gncInvoiceGetInvoiceFromTxn txn))
- (invoice-splits
- (and (txn-is-invoice? txn)
- (gnc-lot-get-split-list
- (gncInvoiceGetPostedLot invoice))))
- (payment-splits
- (and (txn-is-payment? txn)
- (filter
- (lambda (inv-split)
- (member txn (map xaccSplitGetParent (cdr inv-split))))
- links))))
+ (value (AP-negate (xaccTransGetAccountAmount txn acc)))
+ (invoice (gncInvoiceGetInvoiceFromTxn txn)))
(cond
;; txn-date < start-date. skip display, accumulate amounts
@@ -488,15 +489,14 @@
(lp printed? odd-row? (cdr splits) (+ total value)
(if (negative? value) (+ debit value) debit)
(if (negative? value) credit (+ credit value))
- tax sale (if (null? invoice) links
- (acons invoice invoice-splits links))))
+ tax sale))
;; if balance row hasn't been rendered, consider
;; adding here. skip if value=0.
((not printed?)
(let ((print? (and (value-col used-columns) (not (zero? total)))))
(if print? (add-balance-row odd-row? total))
- (lp #t (not print?) splits total debit credit tax sale links)))
+ (lp #t (not print?) splits total debit credit tax sale)))
(else
(add-row
@@ -506,26 +506,23 @@
(and (>= value 0) value) (and (< value 0) value)
(invoice->sale invoice) (invoice->tax invoice)
(cond
- ((and invoice-splits (eq? link-option 'simple))
- (if (gnc-lot-is-closed (gncInvoiceGetPostedLot invoice))
+ ((and (txn-is-invoice? txn) (eq? link-option 'simple))
+ (if (gncInvoiceIsPaid invoice)
(list (list (_ "Paid")))
(list (list #f))))
- ((and invoice-splits (eq? link-option 'detailed))
- (make-invoice->payments-table invoice invoice-splits currency txn))
- ((and payment-splits (eq? link-option 'simple))
- (make-payment->invoices-list invoice payment-splits))
- ((and payment-splits (eq? link-option 'detailed))
- (make-payment->invoices-table txn payment-splits currency))
- ;; some error occurred, show 1 line containing empty-list
+ ((and (txn-is-invoice? txn) (eq? link-option 'detailed))
+ (make-invoice->payments-table invoice))
+ ((and (txn-is-payment? txn) (eq? link-option 'simple))
+ (make-payment->invoices-list txn))
+ ((and (txn-is-payment? txn) (eq? link-option 'detailed))
+ (make-payment->invoices-table txn currency))
(else '(()))))
(lp printed? (not odd-row?) (cdr splits) (+ total value)
(if (negative? value) (+ debit value) debit)
(if (negative? value) credit (+ credit value))
(+ tax (or (invoice->tax invoice) 0))
- (+ sale (or (invoice->sale invoice) 0))
- (if (null? invoice) links
- (acons invoice invoice-splits links))))))))))
+ (+ sale (or (invoice->sale invoice) 0))))))))))
(define (options-generator owner-type)
@@ -632,17 +629,6 @@ invoices and amounts.")))))
gnc:*report-options*)
-(define (multiline-to-html-text str)
- ;; simple function - splits string containing #\newline into
- ;; substrings, and convert to a gnc:make-html-text construct which
- ;; adds gnc:html-markup-br after each substring.
- (let loop ((list-of-substrings (string-split str #\newline))
- (result '()))
- (if (null? list-of-substrings)
- (apply gnc:make-html-text (if (null? result) '() (reverse (cdr result))))
- (loop (cdr list-of-substrings)
- (cons* (gnc:html-markup-br) (car list-of-substrings) result)))))
-
(define (setup-query q owner accounts end-date job?)
(let ((guid (gncOwnerReturnGUID (if job? owner (gncOwnerGetEndOwner owner))))
(last-param (if job? QOF-PARAM-GUID OWNER-PARENTG)))
@@ -670,7 +656,7 @@ invoices and amounts.")))))
'attribute (list "cellpadding" 0)
'attribute (list "valign" "top"))
(gnc:html-table-append-row!
- table (multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
+ table (gnc:multiline-to-html-text (gnc:owner-get-name-and-address-dep owner)))
table))
(define (make-myname-table book date-format)
@@ -689,7 +675,7 @@ invoices and amounts.")))))
(when name
(gnc:html-table-append-row! table (list name)))
(when addy
- (gnc:html-table-append-row! table (multiline-to-html-text addy)))
+ (gnc:html-table-append-row! table (gnc:multiline-to-html-text addy)))
(gnc:html-table-append-row!
table (list (gnc-print-time64 (gnc:get-today) date-format)))
table))
@@ -730,7 +716,7 @@ invoices and amounts.")))))
(document (gnc:make-html-document))
(table (gnc:make-html-table))
(headings (make-heading-list used-columns link-option))
- (report-title (string-append (_ (owner-string type)) " " (_ "Report"))))
+ (report-title (string-append (_ owner-descr) " " (_ "Report"))))
(cond
((not (gncOwnerIsValid owner))
commit cbb0c36ad4f47f40ca45c8fe0ede6de60f4a4e9e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Dec 14 12:24:32 2019 +0800
[test-owner-report] properly test link amounts
Previous test wasn't comprehensive; due to variable row lengths,
the (td 11) wouldn't consistently select the link amount. using
(td -1) will select the last <td> element in the row.
Moreover also test the class-name to target the link amounts otherwise
other elements (eg the aging-list) will also be returned.
diff --git a/gnucash/report/business-reports/test/test-owner-report.scm b/gnucash/report/business-reports/test/test-owner-report.scm
index d040fc696..8e4ae507a 100644
--- a/gnucash/report/business-reports/test/test-owner-report.scm
+++ b/gnucash/report/business-reports/test/test-owner-report.scm
@@ -327,6 +327,7 @@
sxml)))
(test-end "customer-report")
+ (display "new-owner-report tests:\n")
(test-begin "new-customer-report")
(let* ((options (default-testing-options 'customer-new
owner-1 (get-acct "AR-USD")))
@@ -351,9 +352,18 @@
"$228.00" "$28.00" "$34.75" "$31.75")
((sxpath `(// (table 3) // tr (td 8) // *text*))
sxml))
- (test-equal "link-amounts"
- '("$1.50" "$11.50" "$11.50" "$200.00" "$200.00")
- ((sxpath `(// (table 3) // tr (td 11) // *text*))
+ (test-equal "positive-link-amounts"
+ '("$1.50" "$2.00" "$8.00" "$7.50" "$8.50" "$11.50" "$11.50"
+ "$4.00" "$200.00" "$200.00" "$6.75")
+ ((sxpath `(// (table 3) // tr
+ (td -1 (@ (equal? (class "number-cell")))) //
+ *text*))
+ sxml))
+ (test-equal "negative-link-amounts"
+ '("-$3.00")
+ ((sxpath `(// (table 3) // tr
+ (td -1 (@ (equal? (class "number-cell neg")))) //
+ *text*))
sxml))
;; from the report, find the 3rd table, last row, find embedded
;; table, retrieve tr contents
Summary of changes:
.../report/reports/standard/new-owner-report.scm | 230 ++++++++++-----------
.../reports/standard/test/test-owner-report.scm | 19 +-
2 files changed, 122 insertions(+), 127 deletions(-)
More information about the gnucash-changes
mailing list