IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Update qif import routines to use gnc-numeric earlier in the import

Browse Source 
process (so we can fix the precision of numbers correctly from the string)

use-modules on the right modules within reports.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4758 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Bill Gribble 2001-06-20 01:07:50 +00:00
parent be51bde568
commit 6ce6e397c5
17 changed files with 134 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ChangeLog
View File

@ -1,3 +1,17 @@
2001-06-19 Bill Gribble <grib@billgribble.com>
* src/scm/qif-import/qif-parse.scm: convert to gnc-numeric when
parsing, using string length as the precision
* src/scm/qif-import/qif-to-gnc.scm: use gnc-numeric
math routines where necessary
* src/scm/qif-import/qif-file.scm: pass an equality test
predicate to check-and-parse-fields
* src/scm/report/*: fix module reports to use-modules on
srfi-1 and slib where needed.
2001-06-19 Dave Peticolas <dave@krondo.com>
* src/gnome/dialog-nextrun.h: add guards

7
src/gnome/druid-qif-import.c
View File

@ -473,9 +473,10 @@ gnc_ui_qif_import_load_file_next_cb(GnomeDruidPage * page,
else {
/* call the field parser */
parse_return = gh_call1(qif_file_parse, gh_car(imported_files));
/* warning means the date format is ambiguous. Set up the
* format selector page. */
/* warning means the date format is ambiguous. Set up the format
* selector page. FIXME: this can return warnings for things
* other than date format ambiguities. */
if(gh_list_p(parse_return) &&
(gh_car(parse_return) == SCM_BOOL_T)) {
date_formats = gh_cadr(parse_return);

32
src/scm/qif-import/qif-file.scm
View File

@ -463,8 +463,6 @@
(false-if-exception
(let* ((error #f)
(all-ok #f)
(start-time #f)
(end-time #f)
(set-error
(lambda (e)
(if (not error)
@ -478,11 +476,10 @@
(lambda (elt)
(display elt))
lst))))))
(set! start-time (gettimeofday))
(and
;; fields of categories.
(check-and-parse-field
qif-cat:tax-class qif-cat:set-tax-class!
qif-cat:tax-class qif-cat:set-tax-class! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:cats self)
qif-parse:print-number
@ -490,7 +487,7 @@
set-error)
(check-and-parse-field
qif-cat:budget-amt qif-cat:set-budget-amt!
qif-cat:budget-amt qif-cat:set-budget-amt! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:cats self)
qif-parse:print-number
@ -499,7 +496,7 @@
;; fields of accounts
(check-and-parse-field
qif-acct:limit qif-acct:set-limit!
qif-acct:limit qif-acct:set-limit! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:accounts self)
qif-parse:print-number
@ -507,7 +504,7 @@
set-error)
(check-and-parse-field
qif-acct:budget qif-acct:set-budget!
qif-acct:budget qif-acct:set-budget! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:accounts self)
qif-parse:print-number
@ -521,7 +518,7 @@
;; fields of transactions
(check-and-parse-field
qif-xtn:date qif-xtn:set-date!
qif-xtn:date qif-xtn:set-date! equal?
qif-parse:check-date-format '(m-d-y d-m-y y-m-d y-d-m)
qif-parse:parse-date/format
(qif-file:xtns self)
@ -538,7 +535,7 @@
qif-parse:parse-action-field (qif-file:xtns self) set-error)
(check-and-parse-field
qif-xtn:share-price qif-xtn:set-share-price!
qif-xtn:share-price qif-xtn:set-share-price! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:xtns self)
qif-parse:print-number
@ -546,7 +543,7 @@
set-error)
(check-and-parse-field
qif-xtn:num-shares qif-xtn:set-num-shares!
qif-xtn:num-shares qif-xtn:set-num-shares! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:xtns self)
qif-parse:print-number
@ -554,7 +551,7 @@
set-error)
(check-and-parse-field
qif-xtn:commission qif-xtn:set-commission!
qif-xtn:commission qif-xtn:set-commission! gnc:numeric-equal
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:xtns self)
qif-parse:print-number
@ -564,7 +561,7 @@
;; this one's a little tricky... it checks and sets all the
;; split amounts for the transaction together.
(check-and-parse-field
qif-xtn:split-amounts qif-xtn:set-split-amounts!
qif-xtn:split-amounts qif-xtn:set-split-amounts! gnc:numeric-equal
qif-parse:check-number-formats '(decimal comma)
qif-parse:parse-numbers/format (qif-file:xtns self)
qif-parse:print-numbers
@ -575,7 +572,6 @@
(set! all-ok #t)
#t))
(set! end-time (gettimeofday))
(cond (error
(cons all-ok error))
(#t #t)))))
@ -606,7 +602,7 @@
;; types.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (check-and-parse-field getter setter checker
(define (check-and-parse-field getter setter equiv-thunk checker
formats parser objects printer
on-error errormsg)
;; first find the right format for the field
@ -649,8 +645,8 @@
;; just ignore the format ambiguity. Otherwise, it's really an
;; error. ATM since there's no way to correct the error let's
;; just leave it be.
(if (or (all-formats-equivalent? getter parser formats objects printer
errormsg)
(if (or (all-formats-equivalent? getter parser equiv-thunk formats
objects printer errormsg)
(eq? on-error 'guess-on-ambiguity))
(set! format (car formats))
(begin
@ -687,7 +683,7 @@
;; "1000 2000 3000 4000" could be interpreted as decimal or comma
;; radix, but who cares? The values will be the same).
(define (all-formats-equivalent? getter parser formats objects
(define (all-formats-equivalent? getter parser equiv-thunk formats objects
printer errormsg)
(let ((all-ok #t))
(let obj-loop ((objlist objects))
@ -699,7 +695,7 @@
(for-each
(lambda (fmt)
(let ((this-parsed (parser unparsed fmt)))
(if (not (equal? parsed this-parsed))
(if (not (equiv-thunk parsed this-parsed))
(begin
(set! all-ok #f)
(errormsg

1
src/scm/qif-import/qif-objects.scm
View File

@ -281,6 +281,7 @@
(define (qif-xtn:print self)
(simple-obj-print self))
(define (qif-xtn:split-amounts self)
(map
(lambda (split)

55
src/scm/qif-import/qif-parse.scm
View File

@ -477,41 +477,52 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:parse-number/format
;; assuming we know what the format is, parse the string.
;; returns a gnc-numeric; the denominator is set so as to exactly
;; represent the number
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-number/format value-string format)
(case format
((decimal)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-remove-char value-string #\,)
#\$)
(lambda () (read)))))
(let* ((filtered-string
(string-remove-char
(string-remove-char value-string #\,)
#\$))
(read-val
(with-input-from-string filtered-string
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f)))
(gnc:double-to-gnc-numeric
(+ 0.0 read-val) GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS (- (string-length filtered-string) 1))
GNC-RND-ROUND))
(gnc:numeric-zero))))
((comma)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-replace-char!
(string-remove-char value-string #\.)
#\, #\.)
#\$)
(lambda () (read)))))
(let* ((filtered-string
(string-remove-char
(string-replace-char!
(string-remove-char value-string #\.)
#\, #\.)
#\$))
(read-val
(with-input-from-string filtered-string
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f)))
(gnc:double-to-gnc-numeric
(+ 0.0 read-val) GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS (- (string-length filtered-string) 1))
GNC-RND-ROUND))
(gnc:numeric-zero))))
((integer)
(let ((read-val
(with-input-from-string
(string-remove-char value-string #\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f)))))
(gnc:double-to-gnc-numeric
(+ 0.0 read-val) 1 GNC-RND-ROUND)
(gnc:numeric-zero))))))
(define (qif-parse:check-number-formats amt-strings formats)
(let ((retval formats))
(for-each
@ -533,7 +544,7 @@
(if (not tmp)
(set! all-ok #f))
tmp)
0.0))
(gnc:numeric-zero)))
amt-strings)))
(if all-ok parsed #f)))

64
src/scm/qif-import/qif-to-gnc.scm
View File

@ -11,9 +11,6 @@
(gnc:depend "utilities.scm")
(define (gnc:qif-fuzzy= num-1 num-2)
(< (abs (- num-1 num-2)) .00000001))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; find-or-make-acct:
;; given a colon-separated account path, return an Account* to
@ -394,12 +391,6 @@
(qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn))))
(qif-from-acct (qif-xtn:from-acct qif-xtn))
(qif-cleared (qif-xtn:cleared qif-xtn))
(amt-cvt (lambda (n)
(if n
(gnc:double-to-gnc-numeric
n GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 6) GNC-RND-ROUND))
(gnc:numeric-zero))))
(n- (lambda (n) (gnc:numeric-neg n)))
(nsub (lambda (a b) (gnc:numeric-sub a b 0 GNC-DENOM-LCD)))
(n+ (lambda (a b) (gnc:numeric-add a b 0 GNC-DENOM-LCD)))
@ -409,6 +400,7 @@
;; set properties of the whole transaction
(apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn))
;; fixme: bug #105
(if qif-payee
(gnc:transaction-set-description gnc-xtn qif-payee))
(if qif-number
@ -441,7 +433,7 @@
(far-acct-name #f)
(far-acct-type #f)
(far-acct #f)
(split-amt (amt-cvt (qif-split:amount qif-split)))
(split-amt (qif-split:amount qif-split))
(memo (qif-split:memo qif-split))
(cat (qif-split:category qif-split)))
@ -510,11 +502,10 @@
;; "action" encoded in the Number field. It's generally the
;; security account (for buys, sells, and reinvests) but can
;; also be an interest, dividend, or SG/LG account.
(let* ((share-price (amt-cvt (qif-xtn:share-price qif-xtn)))
(num-shares (amt-cvt (qif-xtn:num-shares qif-xtn)))
(split-amt (n* share-price num-shares))
(xtn-amt (amt-cvt
(qif-split:amount (car (qif-xtn:splits qif-xtn)))))
(let* ((share-price (qif-xtn:share-price qif-xtn))
(num-shares (qif-xtn:num-shares qif-xtn))
(split-amt #f)
(xtn-amt (qif-split:amount (car (qif-xtn:splits qif-xtn))))
(qif-accts #f)
(qif-near-acct #f)
(qif-far-acct #f)
@ -523,7 +514,7 @@
(far-acct-name #f)
(far-acct #f)
(commission-acct #f)
(commission-amt (amt-cvt (qif-xtn:commission qif-xtn)))
(commission-amt (qif-xtn:commission qif-xtn))
(commission-split #f)
(defer-share-price #f)
(gnc-far-split (gnc:split-create)))
@ -694,11 +685,16 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:mark-some-splits splits xtn candidate-xtns)
(let* ((split (car splits))
(let* ((n- (lambda (n) (gnc:numeric-neg n)))
(nsub (lambda (a b) (gnc:numeric-sub a b 0 GNC-DENOM-LCD)))
(n+ (lambda (a b) (gnc:numeric-add a b 0 GNC-DENOM-LCD)))
(n* (lambda (a b) (gnc:numeric-mul a b 0 GNC-DENOM-REDUCE)))
(n/ (lambda (a b) (gnc:numeric-div a b 0 GNC-DENOM-REDUCE)))
(split (car splits))
(near-acct-name #f)
(far-acct-name #f)
(date (qif-xtn:date xtn))
(amount (- (qif-split:amount split)))
(amount (n- (qif-split:amount split)))
(group-amount #f)
(memo (qif-split:memo split))
(security-name (qif-xtn:security-name xtn))
@ -714,7 +710,7 @@
(begin
(set! near-acct-name (qif-xtn:from-acct xtn))
(set! far-acct-name (qif-split:category split))
(set! group-amount 0.0)
(set! group-amount (gnc:numeric-zero))
;; group-amount is the sum of all the splits in this xtn
;; going to the same account as 'split'. We might be able
@ -727,14 +723,14 @@
(begin
(set! same-acct-splits
(cons s same-acct-splits))
(set! group-amount (- group-amount (qif-split:amount s))))
(set! group-amount (nsub group-amount (qif-split:amount s))))
(set! different-acct-splits
(cons s different-acct-splits))))
splits)
(set! same-acct-splits (reverse same-acct-splits))
(set! different-acct-splits (reverse different-acct-splits)))
;; stock transactions. they can't have splits as far as I can
;; tell, so the 'different-acct-splits' is always '()
(let ((qif-accts
@ -749,18 +745,18 @@
(case action
((intincx divx cglongx cgmidx cgshortx rtrncapx margintx
sellx)
(set! amount (- amount))
(set! amount (n- amount))
(set! near-acct-name (qif-xtn:from-acct xtn))
(set! far-acct-name (qif-split:category split)))
((miscincx miscexpx)
(set! amount (- amount))
(set! amount (n- amount))
(set! near-acct-name (qif-xtn:from-acct xtn))
(set! far-acct-name (qif-split:miscx-category split)))
((buyx)
(set! near-acct-name (qif-xtn:from-acct xtn))
(set! far-acct-name (qif-split:category split)))
((xout)
(set! amount (- amount)))))))
(set! amount (n- amount)))))))
;; this is the grind loop. Go over every unmarked transaction in
;; the candidate-xtns list.
@ -800,7 +796,7 @@
(define (qif-import:xtn-has-matches? xtn acct-name date amount group-amt)
(let ((matching-splits '())
(same-acct-splits '())
(this-group-amt 0.0)
(this-group-amt (gnc:numeric-zero))
(how #f)
(date-matches
(let ((self-date (qif-xtn:date xtn)))
@ -810,7 +806,13 @@
(eq? (length date) 3)
(= (car self-date) (car date))
(= (cadr self-date) (cadr date))
(= (caddr self-date) (caddr date))))))
(= (caddr self-date) (caddr date)))))
(n- (lambda (n) (gnc:numeric-neg n)))
(nsub (lambda (a b) (gnc:numeric-sub a b 0 GNC-DENOM-LCD)))
(n+ (lambda (a b) (gnc:numeric-add a b 0 GNC-DENOM-LCD)))
(n* (lambda (a b) (gnc:numeric-mul a b 0 GNC-DENOM-REDUCE)))
(n/ (lambda (a b) (gnc:numeric-div a b 0 GNC-DENOM-REDUCE))))
(if date-matches
(begin
;; calculate a group total for splits going to acct-name
@ -831,21 +833,21 @@
(case action
((xout sellx intincx divx cglongx cgshortx
miscincx miscexpx)
(set! this-amt (- this-amt)))))
(set! this-amt (n- this-amt)))))
;; we might be done if this-amt is either equal
;; to the split amount or the group amount.
(cond
((gnc:qif-fuzzy= this-amt amount)
((gnc:numeric-equal this-amt amount)
(set! how
(cons 'one-to-one (list split))))
((and group-amt (gnc:qif-fuzzy= this-amt group-amt))
((and group-amt (gnc:numeric-equal this-amt group-amt))
(set! how
(cons 'one-to-many (list split))))
(#t
(set! same-acct-splits (cons split same-acct-splits))
(set! this-group-amt
(+ this-group-amt this-amt))))))
(n+ this-group-amt this-amt))))))
;; if 'how' is non-#f, we are ready to return.
(if (and (not how)
@ -855,7 +857,7 @@
;; now we're out of the loop. if 'how' isn't set,
;; we can still have a many-to-one match.
(if (and (not how)
(gnc:qif-fuzzy= this-group-amt amount))
(gnc:numeric-equal this-group-amt amount))
(begin
(set! how
(cons 'many-to-one same-acct-splits))))))

4
src/scm/report/account-piecharts.scm
View File

@ -29,6 +29,10 @@
(define-module (gnucash report account-piecharts))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
(define menuname-income (N_ "Income Piechart"))
(define menuname-expense (N_ "Expense Piechart"))
(define menuname-assets (N_ "Asset Piechart"))

2
src/scm/report/account-summary.scm
View File

@ -31,6 +31,8 @@
(define-module (gnucash report account-summary))
(use-modules (srfi srfi-1))
;; account summary report
;; prints a table of account information with clickable
;; links to open the corresponding register window.

2
src/scm/report/average-balance.scm
View File

@ -13,6 +13,8 @@
(gnc:depend "date-utilities.scm")
(define-module (gnucash report average-balance))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))

4
src/scm/report/balance-sheet.scm
View File

@ -30,9 +30,11 @@
(define-module (gnucash report balance-sheet))
(use-modules (ice-9 slib))
(require 'printf)
;; first define all option's names so that they are properly defined
;; in *one* place.
(define optname-to-date (N_ "To"))
(define optname-display-depth (N_ "Account Display Depth"))

3
src/scm/report/category-barchart.scm
View File

@ -27,6 +27,9 @@
(gnc:depend "date-utilities.scm")
(define-module (gnucash report category-barchart))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
;; The option names are defined here to 1. save typing and 2. avoid
;; spelling errors. The *reportnames* are defined here (and not only

4
src/scm/report/net-barchart.scm
View File

@ -31,6 +31,10 @@
(define-module (gnucash report net-barchart))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))
(define optname-stepsize (N_ "Step Size"))

4
src/scm/report/pnl.scm
View File

@ -27,6 +27,10 @@
(define-module (gnucash report pnl))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
;; Profit and loss report. Actually, people in finances might want
;; something different under this name, but they are welcomed to
;; contribute their changes :-)

4
src/scm/report/portfolio.scm
View File

@ -26,6 +26,10 @@
(define-module (gnucash report portfolio))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
(define optname-price-source (N_ "Price Source"))
(define (options-generator)

4
src/scm/report/price-scatter.scm
View File

@ -27,6 +27,10 @@
(define-module (gnucash report price-scatter))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
(define optname-from-date (N_ "From"))
(define optname-to-date (N_ "To"))
(define optname-stepsize (N_ "Step Size"))

4
src/scm/report/taxtxf.scm
View File

@ -36,6 +36,10 @@
(define-module (gnucash report taxtxf))
(use-modules (srfi srfi-1))
(use-modules (ice-9 slib))
(require 'printf)
(define (make-level-collector num-levels)
(let ((level-collector (make-vector num-levels)))
(do ((i 0 (+ i 1)))

1
src/scm/report/transaction.scm
View File

@ -32,6 +32,7 @@
(define-module (gnucash report transaction))
(use-modules (ice-9 slib))
(require 'printf)
(require 'record)
(define-macro (addto! alist element)