gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sun Jul 14 00:01:40 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/8adcacbd (commit)
via https://github.com/Gnucash/gnucash/commit/dae26da0 (commit)
via https://github.com/Gnucash/gnucash/commit/fee383e8 (commit)
via https://github.com/Gnucash/gnucash/commit/74169114 (commit)
from https://github.com/Gnucash/gnucash/commit/105f5396 (commit)
commit 8adcacbdd259ceab3bc49f0de650070c3f93538f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Fri Jul 12 21:54:53 2019 +0800
[test-owner-report] basic tests for customer and job reports
create invoices, due dates at various points in the past
diff --git a/gnucash/report/business-reports/test/CMakeLists.txt b/gnucash/report/business-reports/test/CMakeLists.txt
index 26fe43693..2976ec48e 100644
--- a/gnucash/report/business-reports/test/CMakeLists.txt
+++ b/gnucash/report/business-reports/test/CMakeLists.txt
@@ -1,6 +1,7 @@
set(scm_test_business_reports_with_srfi64_SOURCES
test-invoice.scm
+ test-owner-report.scm
)
set(GUILE_DEPENDS
diff --git a/gnucash/report/business-reports/test/test-owner-report.scm b/gnucash/report/business-reports/test/test-owner-report.scm
new file mode 100644
index 000000000..df8940bb7
--- /dev/null
+++ b/gnucash/report/business-reports/test/test-owner-report.scm
@@ -0,0 +1,347 @@
+(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 (srfi srfi-1))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+(use-modules (sxml simple))
+(use-modules (sxml xpath))
+(use-modules (system vm coverage))
+(use-modules (system vm vm))
+
+(define uuid-list
+ (list (cons 'employee "08ae9c2e884b4f9787144f47eacd7f44")
+ (cons 'vendor "d7d1e53505ee4b1b82efad9eacedaea0")
+ (cons 'customer "c146317be32e4948a561ec7fc89d15c1")
+ (cons 'job "5518ac227e474f47a34439f2d4d049de")))
+
+(setlocale LC_ALL "C")
+
+(define (run-test)
+ (if #f
+ (coverage-test run-test-proper)
+ (run-test-proper)))
+
+(define (coverage-test tester)
+ (let* ((currfile (dirname (current-filename)))
+ (path (string-take currfile (string-rindex currfile #\/))))
+ (add-to-load-path path))
+ (call-with-values
+ (lambda()
+ (with-code-coverage tester))
+ (lambda (data result)
+ (let ((port (open-output-file "/tmp/lcov.info")))
+ (coverage-data->lcov data port)
+ (close port)))))
+
+(define (run-test-proper)
+ (let ((saved-format (qof-date-format-get)))
+ (qof-date-format-set QOF-DATE-FORMAT-ISO)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-owner-report")
+ (owner-tests)
+ (qof-date-format-set saved-format)
+ (test-end "test-owner-report")))
+
+(define (sxml-get-row-col sxml row col)
+ (sxml->table-row-col sxml 3 row col))
+
+(define (set-option! options section name value)
+ (let ((option (gnc:lookup-option options section name)))
+ (if option
+ (gnc:option-set-value option value)
+ (test-assert (format #f "wrong-option ~a ~a" section name) #f))))
+
+(define (get-currency sym)
+ (gnc-commodity-table-lookup
+ (gnc-commodity-table-get-table (gnc-get-current-book))
+ (gnc-commodity-get-namespace (gnc-default-report-currency))
+ sym))
+
+(define structure
+ (list "Root" (list (cons 'type ACCT-TYPE-ASSET)
+ (cons 'commodity (get-currency "USD")))
+ (list "Asset"
+ (list "Bank-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "Bank-EUR" (list (cons 'commodity (get-currency "EUR"))))
+ (list "Bank-USD"))
+ (list "VAT"
+ (list "VAT-on-Purchases")
+ (list "VAT-on-Sales" (list (cons 'type ACCT-TYPE-LIABILITY))))
+ (list "Income" (list (cons 'type ACCT-TYPE-INCOME))
+ (list "Income-USD")
+ (list "Income-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "Income-EUR" (list (cons 'commodity (get-currency "EUR")))))
+ (list "A/Receivable" (list (cons 'type ACCT-TYPE-RECEIVABLE))
+ (list "AR-USD")
+ (list "AR-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "AR-EUR" (list (cons 'commodity (get-currency "EUR")))))
+ (list "A/Payable" (list (cons 'type ACCT-TYPE-PAYABLE))
+ (list "AP-USD")
+ (list "AP-GBP" (list (cons 'commodity (get-currency "GBP"))))
+ (list "AP-EUR" (list (cons 'commodity (get-currency "EUR")))))))
+
+(define (owner-tests)
+ ;; This function will perform implementation testing on the customer report.
+ (define (options->sxml variant options test-title)
+ (define uuid (cdr (assq variant uuid-list)))
+ ;; (format #t "[~a] Options:\n~a"
+ ;; test-title
+ ;; (gnc:html-render-options-changed options #t))
+ (gnc:options->sxml uuid options (format #f "test-~a" variant) test-title))
+ (define (options->invoice inv)
+ (let* ((inv-uuid "5123a759ceb9483abf2182d01c140e8d") ;invoice
+ (inv-options (gnc:make-report-options inv-uuid)))
+ (set-option! inv-options "General" "Invoice Number" inv)
+ (gnc:options->sxml inv-uuid inv-options "test" "test-invoice")))
+
+ (let* ((env (create-test-env))
+ (account-alist (env-create-account-structure-alist env structure))
+ (get-acct (lambda (name)
+ (or (assoc-ref account-alist name)
+ (error "invalid account name" name))))
+ (YEAR (gnc:time64-get-year (gnc:get-today)))
+
+ (cust-1 (let ((cust-1 (gncCustomerCreate (gnc-get-current-book))))
+ (gncCustomerSetID cust-1 "cust-1-id")
+ (gncCustomerSetName cust-1 "cust-1-name")
+ (gncCustomerSetNotes cust-1 "cust-1-notes")
+ (gncCustomerSetCurrency cust-1 (get-currency "USD"))
+ (gncCustomerSetTaxIncluded cust-1 1) ;1 = GNC-TAXINCLUDED-YES
+ cust-1))
+
+ (owner-1 (let ((owner-1 (gncOwnerNew)))
+ (gncOwnerInitCustomer owner-1 cust-1)
+ owner-1))
+
+ ;; inv-1 is generated for a customer
+ (inv-1 (let ((inv-1 (gncInvoiceCreate (gnc-get-current-book))))
+ (gncInvoiceSetOwner inv-1 owner-1)
+ (gncInvoiceSetNotes inv-1 "inv-1-notes")
+ (gncInvoiceSetBillingID inv-1 "inv-1-billing-id")
+ (gncInvoiceSetCurrency inv-1 (get-currency "USD"))
+ inv-1))
+
+ (job-1 (let ((job-1 (gncJobCreate (gnc-get-current-book))))
+ (gncJobSetID job-1 "job-1-id")
+ (gncJobSetName job-1 "job-1-name")
+ (gncJobSetOwner job-1 owner-1)
+ job-1))
+ (owner-2 (let ((owner-2 (gncOwnerNew)))
+ (gncOwnerInitJob owner-2 job-1)
+ owner-2))
+ ;; inv-2 is generated from a customer's job
+ (inv-2 (let ((inv-2 (gncInvoiceCreate (gnc-get-current-book))))
+ (gncInvoiceSetOwner inv-2 owner-2)
+ (gncInvoiceSetNotes inv-2 "inv-2-notes")
+ (gncInvoiceSetCurrency inv-2 (get-currency "USD"))
+ inv-2))
+
+ (entry (lambda (amt)
+ (let ((entry (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry "entry-desc")
+ (gncEntrySetAction entry "entry-action")
+ (gncEntrySetNotes entry "entry-notes")
+ (gncEntrySetInvAccount entry (get-acct "Income-USD"))
+ (gncEntrySetDocQuantity entry 1 #f)
+ (gncEntrySetInvPrice entry amt)
+ entry)))
+
+ ;; entry-1 1 widgets of $6 = $6
+ (entry-1 (entry 6))
+
+ ;; entry-2 3 widgets of EUR4 = EUR12
+ (entry-2 (let ((entry-2 (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry-2 (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry-2 "entry-2-desc")
+ (gncEntrySetAction entry-2 "entry-2-action")
+ (gncEntrySetNotes entry-2 "entry-2-notes")
+ (gncEntrySetInvAccount entry-2 (get-acct "Income-EUR"))
+ (gncEntrySetDocQuantity entry-2 3 #f)
+ (gncEntrySetInvPrice entry-2 4)
+ entry-2))
+
+ ;; entry-3 5 widgets of GBP7 = GBP35
+ (entry-3 (let ((entry-3 (gncEntryCreate (gnc-get-current-book))))
+ (gncEntrySetDateGDate entry-3 (time64-to-gdate (current-time)))
+ (gncEntrySetDescription entry-3 "entry-3-desc")
+ (gncEntrySetAction entry-3 "entry-3-action")
+ (gncEntrySetNotes entry-3 "entry-3-notes")
+ (gncEntrySetInvAccount entry-3 (get-acct "Income-GBP"))
+ (gncEntrySetDocQuantity entry-3 5 #f)
+ (gncEntrySetInvPrice entry-3 7)
+ entry-3))
+
+ (standard-vat-sales-tt
+ (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
+ (gncTaxTableIncRef tt)
+ (gncTaxTableSetName tt "10% vat on sales")
+ (let ((entry (gncTaxTableEntryCreate)))
+ (gncTaxTableEntrySetAccount entry (get-acct "VAT-on-Sales"))
+ (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
+ (gncTaxTableEntrySetAmount entry 10)
+ (gncTaxTableAddEntry tt entry))
+ tt))
+
+ (standard-vat-purchases-tt
+ (let ((tt (gncTaxTableCreate (gnc-get-current-book))))
+ (gncTaxTableIncRef tt)
+ (gncTaxTableSetName tt "10% vat on purchases")
+ (let ((entry (gncTaxTableEntryCreate)))
+ (gncTaxTableEntrySetAccount entry (get-acct "VAT-on-Purchases"))
+ (gncTaxTableEntrySetType entry GNC-AMT-TYPE-PERCENT)
+ (gncTaxTableEntrySetAmount entry 10)
+ (gncTaxTableAddEntry tt entry))
+ tt)))
+
+ (define* (default-testing-options variant owner account)
+ ;; owner-report will run from 1.1.1980 to 1.7.1980
+ (let ((options (gnc:make-report-options
+ (assq-ref uuid-list variant))))
+ (set-option! options "General"
+ (case variant
+ ((customer) "Customer")
+ ((job) "Job"))
+ owner)
+ (set-option! options "General" "From"
+ (cons 'absolute (gnc-dmy2time64 1 1 1980)))
+ (set-option! options "General" "To"
+ (cons 'absolute (gnc-dmy2time64 1 7 1980)))
+ (set-option! options "General" "Account" account)
+ options))
+
+ ;; inv-1 $6, due 18.7.1980 after report-date i.e. "current"
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 27/4))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 05 1980) ;posted
+ (gnc-dmy2time64 18 07 1980) ;due
+ "inv current $6.75" #t #f))
+
+ ;; inv-1-copy due 18.6.1980, <30days before report date
+ ;; amount due $12
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 4))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 04 1980) ;posted
+ (gnc-dmy2time64 18 06 1980) ;due
+ "inv <30days $4.00" #t #f))
+
+ ;; inv-1-copy due 18.5.1980, 30-60days before report date
+ ;; amount due $6
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 17/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 03 1980) ;posted
+ (gnc-dmy2time64 18 05 1980) ;due
+ "inv 30-60 $8.50" #t #f))
+
+ ;; inv-1-copy due 18.4.1980, 60-90days before report date
+ ;; amount due $6
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 15/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 02 1980) ;posted
+ (gnc-dmy2time64 18 04 1980) ;due
+ "inv 60-90 $7.50" #t #f))
+
+ ;; inv-1-copy due 18.3.1980, >90days before report date
+ ;; amount due $11.50, drip-payments
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 23/2))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 01 1980) ;posted
+ (gnc-dmy2time64 18 03 1980) ;due
+ "inv >90 $11.50" #t #f)
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 3/2 1
+ (gnc-dmy2time64 18 03 1980)
+ "inv >90 payment" "pay only $1.50")
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 2 1
+ (gnc-dmy2time64 20 03 1980)
+ "inv >90 payment" "pay only $2.00"))
+
+ ;; inv-1-copy due 18.3.1980, >90days before report date
+ ;; amount due $11.50, drip-payments
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry 200))
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 18 04 1980) ;posted
+ (gnc-dmy2time64 18 04 1980) ;due
+ "inv $200" #t #f)
+ (gncInvoiceApplyPayment
+ inv-1-copy '() (get-acct "Bank-USD") 200 1
+ (gnc-dmy2time64 19 04 1980)
+ "inv $200" "fully paid"))
+
+ (let ((inv-1-copy (gncInvoiceCopy inv-1)))
+ (gncInvoiceAddEntry inv-1-copy (entry -3))
+ (gncInvoiceSetIsCreditNote inv-1-copy #t)
+ (gncInvoicePostToAccount inv-1-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 22 06 1980) ;posted
+ (gnc-dmy2time64 22 06 1980) ;due
+ "inv $3 CN" #t #f))
+
+ ;; (gnc:dump-book) (newline)
+ ;; (gnc:dump-invoices) (newline)
+ (display "customer-report tests:\n")
+ (test-begin "customer-report")
+ (let* ((options (default-testing-options 'customer owner-1 (get-acct "AR-USD")))
+ (sxml (options->sxml 'customer options "customer-report basic")))
+ (test-equal "inv-descriptions"
+ '("inv >90 $11.50" "inv 60-90 $7.50" "inv 30-60 $8.50"
+ "inv >90 payment" "inv >90 payment" "inv <30days $4.00"
+ "inv $200" "inv $200" "inv current $6.75" "inv $3 CN"
+ "$31.75" "$8.00" "$8.00")
+ (sxml-get-row-col sxml #f 5))
+ (test-equal "debit-amounts"
+ '("$11.50" "$7.50" "$8.50" "$4.00" "$200.00" "$6.75")
+ (sxml-get-row-col sxml #f 6))
+ (test-equal "crebit-amounts"
+ '("-$1.50" "-$2.00" "-$200.00" "-$3.00")
+ (sxml-get-row-col sxml #f 7))
+ ;; from the report, find the 3rd table, last row, find embedded
+ ;; table, retrieve tr contents
+ (test-equal "aging-table"
+ '("$6.75" "$1.00" "$8.50" "$7.50" "$8.00")
+ ((sxpath `(// (table 3) // (tr -1) // table // tbody // tr // *text*))
+ sxml)))
+ (test-end "customer-report")
+
+ (display "job-report tests:\n")
+ ;; inv for job
+ (let ((inv-2-copy (gncInvoiceCopy inv-2)))
+ (gncInvoiceAddEntry inv-2-copy (entry 25/4))
+ (gncInvoicePostToAccount inv-2-copy
+ (get-acct "AR-USD") ;post-to acc
+ (gnc-dmy2time64 13 05 1980) ;posted
+ (gnc-dmy2time64 18 06 1980) ;due
+ "inv for job" #t #f)
+ (gncInvoiceApplyPayment
+ inv-2-copy '() (get-acct "Bank-USD") 25/4 1
+ (gnc-dmy2time64 18 06 1980)
+ "inv for job" "fully paid"))
+
+ (test-begin "job-report")
+ (let* ((options (default-testing-options 'job owner-2 (get-acct "AR-USD")))
+ (sxml (options->sxml 'job options "job-report basic")))
+ (test-equal "inv-descriptions"
+ '("inv for job" "inv for job")
+ (sxml-get-row-col sxml #f 5))
+ (test-equal "amounts"
+ '("$6.25" "-$6.25")
+ (sxml-get-row-col sxml #f 6)))
+ (test-end "job-report")))
commit dae26da037744a129a1bfc78b0dd62343d249bd6
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 22:55:50 2019 +0800
[owner-report] sanitize strings in preparation for tests
diff --git a/gnucash/report/business-reports/owner-report.scm b/gnucash/report/business-reports/owner-report.scm
index 47dd06985..d71664229 100644
--- a/gnucash/report/business-reports/owner-report.scm
+++ b/gnucash/report/business-reports/owner-report.scm
@@ -285,11 +285,11 @@
(qof-print-date due-date)
"")))
(if (num-col column-vector)
- (addto! row-contents num))
+ (addto! row-contents (gnc:html-string-sanitize num)))
(if (type-col column-vector)
(addto! row-contents type-str))
(if (memo-col column-vector)
- (addto! row-contents memo))
+ (addto! row-contents (gnc:html-string-sanitize memo)))
(if (sale-col column-vector)
(addto! row-contents
(gnc:make-html-table-cell/markup "number-cell" sale)))
commit fee383e85e441ce2a50b741ac7049b6a5075b4d3
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 23:17:43 2019 +0800
[job-report] sanitize strings in preparation for tests
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index e0bc4053d..60954b02d 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -480,8 +480,8 @@
(gnc:html-table-append-row!
table
(list
- (string-append label ": ")
- (string-expand (qof-print-date date) #\space " "))))
+ (string-append label " ")
+ (qof-print-date date))))
(define (make-date-table)
(let ((table (gnc:make-html-table)))
@@ -569,7 +569,7 @@
(gnc:html-document-set-headline!
document (gnc:html-markup
- "!"
+ "span"
report-title-str ": "
(gnc:html-markup-anchor
(gnc:job-anchor-text (gncOwnerGetJob owner))
commit 74169114d55e3b25c333d43c47672e1c754ac653
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Jul 13 13:42:23 2019 +0800
[report-utilities] add gnc:dump-book and gnc:dump-invoices
(gnc:dump-book)
utility function for tests. dumps the whole book. sample output:
Account: <Root> Comm<USD> Type<Asset>
Account: <Root.Asset> Comm<USD> Type<Asset>
Account: <Root.Asset.Bank> Comm<USD> Type<Asset>
Split: 07/13/19 Amt<$17,479.18> Val<$17,479.18> Desc<cust-1-name>
Account: <Root.VAT> Comm<USD> Type<Asset>
Account: <Root.VAT.VAT-on-Sales> Comm<USD> Type<Liability>
Split: 07/13/19 Amt<-$1,111.01> Val<-$1,111.01> Desc<cust-1-name>
Account: <Root.A/Receivable> Comm<USD> Type<A/Receivable>
Split: 07/13/19 Amt<-$17,479.18> Val<-$17,479.18> Desc<cust-1-name>
Split: 07/13/19 Amt<$17,479.18> Val<$17,479.18> Desc<cust-1-name>
Account: <Root.Income> Comm<USD> Type<Income>
Split: 07/13/19 Amt<-$16,368.17> Val<-$16,368.17> Desc<cust-1-name>
(gnc:dump-invoices)
Invoice: ID<> Owner<cust-1-name>
Date: Open<?> Post<07/13/19> Due<07/13/19>
Entry: Date<07/13/19> Desc<taxable=N tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=N tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=N tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Entry: Date<07/13/19> Desc<taxable=Y tax-inc...> Action<action> Notes<> Qty<11>
Totals: Total<$17,479.18> TotalSubtotal<$16,368.17> TotalTax<$1,111.01>
diff --git a/gnucash/report/report-system/report-system.scm b/gnucash/report/report-system/report-system.scm
index de16b73fc..ed4f2a0d8 100644
--- a/gnucash/report/report-system/report-system.scm
+++ b/gnucash/report/report-system/report-system.scm
@@ -743,6 +743,8 @@
(export make-file-url)
(export gnc:strify)
(export gnc:pk)
+(export gnc:dump-book)
+(export gnc:dump-invoices)
;; trep-engine.scm
(export gnc:trep-options-generator)
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index a77bc0b3d..f5b6446c9 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -1160,3 +1160,75 @@ flawed. see report-utilities.scm. please update reports.")
(display (map gnc:strify args))
(newline)
(last args))))
+
+;; utility function for testing. dumps the whole book contents to
+;; console.
+(define (gnc:dump-book)
+ (for-each
+ (lambda (acc)
+ (format #t "\nAccount: <~a> Comm<~a> Type<~a>\n"
+ (gnc-account-get-full-name acc)
+ (gnc-commodity-get-mnemonic
+ (xaccAccountGetCommodity acc))
+ (xaccAccountGetTypeStr
+ (xaccAccountGetType acc)))
+ (for-each
+ (lambda (s)
+ (let ((txn (xaccSplitGetParent s)))
+ (format #t " Split: ~a Amt<~a> Val<~a> Desc<~a>\n"
+ (qof-print-date (xaccTransGetDate txn))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (xaccAccountGetCommodity acc)
+ (xaccSplitGetAmount s)))
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (xaccTransGetCurrency txn)
+ (xaccSplitGetValue s)))
+ (xaccTransGetDescription txn))))
+ (xaccAccountGetSplitList acc)))
+ (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account))))
+
+;; dump all invoices posted into an AP/AR account
+(define (gnc:dump-invoices)
+ (let* ((acc-APAR (filter (compose xaccAccountIsAPARType xaccAccountGetType)
+ (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account))))
+ (inv-txns (filter (lambda (t) (eqv? (xaccTransGetTxnType t) TXN-TYPE-INVOICE))
+ (map xaccSplitGetParent
+ (append-map xaccAccountGetSplitList acc-APAR))))
+ (invoices (map gncInvoiceGetInvoiceFromTxn inv-txns)))
+ (define (maybe-date time64) ;handle INT-MAX differently
+ (if (= 9223372036854775807 time64) "?" (qof-print-date time64)))
+ (define (maybe-trunc str)
+ (if (> (string-length str) 20) (string-append (substring str 0 17) "...") str))
+ (define (inv-amt->string inv amt)
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary
+ (gncInvoiceGetCurrency inv) amt)))
+ (for-each
+ (lambda (inv)
+ (format #t "\nInvoice: ID<~a> Owner<~a> Account<~a>\n"
+ (gncInvoiceGetID inv)
+ (gncOwnerGetName (gncInvoiceGetOwner inv))
+ (xaccAccountGetName (gncInvoiceGetPostedAcc inv)))
+ (format #t " Date: Open<~a> Post<~a> Due<~a>\n"
+ (maybe-date (gncInvoiceGetDateOpened inv))
+ (maybe-date (gncInvoiceGetDatePosted inv))
+ (maybe-date (gncInvoiceGetDateDue inv)))
+ (for-each
+ (lambda (entry)
+ (format #t " Entry: Date<~a> Desc<~a> Action<~a> Notes<~a> Qty<~a>\n"
+ (maybe-date (gncEntryGetDate entry))
+ (maybe-trunc (gncEntryGetDescription entry))
+ (maybe-trunc (gncEntryGetAction entry))
+ (maybe-trunc (gncEntryGetNotes entry))
+ (gncEntryGetQuantity entry)))
+ (gncInvoiceGetEntries inv))
+ (format #t " Totals: Total<~a> TotalSubtotal<~a> TotalTax<~a>\n"
+ (inv-amt->string inv (gncInvoiceGetTotal inv))
+ (inv-amt->string inv (gncInvoiceGetTotalSubtotal inv))
+ (inv-amt->string inv (gncInvoiceGetTotalTax inv)))
+ (newline))
+ invoices)))
Summary of changes:
gnucash/report/business-reports/job-report.scm | 6 +-
gnucash/report/business-reports/owner-report.scm | 4 +-
.../report/business-reports/test/CMakeLists.txt | 1 +
.../business-reports/test/test-owner-report.scm | 347 +++++++++++++++++++++
gnucash/report/report-system/report-system.scm | 2 +
gnucash/report/report-system/report-utilities.scm | 72 +++++
6 files changed, 427 insertions(+), 5 deletions(-)
create mode 100644 gnucash/report/business-reports/test/test-owner-report.scm
More information about the gnucash-changes
mailing list