QIF importer: Prevent currency-denominated accounts from being assigned

a stock or mutual fund account type (bug 513829).
BP


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@16947 57a11ea4-9604-0410-9ed3-97b8803252fd

src/import-export/qif-import/qif-to-gnc.scm

@@ -6,9 +6,11 @@
 ;;;  Copyright 2000-2001 Bill Gribble <grib@billgribble.com> 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;  find-or-make-acct:
+;;  qif-import:find-or-make-acct
-;;  given a colon-separated account path, return an Account* to
+;;
+;;  Given a colon-separated account path, return an Account* to
 ;;  an existing or new account.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -49,28 +51,26 @@
                   (string-append short-name (sprintf #f " %a" count)))))
           short-name))
     
-    ;; just because we found an account doesn't mean we can use it.
+    ;; If a GnuCash account already exists in the old root with the same
-    ;; if the name is in use but the commodity, or type are
+    ;; name, that doesn't necessarily mean we can use it. The type and
-    ;; incompatible, we need to create a new account with a modified
+    ;; commodity must be  compatible.
-    ;; name.
     (if (and same-gnc-account (not (null? same-gnc-account))) 
         (if (compatible? same-gnc-account)
             (begin 
-              ;; everything is ok, so we can just use the same
+              ;; The existing GnuCash account is compatible, so we
-              ;; account.  Make sure we make the same type. 
+              ;; can use it. Make sure we use the same type. 
               (set! make-new-acct #f)
               (set! incompatible-acct #f)
               (set! allowed-types 
                     (list (xaccAccountGetType same-gnc-account))))
             (begin 
-              ;; there's an existing account with that name, so we
+              ;; There's an existing, incompatible account with that name,
-              ;; have to make a new acct with different properties and
+              ;; so we have to make a new account with different properties
-              ;; something to indicate that it's different
+              ;; and a slightly different name.
               (set! make-new-acct #t)
               (set! incompatible-acct #t)))
         (begin 
-          ;; otherwise, there is no existing account with the same 
+          ;; Otherwise, there's no existing account with the same name.
-          ;; name.
           (set! make-new-acct #t)
           (set! incompatible-acct #f)))
     
@@ -84,8 +84,35 @@
               (parent-acct #f)
               (parent-name #f)
               (acct-name #f)
-              (last-colon #f))
+              (last-sep #f))
-          (set! last-colon (string-rindex gnc-name separator))
+
+          ;; This procedure returns a default account type.  This could
+          ;; be smarter, but at least it won't allow security account
+          ;; types to be used on currency-denominated accounts.
+          (define (default-account-type allowed-types currency?)
+            (if (or (not allowed-types)
+                    (null? allowed-types))
+                ;; None of the allowed types are compatible.
+                ;; Bug detected!
+                (throw 'bug
+                       "qif-import:find-or-make-acct"
+                       "No valid account types allowed for account ~A."
+                       (list acct-name)
+                       #f)
+                (if (memv (car allowed-types) (list GNC-STOCK-TYPE
+                                                    GNC-MUTUAL-TYPE))
+                    ;; The type is incompatible with a currency.
+                    (if currency?
+                      (default-account-type (cdr allowed-types)
+                                            currency?)
+                      (car allowed-types))
+                    ;; The type is compatible with a currency.
+                    (if currency?
+                      (car allowed-types)
+                      (default-account-type (cdr allowed-types)
+                                            currency?)))))
+
+          (set! last-sep (string-rindex gnc-name separator))
           
           (xaccAccountBeginEdit new-acct)
           
@@ -107,30 +134,29 @@
                 (xaccAccountSetCode
                  new-acct (xaccAccountGetCode same-gnc-account))))
           
-          ;; make sure that if this is a nested account foo:bar:baz,
+          ;; If this is a nested account foo:bar:baz, make sure
-          ;; foo:bar and foo exist also.
+          ;; that foo:bar and foo exist also.
-          (if last-colon
+          (if last-sep
               (begin 
-                (set! parent-name (substring gnc-name 0 last-colon))
+                (set! parent-name (substring gnc-name 0 last-sep))
-                (set! acct-name (substring gnc-name (+ 1 last-colon) 
+                (set! acct-name (substring gnc-name (+ 1 last-sep) 
                                            (string-length gnc-name))))
-              (begin 
+              (set! acct-name gnc-name))
-                (set! acct-name gnc-name)))
           
-          ;; if this is a new account, use the 
+          ;; If this is a completely new account (as opposed to a copy
-          ;; parameters passed in
+          ;; of an existing account), use the parameters passed in.
           (if make-new-acct
               (begin 
-                ;; set the name, description, etc.
+                ;; Set the name, description, and commodity.
                 (xaccAccountSetName new-acct acct-name)
                 (if (qif-map-entry:description acct-info)
                     (xaccAccountSetDescription
                      new-acct (qif-map-entry:description acct-info)))
                 (xaccAccountSetCommodity new-acct commodity)
                 
-                ;; if it's an incompatible account, set the
+                ;; If there was an existing, incompatible account with
-                ;; name to be unique, and a description that 
+                ;; the same name, set the new account name to be unique,
-                ;; hints what's happening 
+                ;; and set a description that hints at what's happened.
                 (if incompatible-acct
                     (let ((new-name (make-unique-name-variant 
                                      gnc-name acct-name)))
@@ -139,13 +165,15 @@
                        new-acct 
                        (_ "QIF import: Name conflict with another account."))))
                 
-                ;; set the account type.  this could be smarter. 
+                ;; Set the account type.
-                (if (qif-map-entry:allowed-types acct-info)
+                (xaccAccountSetType new-acct
-                    (xaccAccountSetType
+                                    (default-account-type
-                     new-acct (car (qif-map-entry:allowed-types acct-info))))))
+                                      (qif-map-entry:allowed-types acct-info)
+                                      (gnc-commodity-is-currency commodity)))))
           (xaccAccountCommitEdit new-acct)
 
-          (if last-colon
+          ;; If a parent account is needed, find or make it.
+          (if last-sep
               (let ((pinfo (make-qif-map-entry)))
                 (qif-map-entry:set-qif-name! pinfo parent-name)
                 (qif-map-entry:set-gnc-name! pinfo parent-name)