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 qif patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2462 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-06-13 19:51:42 +00:00
parent 4821068082
commit 2504698991
2 changed files with 140 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -28,7 +28,6 @@
y2k-threshold y2k-threshold
currency ;; this is a string.. no checking currency ;; this is a string.. no checking
xtns xtns
markable-xtns ;; we prune xtns to speed up marking.
accounts accounts
cats cats
classes))) classes)))
@ -84,12 +83,6 @@
(define qif-file:set-xtns! (define qif-file:set-xtns!
(simple-obj-setter <qif-file> 'xtns)) (simple-obj-setter <qif-file> 'xtns))
(define qif-file:markable-xtns
(simple-obj-getter <qif-file> 'markable-xtns))
(define qif-file:set-markable-xtns!
(simple-obj-setter <qif-file> 'markable-xtns))
(define qif-file:accounts (define qif-file:accounts
(simple-obj-getter <qif-file> 'accounts)) (simple-obj-getter <qif-file> 'accounts))

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

@ -147,6 +147,7 @@
(gnc-acct-hash (make-hash-table 20)) (gnc-acct-hash (make-hash-table 20))
(existing-gnc-accounts #f) (existing-gnc-accounts #f)
(sorted-accounts-list '()) (sorted-accounts-list '())
(markable-xtns '())
(sorted-qif-files-list (sorted-qif-files-list
(sort qif-files-list (sort qif-files-list
(lambda (a b) (lambda (a b)
@ -212,18 +213,26 @@
;; ones to match. ;; ones to match.
(for-each (for-each
(lambda (qif-file) (lambda (qif-file)
(let ((markable-xtns '())) (for-each
(for-each (lambda (xtn)
(lambda (xtn) (let splitloop ((splits (qif-xtn:splits xtn)))
(let splitloop ((splits (qif-xtn:splits xtn))) (if (qif-split:category-is-account? (car splits))
(if (qif-split:category-is-account? (car splits)) (set! markable-xtns (cons xtn markable-xtns))
(set! markable-xtns (cons xtn markable-xtns)) (if (not (null? (cdr splits)))
(if (not (null? (cdr splits))) (splitloop (cdr splits))))))
(splitloop (cdr splits)))))) (qif-file:xtns qif-file)))
(qif-file:xtns qif-file))
(qif-file:set-markable-xtns! qif-file markable-xtns)))
qif-files-list) qif-files-list)
;; now run through the markable transactions marking any
;; duplicates. marked transactions/splits won't get imported.
(if (> (length markable-xtns) 1)
(let xloop ((xtn (car markable-xtns))
(rest (cdr markable-xtns)))
(if (not (qif-xtn:mark xtn))
(qif-import:mark-matching-xtns xtn rest))
(if (not (null? (cdr rest)))
(xloop (car rest) (cdr rest)))))
;; iterate over files. Going in the sort order by number of ;; iterate over files. Going in the sort order by number of
;; transactions should give us a small speed advantage. ;; transactions should give us a small speed advantage.
(for-each (for-each
@ -232,11 +241,6 @@
(lambda (xtn) (lambda (xtn)
(if (not (qif-xtn:mark xtn)) (if (not (qif-xtn:mark xtn))
(begin (begin
;; mark the transaction and find any other QIF
;; xtns that refer to the same xtn
(qif-xtn:set-mark! xtn #t)
(qif-import:mark-matching-xtns xtn qif-file qif-files-list)
;; create and fill in the GNC transaction ;; create and fill in the GNC transaction
(let ((gnc-xtn (gnc:transaction-create))) (let ((gnc-xtn (gnc:transaction-create)))
(gnc:transaction-init gnc-xtn) (gnc:transaction-init gnc-xtn)
@ -257,7 +261,6 @@
;; rebalance and commit everything ;; rebalance and commit everything
(gnc:transaction-commit-edit gnc-xtn))))) (gnc:transaction-commit-edit gnc-xtn)))))
(qif-file:xtns qif-file))) (qif-file:xtns qif-file)))
sorted-qif-files-list) sorted-qif-files-list)
@ -327,46 +330,48 @@
;; end" for the transaction. ;; end" for the transaction.
(for-each (for-each
(lambda (qif-split) (lambda (qif-split)
(let ((gnc-far-split (gnc:split-create)) (if (not (qif-split:mark qif-split))
(far-acct-info #f) (let ((gnc-far-split (gnc:split-create))
(far-acct-name #f) (far-acct-info #f)
(far-acct-type #f) (far-acct-name #f)
(far-acct #f) (far-acct-type #f)
(split-amt (qif-split:amount qif-split)) (far-acct #f)
(memo (qif-split:memo qif-split))) (split-amt (qif-split:amount qif-split))
(memo (qif-split:memo qif-split)))
(if (not split-amt) (set! split-amt 0.0))
(if (not split-amt) (set! split-amt 0.0))
;; fill the splits in (near first). This handles files in
;; multiple currencies by pulling the currency value from the ;; fill the splits in (near first). This handles
;; file import. ;; files in multiple currencies by pulling the
(set! near-split-total (+ near-split-total split-amt)) ;; currency value from the file import.
(gnc:split-set-base-value gnc-far-split (- split-amt) currency) (set! near-split-total (+ near-split-total split-amt))
(gnc:split-set-base-value gnc-far-split
(if memo (gnc:split-set-memo gnc-far-split memo)) (- split-amt) currency)
(if (qif-split:category-is-account? qif-split) (if memo (gnc:split-set-memo gnc-far-split memo))
(set! far-acct-info
(hash-ref qif-acct-map (if (qif-split:category-is-account? qif-split)
(qif-split:category qif-split))) (set! far-acct-info
(set! far-acct-info (hash-ref qif-acct-map
(hash-ref qif-cat-map (qif-split:category qif-split)))
(qif-split:category qif-split)))) (set! far-acct-info
(set! far-acct-name (hash-ref qif-cat-map
(list-ref far-acct-info 1)) (qif-split:category qif-split))))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name)) (set! far-acct-name
(list-ref far-acct-info 1))
;; set the reconcile status. I thought I could set using (set! far-acct (hash-ref gnc-acct-hash far-acct-name))
;; the quicken type, but it looks like #\r reconcile
;; states aren't preserved across gnucash save/restores. ;; set the reconcile status. I thought I could set using
(let ((cleared (qif-split:matching-cleared qif-split))) ;; the quicken type, but it looks like #\r reconcile
(if (or (eq? 'cleared cleared) ;; states aren't preserved across gnucash save/restores.
(eq? 'reconciled cleared)) (let ((cleared (qif-split:matching-cleared qif-split)))
(gnc:split-set-reconcile gnc-far-split #\c))) (if (or (eq? 'cleared cleared)
(eq? 'reconciled cleared))
;; finally, plug the split into the account (gnc:split-set-reconcile gnc-far-split #\c)))
(gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct gnc-far-split))) ;; finally, plug the split into the account
(gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct gnc-far-split))))
splits) splits)
;; the value of the near split is the total of the far splits. ;; the value of the near split is the total of the far splits.
@ -474,10 +479,12 @@
(gnc:split-set-base-value gnc-far-split (- num-shares) (gnc:split-set-base-value gnc-far-split (- num-shares)
qif-security)) qif-security))
;; stock splits are a pain in the butt: QIF just specifies ;; stock splits: QIF just specifies the split ratio, not
;; the split ratio, not the number of shares in and out, ;; the number of shares in and out, so we have to fetch
;; so we have to fetch the number of shares from the ;; the number of shares from the security account
;; security account
;; FIXME : this could be wrong. Make sure the
;; share-amount is at the correct time.
((stksplit) ((stksplit)
(let* ((splitratio (/ num-shares 10)) (let* ((splitratio (/ num-shares 10))
(in-shares (in-shares
@ -537,24 +544,29 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:mark-matching-xtns ;; qif-import:mark-matching-xtns
;; find transactions that are the "opposite half" of xtn and
;; mark them so they won't be imported.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:mark-matching-xtns xtn qif-file qif-files) (define (qif-import:mark-matching-xtns xtn candidate-xtns)
(for-each (for-each
(lambda (split) (lambda (split)
(if (not (qif-split:mark split)) (if (not (qif-split:mark split))
(if (qif-split:category-is-account? split) (if (qif-split:category-is-account? split)
(begin (begin
(qif-split:set-mark! split #t)
(qif-split:set-matching-cleared! (qif-split:set-matching-cleared!
split split
(qif-import:mark-matching-split (qif-import:mark-matching-split
split xtn qif-file qif-files)) split xtn candidate-xtns))))))
(qif-split:set-mark! split #t))))) (qif-xtn:splits xtn)))
(qif-xtn:splits xtn))
(qif-xtn:set-mark! xtn #t))
(define (qif-import:mark-matching-split split xtn qif-file qif-files) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:mark-matching-split
;; find split(s) matching 'split' and mark them so they don't get
;; imported.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:mark-matching-split split xtn candidate-xtns)
(let* ((near-acct-name #f) (let* ((near-acct-name #f)
(far-acct-name (qif-split:category split)) (far-acct-name (qif-split:category split))
(date (qif-xtn:date xtn)) (date (qif-xtn:date xtn))
@ -574,9 +586,11 @@
(set! near-acct-name (qif-file:default-account qif-file)))) (set! near-acct-name (qif-file:default-account qif-file))))
(let ((qif-accts (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! near-acct-name (car qif-accts))
(set! far-acct-name (cadr qif-accts)) (set! far-acct-name (cadr qif-accts))
(if (not commission) (set! commission 0.0))
(if action (if action
;; we need to do some special massaging to get ;; we need to do some special massaging to get
;; transactions to match up. Quicken thinks the near ;; transactions to match up. Quicken thinks the near
@ -587,40 +601,31 @@
(set! near-acct-name (qif-xtn:from-acct xtn)) (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)))
((xout sellx) ((xout sellx)
(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 split of every
;; unmarked transaction of every file that has any transactions from ;; unmarked transaction in the candidate-xtns list.
;; the far-acct-name. (let xtn-loop ((xtns candidate-xtns))
(let file-loop ((files qif-files)) (if (not (qif-xtn:mark (car xtns)))
(let xtn-loop ((xtns (qif-file:markable-xtns (car files)))) (let split-loop ((splits (qif-xtn:splits (car xtns))))
(if (not (qif-xtn:mark (car xtns))) (if (qif-split:split-matches?
(let split-loop ((splits (qif-xtn:splits (car xtns)))) (car splits) (car xtns)
(if (qif-split:split-matches? near-acct-name date amount memo)
(car splits) (car xtns) (begin
near-acct-name date amount memo) (qif-xtn:merge-and-mark-xtns xtn split
(begin (car xtns) (car splits))
(qif-split:set-mark! (car splits) #t) (set! cleared? (qif-xtn:cleared (car xtns)))
(set! cleared? (qif-xtn:cleared (car xtns))) (set! done #t)))
(set! done #t) ;; iterate with the next split
(qif-xtn:merge-xtns xtn split (car xtns) (car splits)) (if (and (not done)
(let ((all-marked #t)) (not (null? (cdr splits))))
(for-each (split-loop (cdr splits)))))
(lambda (s) (if (not (qif-split:mark s))
(set! all-marked #f))) ;; iterate with the next transaction
(qif-xtn:splits (car xtns)))
(if all-marked (qif-xtn:set-mark!
(car xtns) #t)))))
(if (and (not done)
(not (null? (cdr splits))))
(split-loop (cdr splits)))))
(if (and (not done)
(not (null? (cdr xtns))))
(xtn-loop (cdr xtns))))
(if (and (not done) (if (and (not done)
(not (null? (cdr files)))) (not (null? (cdr xtns))))
(file-loop (cdr files)))) (xtn-loop (cdr xtns))))
cleared?)) cleared?))
@ -645,7 +650,7 @@
(case action (case action
((xout sellx intincx divx cglongx cgshortx miscincx miscexpx) ((xout sellx intincx divx cglongx cgshortx miscincx miscexpx)
(set! this-amt (- this-amt)))))) (set! this-amt (- this-amt))))))
(eqv? amount this-amt)) (= amount this-amt))
;; is the date the same? ;; is the date the same?
(let ((self-date (qif-xtn:date xtn))) (let ((self-date (qif-xtn:date xtn)))
@ -653,9 +658,9 @@
(pair? date) (pair? date)
(eq? (length self-date) 3) (eq? (length self-date) 3)
(eq? (length date) 3) (eq? (length date) 3)
(eqv? (car self-date) (car date)) (= (car self-date) (car date))
(eqv? (cadr self-date) (cadr date)) (= (cadr self-date) (cadr date))
(eqv? (caddr self-date) (caddr date)))) (= (caddr self-date) (caddr date))))
;; is the memo the same? (is this true?) ;; is the memo the same? (is this true?)
;; ignore it for now ;; ignore it for now
@ -734,12 +739,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-xtn:merge-xtns ;; qif-xtn:merge-and-mark-xtns
;; merge-xtns merges any additional information from other-xtn into ;; we know that the splits match. Pick one to mark and
;; xtn. this needs to be fleshed out a bit. ;; merge the information into the other one.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-xtn:merge-xtns xtn split other-xtn other-split) (define (qif-xtn:merge-and-mark-xtns xtn split other-xtn other-split)
;; merge transaction fields ;; merge transaction fields
(let ((action (qif-xtn:action xtn)) (let ((action (qif-xtn:action xtn))
(o-action (qif-xtn:action other-xtn)) (o-action (qif-xtn:action other-xtn))
@ -748,41 +753,38 @@
;; this is a transfer involving a security xtn. Let the ;; this is a transfer involving a security xtn. Let the
;; security xtn dominate the way it's handled. ;; security xtn dominate the way it's handled.
((and (not action) o-action security) ((and (not action) o-action security)
(qif-xtn:set-action! xtn o-action) (qif-xtn:mark-split xtn split)
(qif-xtn:set-security-name! xtn (qif-xtn:security-name other-xtn)) (qif-xtn:set-number! other-xtn
(qif-xtn:set-num-shares! xtn (qif-xtn:num-shares other-xtn)) (qif-xtn:number xtn)))
(qif-xtn:set-share-price! xtn (qif-xtn:share-price other-xtn)) ;; this is a security transaction from one brokerage to another
(qif-xtn:set-commission! xtn (qif-xtn:commission other-xtn)) ;; or within a brokerage. The "foox" xtn has the most
(qif-xtn:set-from-acct! ;; information about what went on, so use it.
xtn (qif-xtn:from-acct other-xtn))
(qif-split:set-amount! split (qif-split:amount other-split))
(qif-split:set-class! split (qif-split:class other-split))
(qif-split:set-category-is-account?!
split (qif-split:category-is-account? other-split))
(qif-split:set-category-private!
split (qif-split:category other-split)))
;; this is a security transaction from one brokerage to another.
;; The "foox" xtn has the most information about what went on, so
;; use it.
((and action o-action security) ((and action o-action security)
(case o-action (case o-action
((buyx sellx cgshortx cglongx intincx divx) ((buyx sellx cgshortx cglongx intincx divx)
(qif-xtn:set-action! xtn o-action) (qif-xtn:mark-split xtn split))
(qif-xtn:set-security-name! xtn (else
(qif-xtn:security-name other-xtn)) (qif-xtn:mark-split other-xtn other-split))))
(qif-xtn:set-num-shares! xtn (qif-xtn:num-shares other-xtn))
(qif-xtn:set-share-price! xtn (qif-xtn:share-price other-xtn)) ;; otherwise, this is a normal no-frills split match. if one
(qif-xtn:set-commission! xtn (qif-xtn:commission other-xtn)) ;; transaction has more splits than the other one,
(qif-split:set-amount! split (qif-split:amount other-split)) ;; (heuristically) mark the one with less splits.
(qif-split:set-class! split (qif-split:class other-split)) (#t
(qif-xtn:set-from-acct! (if (< (length (qif-xtn:splits xtn))
xtn (qif-xtn:from-acct other-xtn)) (length (qif-xtn:splits other-xtn)))
(qif-split:set-category-is-account?! (qif-xtn:mark-split xtn split)
split (qif-split:category-is-account? other-split)) (qif-xtn:mark-split other-xtn other-split))))))
(qif-split:set-category-private!
split (qif-split:category other-split))))))))
(define (qif-xtn:mark-split xtn split)
(qif-split:set-mark! split #t)
(let ((all-marked #t))
(let loop ((splits (qif-xtn:splits xtn)))
(if (not (qif-split:mark (car splits)))
(set! all-marked #f)
(if (not (null? (cdr splits)))
(loop (cdr splits)))))
(if all-marked
(qif-xtn:set-mark! xtn #t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:set-share-price split ;; qif-import:set-share-price split