mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Extract cash-flow-calc-money-in-out to its own module.
It's used by two reports so this simplifies the dependency graph.
This commit is contained in:
parent
8ec0b87600
commit
b84ad7ab7e
@ -4,6 +4,7 @@ add_subdirectory(support)
|
||||
|
||||
set (reports_common_SCHEME
|
||||
aging.scm
|
||||
cash-flow-calc.scm
|
||||
)
|
||||
|
||||
# The 'with exposed generator' reports are standard reports that can
|
||||
@ -34,6 +35,7 @@ set (reports_standard_SCHEME
|
||||
standard/budget-income-statement.scm
|
||||
standard/budget.scm
|
||||
standard/cash-flow.scm
|
||||
standard/cashflow-barchart.scm
|
||||
standard/category-barchart.scm
|
||||
standard/dashboard.scm
|
||||
standard/equity-statement.scm
|
||||
@ -57,8 +59,7 @@ set (reports_standard_SCHEME
|
||||
)
|
||||
|
||||
set (reports_standard_SCHEME_2
|
||||
standard/cashflow-barchart.scm #depends on cash-flow report
|
||||
standard/customer-summary.scm # Depends on owner-report
|
||||
standard/customer-summary.scm # Depends on gnc:owner-report-create
|
||||
)
|
||||
|
||||
set(reports_example_SCHEME
|
||||
|
107
gnucash/report/reports/cash-flow-calc.scm
Normal file
107
gnucash/report/reports/cash-flow-calc.scm
Normal file
@ -0,0 +1,107 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; cash-flow-calc.scm: Cash Flow in-out calculation.
|
||||
;;
|
||||
;; copyright 2015 Peter Broadberry
|
||||
;; copyright 2019 Christopher Lam
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, contact:
|
||||
;;
|
||||
;; Free Software Foundation Voice: +1-617-542-5942
|
||||
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
|
||||
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define-module (gnucash reports cash-flow-calc))
|
||||
(use-modules (gnucash engine))
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash core-utils))
|
||||
(use-modules (gnucash app-utils))
|
||||
(use-modules (gnucash report))
|
||||
|
||||
;; function to add inflow and outflow of money
|
||||
(define-public (cash-flow-calc-money-in-out settings)
|
||||
(let* ((accounts (cdr (assq 'accounts settings)))
|
||||
(to-date-t64 (cdr (assq 'to-date-t64 settings)))
|
||||
(from-date-t64 (cdr (assq 'from-date-t64 settings)))
|
||||
(report-currency (cdr (assq 'report-currency settings)))
|
||||
(include-trading-accounts
|
||||
(cdr (assq 'include-trading-accounts settings)))
|
||||
(to-report-currency (cdr (assq 'to-report-currency settings)))
|
||||
(money-in '())
|
||||
(money-in-collector (gnc:make-commodity-collector))
|
||||
(money-out '())
|
||||
(money-out-collector (gnc:make-commodity-collector))
|
||||
(all-splits (gnc:account-get-trans-type-splits-interval
|
||||
accounts '() from-date-t64 to-date-t64))
|
||||
(splits-to-do (length all-splits))
|
||||
(splits-seen-list '()))
|
||||
|
||||
(let loop ((splits all-splits)
|
||||
(work-done 0))
|
||||
(unless (null? splits)
|
||||
(if (zero? (modulo work-done 100))
|
||||
(gnc:report-percent-done (* 85 (/ work-done splits-to-do))))
|
||||
(let* ((split (car splits))
|
||||
(parent (xaccSplitGetParent split)))
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(let* ((s-account (xaccSplitGetAccount s))
|
||||
(s-value (xaccSplitGetValue s))
|
||||
(s-report-value (to-report-currency (xaccTransGetCurrency parent)
|
||||
(abs s-value)
|
||||
(xaccTransGetDate parent))))
|
||||
(cond
|
||||
((null? s-account)
|
||||
(format #t "WARNING: s-account is NULL for split: ~a\n"
|
||||
(gncSplitGetGUID s)))
|
||||
((or (and include-trading-accounts
|
||||
(eqv? (xaccAccountGetType s-account)
|
||||
ACCT-TYPE-TRADING))
|
||||
(member s-account accounts)
|
||||
(member s splits-seen-list))
|
||||
#f)
|
||||
((negative? s-value)
|
||||
(let ((s-account-in-collector
|
||||
(or (assoc-ref money-in s-account)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(set! money-in
|
||||
(assoc-set! money-in s-account coll))
|
||||
coll))))
|
||||
(set! splits-seen-list (cons s splits-seen-list))
|
||||
(money-in-collector 'add report-currency s-report-value)
|
||||
(s-account-in-collector
|
||||
'add report-currency s-report-value)))
|
||||
((positive? s-value)
|
||||
(let ((s-account-out-collector
|
||||
(or (assoc-ref money-out s-account)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(set! money-out
|
||||
(assoc-set! money-out s-account coll))
|
||||
coll))))
|
||||
(set! splits-seen-list (cons s splits-seen-list))
|
||||
(money-out-collector 'add report-currency s-report-value)
|
||||
(s-account-out-collector
|
||||
'add report-currency s-report-value))))))
|
||||
(xaccTransGetSplitList parent)))
|
||||
(loop (cdr splits) (1+ work-done))))
|
||||
|
||||
;; Return an association list of results
|
||||
(list
|
||||
(cons 'money-in-accounts (map car money-in))
|
||||
(cons 'money-in-alist (map (lambda (p) (list (car p) (cdr p))) money-in))
|
||||
(cons 'money-in-collector money-in-collector)
|
||||
(cons 'money-out-accounts (map car money-out))
|
||||
(cons 'money-out-alist (map (lambda (p) (list (car p) (cdr p))) money-out))
|
||||
(cons 'money-out-collector money-out-collector))))
|
||||
|
@ -33,8 +33,7 @@
|
||||
(use-modules (gnucash core-utils))
|
||||
(use-modules (gnucash app-utils))
|
||||
(use-modules (gnucash report))
|
||||
|
||||
(export cash-flow-calc-money-in-out)
|
||||
(use-modules (gnucash reports cash-flow-calc))
|
||||
|
||||
(define reportname (N_ "Cash Flow"))
|
||||
|
||||
@ -336,82 +335,6 @@
|
||||
doc))
|
||||
|
||||
|
||||
;; function to add inflow and outflow of money
|
||||
(define (cash-flow-calc-money-in-out settings)
|
||||
(let* ((accounts (cdr (assq 'accounts settings)))
|
||||
(to-date-t64 (cdr (assq 'to-date-t64 settings)))
|
||||
(from-date-t64 (cdr (assq 'from-date-t64 settings)))
|
||||
(report-currency (cdr (assq 'report-currency settings)))
|
||||
(include-trading-accounts
|
||||
(cdr (assq 'include-trading-accounts settings)))
|
||||
(to-report-currency (cdr (assq 'to-report-currency settings)))
|
||||
(money-in '())
|
||||
(money-in-collector (gnc:make-commodity-collector))
|
||||
(money-out '())
|
||||
(money-out-collector (gnc:make-commodity-collector))
|
||||
(all-splits (gnc:account-get-trans-type-splits-interval
|
||||
accounts '() from-date-t64 to-date-t64))
|
||||
(splits-to-do (length all-splits))
|
||||
(splits-seen-list '()))
|
||||
|
||||
(let loop ((splits all-splits)
|
||||
(work-done 0))
|
||||
(unless (null? splits)
|
||||
(if (zero? (modulo work-done 100))
|
||||
(gnc:report-percent-done (* 85 (/ work-done splits-to-do))))
|
||||
(let* ((split (car splits))
|
||||
(parent (xaccSplitGetParent split)))
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(let* ((s-account (xaccSplitGetAccount s))
|
||||
(s-value (xaccSplitGetValue s))
|
||||
(s-report-value (to-report-currency (xaccTransGetCurrency parent)
|
||||
(abs s-value)
|
||||
(xaccTransGetDate parent))))
|
||||
(cond
|
||||
((null? s-account)
|
||||
(format #t "WARNING: s-account is NULL for split: ~a\n"
|
||||
(gncSplitGetGUID s)))
|
||||
((or (and include-trading-accounts
|
||||
(eqv? (xaccAccountGetType s-account)
|
||||
ACCT-TYPE-TRADING))
|
||||
(member s-account accounts)
|
||||
(member s splits-seen-list))
|
||||
#f)
|
||||
((negative? s-value)
|
||||
(let ((s-account-in-collector
|
||||
(or (assoc-ref money-in s-account)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(set! money-in
|
||||
(assoc-set! money-in s-account coll))
|
||||
coll))))
|
||||
(set! splits-seen-list (cons s splits-seen-list))
|
||||
(money-in-collector 'add report-currency s-report-value)
|
||||
(s-account-in-collector
|
||||
'add report-currency s-report-value)))
|
||||
((positive? s-value)
|
||||
(let ((s-account-out-collector
|
||||
(or (assoc-ref money-out s-account)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(set! money-out
|
||||
(assoc-set! money-out s-account coll))
|
||||
coll))))
|
||||
(set! splits-seen-list (cons s splits-seen-list))
|
||||
(money-out-collector 'add report-currency s-report-value)
|
||||
(s-account-out-collector
|
||||
'add report-currency s-report-value))))))
|
||||
(xaccTransGetSplitList parent)))
|
||||
(loop (cdr splits) (1+ work-done))))
|
||||
|
||||
;; Return an association list of results
|
||||
(list
|
||||
(cons 'money-in-accounts (map car money-in))
|
||||
(cons 'money-in-alist (map (lambda (p) (list (car p) (cdr p))) money-in))
|
||||
(cons 'money-in-collector money-in-collector)
|
||||
(cons 'money-out-accounts (map car money-out))
|
||||
(cons 'money-out-alist (map (lambda (p) (list (car p) (cdr p))) money-out))
|
||||
(cons 'money-out-collector money-out-collector))))
|
||||
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name reportname
|
||||
|
@ -33,7 +33,7 @@
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash core-utils))
|
||||
(use-modules (gnucash app-utils))
|
||||
(use-modules (gnucash reports standard cash-flow))
|
||||
(use-modules (gnucash reports cash-flow-calc))
|
||||
(use-modules (gnucash report))
|
||||
|
||||
(define reportname (N_ "Cash Flow Barchart"))
|
||||
|
@ -455,6 +455,7 @@ gnucash/report/options-utilities.scm
|
||||
gnucash/report/report-core.scm
|
||||
gnucash/report/report-register-hooks.scm
|
||||
gnucash/report/reports/aging.scm
|
||||
gnucash/report/reports/cash-flow-calc.scm
|
||||
gnucash/report/reports/example/average-balance.scm
|
||||
gnucash/report/reports/example/daily-reports.scm
|
||||
gnucash/report/reports/example/hello-world.scm
|
||||
|
Loading…
Reference in New Issue
Block a user