Bill Gribble's update to the qif importer.

* 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

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>
* src/engine/Transaction.h: Added xaccSplitGetAmount to be used

View File

@ -385,8 +385,10 @@
(set! entry
(qif-import:guess-acct (qif-cat:name cat)
(if (qif-cat:expense-cat cat)
(list GNC-EXPENSE-TYPE)
(list GNC-INCOME-TYPE))
(list GNC-EXPENSE-TYPE
GNC-INCOME-TYPE)
(list GNC-INCOME-TYPE
GNC-EXPENSE-TYPE))
gnc-acct-info)))
(qif-map-entry:set-description!
entry (qif-cat:description cat))
@ -416,8 +418,8 @@
(qif-import:guess-acct
xtn-cat
(if (> (qif-split:amount split) 0)
(list GNC-INCOME-TYPE)
(list GNC-EXPENSE-TYPE))
(list GNC-INCOME-TYPE GNC-EXPENSE-TYPE)
(list GNC-EXPENSE-TYPE GNC-INCOME-TYPE))
gnc-acct-info)))
(qif-map-entry:set-display?! entry #t)
(hash-set! cat-hash xtn-cat entry)))))
@ -492,8 +494,14 @@
(qif-map-entry:set-allowed-types!
entry
(if (> (qif-split:amount split) 0)
(list GNC-INCOME-TYPE GNC-EXPENSE-TYPE)
(list GNC-EXPENSE-TYPE GNC-INCOME-TYPE)))))
(list GNC-INCOME-TYPE GNC-EXPENSE-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)
(hash-set! memo-hash key-string entry)))))
splits)))
@ -599,13 +607,22 @@
(gnc:get-account-from-full-name
(gnc:get-current-group)
(qif-map-entry:gnc-name map-entry)
separator)))
(if existing-gnc-acct
separator))
(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
;; security is supposed to be
(hash-set!
stock-hash stock-name
(gnc:account-get-security existing-gnc-acct))
(let ((currency
(gnc:account-get-currency 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
;; ask about it
(begin
@ -619,7 +636,7 @@
100000))))))
#f))
#f acct-hash)
(if (not (null? names))
(sort names string<?)
#f)))

View File

@ -168,15 +168,16 @@
(let ((table '()))
(hash-fold
(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
(cons (list key
(gnc:commodity-get-namespace value)
(gnc:commodity-get-mnemonic value))
table)))
table))
(display "write-commodities: something funny in hash table.\n"))
#f) #f hashtab)
(write table)))
(define (qif-import:save-map-prefs acct-map cat-map memo-map stock-map)
(let* ((pref-dir (build-path (getenv "HOME") ".gnucash"))

View File

@ -518,7 +518,7 @@
me))
(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)
(for-each
(lambda (t)

View File

@ -18,7 +18,8 @@
;; 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)
(let* ((separator (string-ref (gnc:account-separator-char) 0))
(gnc-name (qif-map-entry:gnc-name acct-info))
@ -30,17 +31,6 @@
(make-new-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)
(let ((acc-type (gnc:account-get-type account))
(acc-currency (gnc:account-get-currency account))
@ -48,15 +38,34 @@
(if (memv acc-type
(list GNC-STOCK-TYPE GNC-MUTUAL-TYPE))
(and
(list? allowed-types)
(memv acc-type allowed-types)
(if check-types?
(and (list? allowed-types)
(memv acc-type allowed-types))
#t)
(gnc:commodity-equiv? acc-currency currency)
(gnc:commodity-equiv? acc-security security))
(or (not security)
(gnc:commodity-equiv? acc-security security)))
(and
(list? allowed-types)
(memv acc-type allowed-types)
(if check-types?
(and
(list? allowed-types)
(memv acc-type allowed-types))
#t)
(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.
;; if the name is in use but the currency, security, or type are
;; incompatible, we need to create a new account with a modified
@ -82,7 +91,10 @@
(set! make-new-acct #t)
(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
(let ((new-acct (gnc:malloc-account))
(parent-acct #f)
@ -116,18 +128,10 @@
;; make sure that if this is a nested account foo:bar:baz,
;; foo:bar and foo exist also.
(if last-colon
(let ((pinfo (make-qif-map-entry)))
(begin
(set! parent-name (substring gnc-name 0 last-colon))
(set! acct-name (substring gnc-name (+ 1 last-colon)
(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)))
(string-length gnc-name))))
(begin
(set! acct-name gnc-name)))
@ -158,8 +162,20 @@
(if (qif-map-entry:allowed-types acct-info)
(gnc:account-set-type
new-acct (car (qif-map-entry:allowed-types acct-info))))))
(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
(gnc:account-insert-subaccount parent-acct new-acct)
(gnc:group-insert-account new-group new-acct))
@ -256,17 +272,17 @@
(equity? (memv GNC-EQUITY-TYPE ok-types)))
(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
gnc-acct-hash
old-group new-group))
(security
(qif-import:find-or-make-acct
acctinfo default-currency security
acctinfo #f default-currency security
gnc-acct-hash old-group new-group))
(#t
(qif-import:find-or-make-acct
acctinfo default-currency default-currency
acctinfo #f default-currency #f
gnc-acct-hash old-group new-group)))))
sorted-accounts-list)