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

Bill Gribble's update to the qif importer.

Browse Source 
* src/scm/qif-import/qif-dialog-utils.scm: Be more flexible
	about account types on QIF import

	* src/scm/qif-import/qif-objects.scm: make sure the list of
	allowed types is in the right order

	* src/scm/qif-import/qif-to-gnc.scm: be more flexible about type;
	check on parent type after creating child; don't set security on
	non-{stock,mutual} accounts.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3683 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2001-02-23 22:20:36 +00:00
parent 7e20ed1642
commit ce532a2a86
5 changed files with 95 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
ChangeLog
View File

@ -1,3 +1,15 @@
2001-02-23 Bill Gribble <grib@billgribble.com>
* src/scm/qif-import/qif-dialog-utils.scm: Be more flexible
about account types on QIF import
* src/scm/qif-import/qif-objects.scm: make sure the list of
allowed types is in the right order
* src/scm/qif-import/qif-to-gnc.scm: be more flexible about type;
check on parent type after creating child; don't set security on
non-{stock,mutual} accounts.
2001-02-22 Christian Stimming <stimming@tuhh.de> 2001-02-22 Christian Stimming <stimming@tuhh.de>
* src/engine/Transaction.h: Added xaccSplitGetAmount to be used * src/engine/Transaction.h: Added xaccSplitGetAmount to be used

41
src/scm/qif-import/qif-dialog-utils.scm
View File

@ -385,8 +385,10 @@
(set! entry (set! entry
(qif-import:guess-acct (qif-cat:name cat) (qif-import:guess-acct (qif-cat:name cat)
(if (qif-cat:expense-cat cat) (if (qif-cat:expense-cat cat)
(list GNC-EXPENSE-TYPE) (list GNC-EXPENSE-TYPE
(list GNC-INCOME-TYPE)) GNC-INCOME-TYPE)
(list GNC-INCOME-TYPE
GNC-EXPENSE-TYPE))
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-description! (qif-map-entry:set-description!
entry (qif-cat:description cat)) entry (qif-cat:description cat))
@ -416,8 +418,8 @@
(qif-import:guess-acct (qif-import:guess-acct
xtn-cat xtn-cat
(if (> (qif-split:amount split) 0) (if (> (qif-split:amount split) 0)
(list GNC-INCOME-TYPE) (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE)
(list GNC-EXPENSE-TYPE)) (list GNC-EXPENSE-TYPE GNC-INCOME-TYPE))
gnc-acct-info))) gnc-acct-info)))
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
(hash-set! cat-hash xtn-cat entry))))) (hash-set! cat-hash xtn-cat entry)))))
@ -492,8 +494,14 @@
(qif-map-entry:set-allowed-types! (qif-map-entry:set-allowed-types!
entry entry
(if (> (qif-split:amount split) 0) (if (> (qif-split:amount split) 0)
(list GNC-INCOME-TYPE GNC-EXPENSE-TYPE) (list GNC-INCOME-TYPE GNC-EXPENSE-TYPE
(list GNC-EXPENSE-TYPE GNC-INCOME-TYPE))))) GNC-BANK-TYPE GNC-CCARD-TYPE
GNC-LIABILITY-TYPE GNC-ASSET-TYPE
GNC-STOCK-TYPE GNC-MUTUAL-TYPE)
(list GNC-EXPENSE-TYPE GNC-INCOME-TYPE
GNC-BANK-TYPE GNC-CCARD-TYPE
GNC-LIABILITY-TYPE GNC-ASSET-TYPE
GNC-STOCK-TYPE GNC-MUTUAL-TYPE)))))
(qif-map-entry:set-display?! entry #t) (qif-map-entry:set-display?! entry #t)
(hash-set! memo-hash key-string entry))))) (hash-set! memo-hash key-string entry)))))
splits))) splits)))
@ -599,13 +607,22 @@
(gnc:get-account-from-full-name (gnc:get-account-from-full-name
(gnc:get-current-group) (gnc:get-current-group)
(qif-map-entry:gnc-name map-entry) (qif-map-entry:gnc-name map-entry)
separator))) separator))
(if existing-gnc-acct (existing-type
(gnc:account-get-type existing-gnc-acct)))
(if (and existing-gnc-acct
(memv existing-type (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE)))
;; gnc account already exists... we *know* what the ;; gnc account already exists... we *know* what the
;; security is supposed to be ;; security is supposed to be
(hash-set! (let ((currency
stock-hash stock-name (gnc:account-get-currency existing-gnc-acct))
(gnc:account-get-security existing-gnc-acct)) (security
(gnc:account-get-security existing-gnc-acct)))
(if security
(hash-set! stock-hash stock-name security)
(hash-set! stock-hash stock-name currency)))
;; we know nothing about this security.. we need to ;; we know nothing about this security.. we need to
;; ask about it ;; ask about it
(begin (begin
@ -619,7 +636,7 @@
100000)))))) 100000))))))
#f)) #f))
#f acct-hash) #f acct-hash)
(if (not (null? names)) (if (not (null? names))
(sort names string<?) (sort names string<?)
#f))) #f)))

7
src/scm/qif-import/qif-guess-map.scm
View File

@ -168,15 +168,16 @@
(let ((table '())) (let ((table '()))
(hash-fold (hash-fold
(lambda (key value p) (lambda (key value p)
(if (gw:wcp-is-of-type? <gnc:commodity*> value) (if (and value (gw:wcp-is-of-type? <gnc:commodity*> value))
(set! table (set! table
(cons (list key (cons (list key
(gnc:commodity-get-namespace value) (gnc:commodity-get-namespace value)
(gnc:commodity-get-mnemonic value)) (gnc:commodity-get-mnemonic value))
table))) table))
(display "write-commodities: something funny in hash table.\n"))
#f) #f hashtab) #f) #f hashtab)
(write table))) (write table)))
(define (qif-import:save-map-prefs acct-map cat-map memo-map stock-map) (define (qif-import:save-map-prefs acct-map cat-map memo-map stock-map)
(let* ((pref-dir (build-path (getenv "HOME") ".gnucash")) (let* ((pref-dir (build-path (getenv "HOME") ".gnucash"))

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

@ -518,7 +518,7 @@
me)) me))
(define (qif-map-entry:allowed-parent-types self) (define (qif-map-entry:allowed-parent-types self)
(let ((types-list (qif-map-entry:allowed-types self))) (let ((types-list (reverse (qif-map-entry:allowed-types self))))
(define (add-types . rest) (define (add-types . rest)
(for-each (for-each
(lambda (t) (lambda (t)

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

@ -18,7 +18,8 @@
;; an existing or new account. ;; an existing or new account.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:find-or-make-acct acct-info currency security (define (qif-import:find-or-make-acct acct-info check-types?
currency security
gnc-acct-hash old-group new-group) gnc-acct-hash old-group new-group)
(let* ((separator (string-ref (gnc:account-separator-char) 0)) (let* ((separator (string-ref (gnc:account-separator-char) 0))
(gnc-name (qif-map-entry:gnc-name acct-info)) (gnc-name (qif-map-entry:gnc-name acct-info))
@ -30,17 +31,6 @@
(make-new-acct #f) (make-new-acct #f)
(incompatible-acct #f)) (incompatible-acct #f))
(define (make-unique-name-variant long-name short-name)
(if (gnc:get-account-from-full-name old-group long-name separator)
(let loop ((count 2))
(let ((test-name
(string-append long-name (sprintf #f " %a" count))))
(if (gnc:get-account-from-full-name
old-group test-name separator)
(loop (+ 1 count))
(string-append short-name (sprintf #f " %a" count)))))
short-name))
(define (compatible? account) (define (compatible? account)
(let ((acc-type (gnc:account-get-type account)) (let ((acc-type (gnc:account-get-type account))
(acc-currency (gnc:account-get-currency account)) (acc-currency (gnc:account-get-currency account))
@ -48,15 +38,34 @@
(if (memv acc-type (if (memv acc-type
(list GNC-STOCK-TYPE GNC-MUTUAL-TYPE)) (list GNC-STOCK-TYPE GNC-MUTUAL-TYPE))
(and (and
(list? allowed-types) (if check-types?
(memv acc-type allowed-types) (and (list? allowed-types)
(memv acc-type allowed-types))
#t)
(gnc:commodity-equiv? acc-currency currency) (gnc:commodity-equiv? acc-currency currency)
(gnc:commodity-equiv? acc-security security)) (or (not security)
(gnc:commodity-equiv? acc-security security)))
(and (and
(list? allowed-types) (if check-types?
(memv acc-type allowed-types) (and
(list? allowed-types)
(memv acc-type allowed-types))
#t)
(gnc:commodity-equiv? acc-currency currency))))) (gnc:commodity-equiv? acc-currency currency)))))
(define (make-unique-name-variant long-name short-name)
(if (gnc:get-account-from-full-name old-group long-name separator)
(let loop ((count 2))
(let* ((test-name
(string-append long-name (sprintf #f " %a" count)))
(test-acct
(gnc:get-account-from-full-name old-group test-name
separator)))
(if (and test-acct (not (compatible? test-acct)))
(loop (+ 1 count))
(string-append short-name (sprintf #f " %a" count)))))
short-name))
;; just because we found an account doesn't mean we can use it. ;; just because we found an account doesn't mean we can use it.
;; if the name is in use but the currency, security, or type are ;; if the name is in use but the currency, security, or type are
;; incompatible, we need to create a new account with a modified ;; incompatible, we need to create a new account with a modified
@ -82,7 +91,10 @@
(set! make-new-acct #t) (set! make-new-acct #t)
(set! incompatible-acct #f))) (set! incompatible-acct #f)))
(if existing-account ;; here, existing-account means a previously *created* account
;; (possibly a new account, possibly a copy of an existing gnucash
;; acct)
(if (and existing-account (compatible? existing-account))
existing-account existing-account
(let ((new-acct (gnc:malloc-account)) (let ((new-acct (gnc:malloc-account))
(parent-acct #f) (parent-acct #f)
@ -116,18 +128,10 @@
;; make sure that if this is a nested account foo:bar:baz, ;; make sure that if this is a nested account foo:bar:baz,
;; foo:bar and foo exist also. ;; foo:bar and foo exist also.
(if last-colon (if last-colon
(let ((pinfo (make-qif-map-entry))) (begin
(set! parent-name (substring gnc-name 0 last-colon)) (set! parent-name (substring gnc-name 0 last-colon))
(set! acct-name (substring gnc-name (+ 1 last-colon) (set! acct-name (substring gnc-name (+ 1 last-colon)
(string-length gnc-name))) (string-length gnc-name))))
(qif-map-entry:set-qif-name! pinfo parent-name)
(qif-map-entry:set-gnc-name! pinfo parent-name)
(qif-map-entry:set-allowed-types!
pinfo (qif-map-entry:allowed-parent-types acct-info))
(set! parent-acct (qif-import:find-or-make-acct
pinfo currency security
gnc-acct-hash old-group new-group)))
(begin (begin
(set! acct-name gnc-name))) (set! acct-name gnc-name)))
@ -158,8 +162,20 @@
(if (qif-map-entry:allowed-types acct-info) (if (qif-map-entry:allowed-types acct-info)
(gnc:account-set-type (gnc:account-set-type
new-acct (car (qif-map-entry:allowed-types acct-info)))))) new-acct (car (qif-map-entry:allowed-types acct-info))))))
(gnc:account-commit-edit new-acct) (gnc:account-commit-edit new-acct)
(if last-colon
(let ((pinfo (make-qif-map-entry)))
(qif-map-entry:set-qif-name! pinfo parent-name)
(qif-map-entry:set-gnc-name! pinfo parent-name)
(qif-map-entry:set-allowed-types!
acct-info (list (gnc:account-get-type new-acct)))
(qif-map-entry:set-allowed-types!
pinfo (qif-map-entry:allowed-parent-types acct-info))
(set! parent-acct (qif-import:find-or-make-acct
pinfo #t currency #f
gnc-acct-hash old-group new-group))))
(if parent-acct (if parent-acct
(gnc:account-insert-subaccount parent-acct new-acct) (gnc:account-insert-subaccount parent-acct new-acct)
(gnc:group-insert-account new-group new-acct)) (gnc:group-insert-account new-group new-acct))
@ -256,17 +272,17 @@
(equity? (memv GNC-EQUITY-TYPE ok-types))) (equity? (memv GNC-EQUITY-TYPE ok-types)))
(cond ((and equity? security) ;; a "retained holdings" acct (cond ((and equity? security) ;; a "retained holdings" acct
(qif-import:find-or-make-acct acctinfo (qif-import:find-or-make-acct acctinfo #f
security security security security
gnc-acct-hash gnc-acct-hash
old-group new-group)) old-group new-group))
(security (security
(qif-import:find-or-make-acct (qif-import:find-or-make-acct
acctinfo default-currency security acctinfo #f default-currency security
gnc-acct-hash old-group new-group)) gnc-acct-hash old-group new-group))
(#t (#t
(qif-import:find-or-make-acct (qif-import:find-or-make-acct
acctinfo default-currency default-currency acctinfo #f default-currency #f
gnc-acct-hash old-group new-group))))) gnc-acct-hash old-group new-group)))))
sorted-accounts-list) sorted-accounts-list)