qif import patch

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

src/scm/qif-import/qif-dialog-utils.scm

@@ -40,7 +40,7 @@
 ;; translation.  Sorted on # transactions, then alpha.
 
 (define (qif-dialog:make-account-display qif-files gnc-acct-info) 
-  (let ((acct-hash (make-hash-table 20))
+  (let ((acct-hash (cadr gnc-acct-info))
         (retval '()))
 
     ;; we want to make two passes here.  The first pass picks the
@@ -281,8 +281,6 @@
         bin))
      (vector->list acct-hash))
 
-    (list-set! gnc-acct-info 1 acct-hash)
-    
     ;; sort by number of transactions with that account so the 
     ;; most important are at the top
     (set! retval (sort retval 
@@ -299,7 +297,7 @@
 ;; QIF category name, xtn count, then GNUcash account. 
 
 (define (qif-dialog:make-category-display qif-files gnc-acct-info) 
-  (let ((cat-hash (make-hash-table 20))
+  (let ((cat-hash (caddr gnc-acct-info))
         (retval '()))
     ;; get the Cat entries from each file 
     (for-each 
@@ -363,8 +361,6 @@
         bin))
      (vector->list cat-hash))
     
-    (list-set! gnc-acct-info 2 cat-hash)
-    
     ;; sort by number of transactions with that account so the 
     ;; most important are at the top
     (set! retval (sort retval 

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

@@ -549,46 +549,78 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (qif-import:mark-matching-xtns xtn candidate-xtns)
-  (for-each 
+  (let splitloop ((splits-left (qif-xtn:splits xtn)))
-   (lambda (split)
-     (if (not (qif-split:mark split))
-         (if (qif-split:category-is-account? split)
-             (begin 
-               (qif-split:set-matching-cleared! 
-                split
-                (qif-import:mark-matching-split 
-                 split xtn candidate-xtns))))))
-   (qif-xtn:splits xtn)))
     
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; splits-left starts out as all the splits of this transaction.
-;; qif-import:mark-matching-split
+    ;; if multiple splits match up with a single split on the other 
-;; find split(s) matching 'split' and mark them so they don't get
+    ;; end, we may remove more than one split from splits-left with
-;; imported.
+    ;; each call to mark-some-splits.  
+    (if (not (null? splits-left))
+        (if (not (qif-split:mark (car splits-left)))
+            (set! splits-left 
+                  (qif-import:mark-some-splits 
+                   splits-left xtn candidate-xtns))
+            (set! splits-left (cdr splits-left))))
+    
+    (if (not (null? splits-left))
+        (splitloop splits-left))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; qif-import:mark-some-splits
+;; find split(s) matching elements of splits and mark them so they
+;; don't get imported.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (qif-import:mark-matching-split split xtn candidate-xtns)
+(define (qif-import:mark-some-splits splits xtn candidate-xtns)
-  (let* ((near-acct-name #f)
+  (let* ((split (car splits))
-         (far-acct-name (qif-split:category split))
+         (near-acct-name #f)
+         (far-acct-name #f)
          (date (qif-xtn:date xtn))
          (amount (- (qif-split:amount split)))
+         (group-amount #f)
          (memo (qif-split:memo split))        
          (security-name (qif-xtn:security-name xtn))
          (action (qif-xtn:action xtn))
          (bank-xtn? (not security-name))
          (cleared? #f)
+         (different-acct-splits '())
+         (same-acct-splits '())
+         (how #f)
          (done #f))
     
     (if bank-xtn?
         (begin 
           (set! near-acct-name (qif-xtn:from-acct xtn))
-          (set! far-acct-name (qif-split:category split)))
+          (set! far-acct-name (qif-split:category split))
+          (set! group-amount 0.0)
           
+          ;; group-amount is the sum of all the splits in this xtn
+          ;; going to the same account as 'split'.  We might be able
+          ;; to match this whole group to a single matching opposite
+          ;; split.
+          (for-each 
+           (lambda (s)
+             (if (and (qif-split:category-is-account? s)
+                      (string=? far-acct-name (qif-split:category s)))
+                 (begin
+                   (set! same-acct-splits 
+                         (cons s same-acct-splits))
+                   (set! group-amount (- 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 
-               (qif-split:accounts-affected split xtn))
+               (qif-split:accounts-affected split xtn)))
-              (commission (qif-xtn:commission xtn)))
           (set! near-acct-name (car qif-accts))
           (set! far-acct-name (cadr qif-accts))
-          (if (not commission) (set! commission 0.0))
+          (set! same-acct-splits (list split))
           (if action
               ;; we need to do some special massaging to get
               ;; transactions to match up.  Quicken thinks the near
@@ -602,58 +634,49 @@
                  (set! near-acct-name (qif-xtn:from-acct xtn))
                  (set! far-acct-name (qif-split:category split)))
                 ((xout)
-                 (set! amount (- amount)))))
+                 (set! amount (- amount)))))))
-          (set! amount (- amount commission))))
     
-    ;; this is the grind loop.  Go over every unmarked split of every
+    ;; this is the grind loop.  Go over every unmarked transaction in
-    ;; unmarked transaction in the candidate-xtns list.
+    ;; the candidate-xtns list.
     (let xtn-loop ((xtns candidate-xtns))
       (if (not (qif-xtn:mark (car xtns)))
-          (let split-loop ((splits (qif-xtn:splits (car xtns))))
-            (if (qif-split:split-matches?
-                 (car splits) (car xtns) 
-                 near-acct-name date amount memo)
           (begin 
-                  (qif-xtn:merge-and-mark-xtns xtn split 
+            (set! how
-                                               (car xtns) (car splits))
+                  (qif-import:xtn-has-matches? (car xtns) near-acct-name
-                  (set! cleared? (qif-xtn:cleared (car xtns)))
+                                               date amount group-amount))
-                  (set! done #t)))
+            (if how
-            ;; iterate with the next split
+                (begin
-            (if (and (not done)
+                  (qif-import:merge-and-mark-xtns xtn same-acct-splits 
-                       (not (null? (cdr splits))))
+                                                  (car xtns) how)
-                (split-loop (cdr splits)))))
+                  (set! done #t)))))
-      
       ;; iterate with the next transaction
       (if (and (not done)
                (not (null? (cdr xtns))))
           (xtn-loop (cdr xtns))))
-    cleared?))
     
+    ;; return the rest of the splits to iterate on
+    (if (not how)
+        (cdr splits)
+        (case (car how)
+          ((one-to-one many-to-one)
+           (cdr splits))
+          ((one-to-many)
+           different-acct-splits)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;  qif-split:split-matches? 
+;;  qif-import:xtn-has-matches?
-;;  check if a split matches date, amount, and other criteria
+;;  check for one-to-one, many-to-one, one-to-many split matches.
+;;  returns either #f (no match) or a cons cell with the car being one
+;;  of 'one-to-one 'one-to-many 'many-to-one, the cdr being a list of
+;;  splits that were part of the matching group.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (qif-split:split-matches? split xtn acct-name date amount memo)
+(define (qif-import:xtn-has-matches? xtn acct-name date amount group-amt)
-  (and 
+  (let ((matching-splits '())
-   ;; account name matches 
+        (same-acct-splits '())
-   (string=? acct-name (qif-split:category split))
+        (this-group-amt 0.0)
-   
+        (how #f)
-   ;; is the amount right?  flip the sign for sellx and xout
+        (date-matches 
-   ;; transactions, since they are represented with positive values
-   ;; for outgoing funds.
-   (let ((this-amt (qif-split:amount split))
-         (stock-xtn (qif-xtn:security-name xtn))
-         (action (qif-xtn:action xtn)))
-     (if (and stock-xtn action)
-         (begin 
-           (case action 
-             ((xout sellx intincx divx cglongx cgshortx miscincx miscexpx)
-              (set! this-amt (- this-amt))))))
-     (= amount this-amt))
-   
-   ;; is the date the same?
          (let ((self-date (qif-xtn:date xtn)))
            (and (pair? self-date)
                 (pair? date)
@@ -661,11 +684,59 @@
                 (eq? (length date) 3)
                 (= (car self-date) (car date))
                 (= (cadr self-date) (cadr date))
-          (= (caddr self-date) (caddr date))))
+                (= (caddr self-date) (caddr date))))))
+    (if date-matches 
+        (begin 
+          ;; calculate a group total for splits going to acct-name    
+          (let split-loop ((splits-left (qif-xtn:splits xtn)))
+            (let ((split (car splits-left)))
+              ;; does the account match up?
+              (if (and (qif-split:category-is-account? split)
+                       (string=? (qif-split:category split) acct-name))
+                  ;; if so, get the amount 
+                  (let ((this-amt (qif-split:amount split))
+                        (stock-xtn (qif-xtn:security-name xtn))
+                        (action (qif-xtn:action xtn)))
+                    ;; need to change the sign of the amount for some
+                    ;; stock transactions (buy/sell both positive in
+                    ;; QIF)
+                    (if (and stock-xtn action)
+                        (case action 
+                          ((xout sellx intincx divx cglongx cgshortx 
+                                 miscincx miscexpx)
+                           (set! this-amt (- this-amt)))))
                     
-   ;; is the memo the same? (is this true?)
+                    ;; we might be done if this-amt is either equal 
-   ;; ignore it for now
+                    ;; to the split amount or the group amount.
-   ))
+                    (cond 
+                     ((= this-amt amount)
+                      (set! how 
+                            (cons 'one-to-one (list split))))
+                     ((and group-amt (= 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))))))
+              
+              ;; if 'how' is non-#f, we are ready to return.
+              (if (and (not how) 
+                       (not (null? (cdr splits-left))))
+                  (split-loop (cdr splits-left)))))
+          
+          ;; 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)
+                   (= this-group-amt amount))
+              (begin 
+                (set! how 
+                      (cons 'many-to-one same-acct-splits))))))
+    
+    ;; we're all done.  'how' either is #f or a 
+    ;; cons of the way-it-matched and a list of the matching 
+    ;; splits. 
+    how))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -740,32 +811,69 @@
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-xtn:merge-and-mark-xtns 
+;; qif-import:merge-and-mark-xtns 
 ;; we know that the splits match.  Pick one to mark and 
 ;; merge the information into the other one.  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (qif-xtn:merge-and-mark-xtns xtn split other-xtn other-split)
+(define (qif-import:merge-and-mark-xtns xtn splits other-xtn how)
   ;; merge transaction fields 
   (let ((action (qif-xtn:action xtn))
         (o-action (qif-xtn:action other-xtn))
-        (security (qif-xtn:security-name other-xtn)))
+        (security (qif-xtn:security-name other-xtn))
+        (split (car splits))
+        (match-type (car how))
+        (match-splits (cdr how)))
+    (case match-type 
+      ;; many-to-one: the other-xtn has several splits that total
+      ;; in amount to 'split'.  We want to preserve the multi-split
+      ;; transaction.  
+      ((many-to-one)
+       (qif-xtn:mark-split xtn split)
+       (qif-import:merge-xtn-info xtn other-xtn)
+       (for-each 
+        (lambda (s)
+          (qif-split:set-matching-cleared! s (qif-xtn:cleared xtn)))
+        match-splits))
+      
+      ;; one-to-many: 'split' is just one of a set of splits in xtn
+      ;; that total up to the split in match-splits.
+      ((one-to-many)
+       (qif-xtn:mark-split other-xtn (car match-splits))
+       (qif-import:merge-xtn-info other-xtn xtn)
+       (for-each 
+        (lambda (s)
+          (qif-split:set-matching-cleared! 
+           s (qif-xtn:cleared other-xtn)))
+        splits))
+
+      ;; otherwise: one-to-one, a normal single split match.
+      (else 
        (cond 
         ;; this is a transfer involving a security xtn.  Let the 
         ;; security xtn dominate the way it's handled. 
         ((and (not action) o-action security)
          (qif-xtn:mark-split xtn split)
-      (qif-xtn:set-number! other-xtn 
+         (qif-import:merge-xtn-info xtn other-xtn)
-                           (qif-xtn:number xtn)))
+         (qif-split:set-matching-cleared! 
+          (car match-splits) (qif-xtn:cleared xtn)))
+        
         ;; this is a security transaction from one brokerage to another
         ;; or within a brokerage.  The "foox" xtn has the most
         ;; information about what went on, so use it.
         ((and action o-action security)
          (case o-action
            ((buyx sellx cgshortx cglongx intincx divx)
-         (qif-xtn:mark-split xtn split))
+            (qif-xtn:mark-split xtn split)
+            (qif-import:merge-xtn-info xtn other-xtn)
+            (qif-split:set-matching-cleared!
+             (car match-splits) (qif-xtn:cleared xtn)))
+           
            (else 
-         (qif-xtn:mark-split other-xtn other-split))))
+            (qif-xtn:mark-split other-xtn (car match-splits))
+            (qif-import:merge-xtn-info other-xtn xtn)
+            (qif-split:set-matching-cleared! 
+             split (qif-xtn:cleared other-xtn)))))        
         
         ;; otherwise, this is a normal no-frills split match.  if one
         ;; transaction has more splits than the other one,
@@ -773,9 +881,28 @@
         (#t 
          (if (< (length (qif-xtn:splits xtn))
                 (length (qif-xtn:splits other-xtn)))
+             (begin 
                (qif-xtn:mark-split xtn split)
-          (qif-xtn:mark-split other-xtn other-split))))))
+               (qif-import:merge-xtn-info xtn other-xtn)
+               (qif-split:set-matching-cleared!
+                (car match-splits) (qif-xtn:cleared xtn)))
              
+             (begin
+               (qif-xtn:mark-split other-xtn (car match-splits))
+               (qif-import:merge-xtn-info other-xtn xtn)
+               (qif-split:set-matching-cleared!
+                split (qif-xtn:cleared other-xtn))))))))))
+
+(define (qif-import:merge-xtn-info from-xtn to-xtn)
+  (if (and (qif-xtn:payee from-xtn)
+           (not (qif-xtn:payee to-xtn)))
+      (qif-xtn:set-payee! to-xtn (qif-xtn:payee from-xtn)))
+  (if (and (qif-xtn:address from-xtn)
+           (not (qif-xtn:address to-xtn)))
+      (qif-xtn:set-address! to-xtn (qif-xtn:address from-xtn)))
+  (if (and (qif-xtn:number from-xtn)
+           (not (qif-xtn:number to-xtn)))
+      (qif-xtn:set-number! to-xtn (qif-xtn:number from-xtn))))
 
 
 (define (qif-xtn:mark-split xtn split)