mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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:
parent
7e20ed1642
commit
ce532a2a86
12
ChangeLog
12
ChangeLog
@ -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
|
||||
|
@ -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)))
|
||||
|
@ -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"))
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user