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@2456 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-06-12 21:50:58 +00:00
parent 2069a63ddc
commit 08635f8e8e
5 changed files with 433 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
src/scm/qif-import/qif-dialog-utils.scm
View File

@ -9,20 +9,25 @@
(gnc:support "qif-import/qif-dialog-utils.scm") (gnc:support "qif-import/qif-dialog-utils.scm")
(define (default-dividend-acct security) (define (default-stock-acct brokerage security)
(string-append "Dividends:" security)) (string-append brokerage ":" security))
(define (default-interest-acct security) (define (default-dividend-acct brokerage security)
(string-append "Interest:" security)) (string-append "Dividends:" brokerage ":" security))
(define (default-cglong-acct security) (define (default-interest-acct brokerage security)
(string-append "Cap. gain (long):" security)) (string-append "Interest:" brokerage ":" security))
(define (default-cgshort-acct security) (define (default-cglong-acct brokerage security)
(string-append "Cap. gain (short):" security)) (string-append "Cap. gain (long):" brokerage ":" security))
(define (default-cgshort-acct brokerage security)
(string-append "Cap. gain (short):" brokerage ":" security))
(define (default-equity-holding security)
(string-append "Retained Holdings:" security))
(define (default-equity-account) "Retained Earnings") (define (default-equity-account) "Retained Earnings")
(define (default-equity-category) "[Retained Earnings]")
;; the account-display is a 3-columned list of accounts in the QIF ;; the account-display is a 3-columned list of accounts in the QIF
;; import dialog (the "Account" page of the notebook). Column 1 is ;; import dialog (the "Account" page of the notebook). Column 1 is
@ -72,14 +77,13 @@
(for-each (for-each
(lambda (xtn) (lambda (xtn)
(let ((stock-acct (qif-xtn:security-name xtn)) (let ((stock-acct (qif-xtn:security-name xtn))
(action (qif-xtn:number xtn)) (action (qif-xtn:action xtn))
(action-sym #f)
(from-acct (qif-xtn:from-acct xtn)) (from-acct (qif-xtn:from-acct xtn))
(qif-account #f) (qif-account #f)
(qif-account-types #f) (qif-account-types #f)
(entry #f)) (entry #f))
(if (and stock-acct (string? action)) (if (and stock-acct action)
;; stock transactions are weird. there can be several ;; stock transactions are weird. there can be several
;; accounts associated with stock xtns: the security, ;; accounts associated with stock xtns: the security,
;; the brokerage, a dividend account, a long-term CG ;; the brokerage, a dividend account, a long-term CG
@ -87,14 +91,14 @@
;; account. Make sure all of the right ones get stuck ;; account. Make sure all of the right ones get stuck
;; in the map. ;; in the map.
(begin (begin
(set! action-sym (qif-parse:parse-action-field action))
;; first: figure out what the near-end account is. ;; first: figure out what the near-end account is.
;; it's generally the security account, but could be ;; it's generally the security account, but could be
;; an interest, dividend, or CG account. ;; an interest, dividend, or CG account.
(case action-sym (case action
((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg ((buy buyx sell sellx reinvint reinvdiv reinvsh reinvsg
reinvlg shrsin stksplit) reinvlg shrsin shrsout stksplit)
(set! qif-account stock-acct) (set! qif-account
(default-stock-acct from-acct stock-acct))
(set! qif-account-types (list GNC-STOCK-TYPE (set! qif-account-types (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE))) GNC-MUTUAL-TYPE)))
((div cgshort cglong intinc miscinc miscexp xin xout) ((div cgshort cglong intinc miscinc miscexp xin xout)
@ -107,10 +111,7 @@
(qif-split:category (qif-split:category
(car (qif-xtn:splits xtn)))) (car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-BANK-TYPE (set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE))) GNC-CCARD-TYPE))))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; now reference the near-end account ;; now reference the near-end account
(if qif-account (if qif-account
@ -128,12 +129,12 @@
;; now figure out the other end of the transaction. ;; now figure out the other end of the transaction.
;; the far end will be the brokerage for buy, sell, ;; the far end will be the brokerage for buy, sell,
;; etc, or the "L"-referenced account for buyx, ;; etc, or the "L"-referenced account for buyx,
;; sellx, etc, or an equity account for ShrsIn ;; sellx, etc, or an equity account for ShrsIn/ShrsOut
;; miscintx and miscexpx are very, very "special" ;; miscintx and miscexpx are very, very "special"
;; cases which I don't quite handle correctly yet. ;; cases which I don't quite handle correctly yet.
(set! qif-account #f) (set! qif-account #f)
(case action-sym (case action
((buy sell) ((buy sell)
(set! qif-account from-acct) (set! qif-account from-acct)
(set! qif-account-types (list GNC-BANK-TYPE (set! qif-account-types (list GNC-BANK-TYPE
@ -146,12 +147,13 @@
GNC-CCARD-TYPE))) GNC-CCARD-TYPE)))
((stksplit) ((stksplit)
(set! qif-account stock-acct) (set! qif-account
(default-stock-acct from-acct stock-acct))
(set! qif-account-types (list GNC-STOCK-TYPE (set! qif-account-types (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE))) GNC-MUTUAL-TYPE)))
((cgshort cgshortx reinvsg reinvsh) ((cgshort cgshortx reinvsg reinvsh)
(set! qif-account (set! qif-account
(default-cgshort-acct stock-acct)) (default-cgshort-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((miscincx) ((miscincx)
@ -168,31 +170,27 @@
((cglong cglongx reinvlg) ((cglong cglongx reinvlg)
(set! qif-account (set! qif-account
(default-cglong-acct stock-acct)) (default-cglong-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((intinc intincx reinvint) ((intinc intincx reinvint)
(set! qif-account (set! qif-account
(default-interest-acct stock-acct)) (default-interest-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((div divx reinvdiv) ((div divx reinvdiv)
(set! qif-account (set! qif-account
(default-dividend-acct stock-acct)) (default-dividend-acct from-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE))) (set! qif-account-types (list GNC-INCOME-TYPE)))
((shrsin) ((shrsin shrsout)
(set! qif-account (set! qif-account
(default-equity-account)) (default-equity-holding stock-acct))
(set! qif-account-types (list GNC-EQUITY-TYPE))) (set! qif-account-types (list GNC-EQUITY-TYPE)))
((miscinc miscexp) ((miscinc miscexp)
;; these reference a category on the other end ;; these reference a category on the other end
(set! qif-account #f)) (set! qif-account #f)))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; now reference the far-end account ;; now reference the far-end account
(if qif-account (if qif-account

18
src/scm/qif-import/qif-file.scm
View File

@ -116,10 +116,12 @@
(string-append current "\n" value)))) (string-append current "\n" value))))
;; N : check number / transaction number /xtn direction ;; N : check number / transaction number /xtn direction
;; this could be a number or a string; no point in ;; there's both an action and a number in gnucash,
;; keeping it numeric just yet. ;; one for securities, one for banks.
((#\N) ((#\N)
(qif-xtn:set-number! current-xtn value)) (if (eq? qstate-type 'type:invst)
(qif-xtn:set-action! current-xtn value)
(qif-xtn:set-number! current-xtn value)))
;; C : cleared flag ;; C : cleared flag
((#\C) ((#\C)
@ -350,9 +352,11 @@
;; to change the category to point to the equity account that ;; to change the category to point to the equity account that
;; the opening balance comes from. ;; the opening balance comes from.
(begin (begin
(qif-split:set-category! (qif-split:set-category-private!
(car (qif-xtn:splits xtn)) (car (qif-xtn:splits xtn))
(default-equity-category)) (default-equity-account))
(qif-split:set-category-is-account?!
(car (qif-xtn:splits xtn)) #t)
(if (eq? (qif-file:default-account self) 'unknown) (if (eq? (qif-file:default-account self) 'unknown)
(qif-file:set-default-account! self category))) (qif-file:set-default-account! self category)))
@ -435,6 +439,10 @@
qif-xtn:cleared qif-xtn:set-cleared! qif-xtn:cleared qif-xtn:set-cleared!
qif-parse:parse-cleared-field (qif-file:xtns self) set-error) qif-parse:parse-cleared-field (qif-file:xtns self) set-error)
(parse-field
qif-xtn:action qif-xtn:set-action!
qif-parse:parse-action-field (qif-file:xtns self) set-error)
(check-and-parse-field (check-and-parse-field
qif-xtn:share-price qif-xtn:set-share-price! qif-xtn:share-price qif-xtn:set-share-price!
qif-parse:check-number-format '(decimal comma) qif-parse:check-number-format '(decimal comma)

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

@ -27,7 +27,6 @@
default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE
y2k-threshold y2k-threshold
currency ;; this is a string.. no checking currency ;; this is a string.. no checking
accts-mentioned
xtns xtns
markable-xtns ;; we prune xtns to speed up marking. markable-xtns ;; we prune xtns to speed up marking.
accounts accounts
@ -67,12 +66,6 @@
(define qif-file:set-currency! (define qif-file:set-currency!
(simple-obj-setter <qif-file> 'currency)) (simple-obj-setter <qif-file> 'currency))
(define qif-file:accts-mentioned
(simple-obj-getter <qif-file> 'accts-mentioned))
(define qif-file:set-accts-mentioned!
(simple-obj-setter <qif-file> 'accts-mentioned))
(define qif-file:cats (define qif-file:cats
(simple-obj-getter <qif-file> 'cats)) (simple-obj-getter <qif-file> 'cats))
@ -108,7 +101,6 @@
(qif-file:set-default-account! self account) (qif-file:set-default-account! self account)
(qif-file:set-currency! self currency) (qif-file:set-currency! self currency)
(qif-file:set-y2k-threshold! self 50) (qif-file:set-y2k-threshold! self 50)
(qif-file:set-accts-mentioned! self '())
(qif-file:set-xtns! self '()) (qif-file:set-xtns! self '())
(qif-file:set-accounts! self '()) (qif-file:set-accounts! self '())
(qif-file:set-cats! self '()) (qif-file:set-cats! self '())
@ -202,7 +194,7 @@
(define <qif-xtn> (define <qif-xtn>
(make-simple-class (make-simple-class
'qif-xtn 'qif-xtn
'(date payee address number cleared '(date payee address number action cleared
from-acct share-price num-shares security-name commission from-acct share-price num-shares security-name commission
splits mark))) splits mark)))
@ -233,6 +225,12 @@
(define qif-xtn:set-number! (define qif-xtn:set-number!
(simple-obj-setter <qif-xtn> 'number)) (simple-obj-setter <qif-xtn> 'number))
(define qif-xtn:action
(simple-obj-getter <qif-xtn> 'action))
(define qif-xtn:set-action!
(simple-obj-setter <qif-xtn> 'action))
(define qif-xtn:cleared (define qif-xtn:cleared
(simple-obj-getter <qif-xtn> 'cleared)) (simple-obj-getter <qif-xtn> 'cleared))
@ -456,23 +454,6 @@
(simple-obj-print self)) (simple-obj-print self))
(define (qif-file:add-xtn! self xtn) (define (qif-file:add-xtn! self xtn)
(let ((splits (qif-xtn:splits xtn)))
(for-each
(lambda (split)
(let ((accts (qif-split:accounts-affected split xtn))
(mentioned (qif-file:accts-mentioned self)))
;; add the near account to the mentioned-list
;; but only for the first split
(if (and (eq? (car splits) split)
(not (member (car accts) mentioned)))
(qif-file:set-accts-mentioned!
self (cons (car accts) mentioned)))
;; add the far account for each split
(set! mentioned (qif-file:accts-mentioned self))
(if (not (member (cadr accts) mentioned))
(qif-file:set-accts-mentioned!
self (cons (cadr accts) mentioned)))))
splits))
(qif-file:set-xtns! self (qif-file:set-xtns! self
(cons xtn (qif-file:xtns self)))) (cons xtn (qif-file:xtns self))))

121
src/scm/qif-import/qif-parse.scm
View File

@ -175,63 +175,67 @@
(define (qif-parse:parse-action-field read-value) (define (qif-parse:parse-action-field read-value)
(let ((action-symbol (string-to-canonical-symbol read-value))) (if read-value
(case action-symbol (let ((action-symbol (string-to-canonical-symbol read-value)))
;; buy (case action-symbol
((buy kauf) ;; buy
'buy) ((buy kauf)
((buyx kaufx) 'buy)
'buyx) ((buyx kaufx)
((sell) ;; verkaufen 'buyx)
'sell) ((sell) ;; verkaufen
((sellx) 'sell)
'sellx) ((sellx)
((div) ;; dividende 'sellx)
'div) ((div) ;; dividende
((divx) 'div)
'divx) ((divx)
((int intinc aktzu) ;; zinsen 'divx)
'intinc) ((int intinc aktzu) ;; zinsen
((intx intincx) 'intinc)
'intincx) ((intx intincx)
((cglong) ;; Kapitalgewinnsteuer 'intincx)
'cglong) ((cglong) ;; Kapitalgewinnsteuer
((cglongx) 'cglong)
'cglongx) ((cglongx)
((cgshort) 'cglongx)
'cgshort) ((cgshort)
((cgshortx) 'cgshort)
'cgshortx) ((cgshortx)
((shrsin) 'cgshortx)
'shrsin) ((shrsin)
((xin) 'shrsin)
'xin) ((shrsout)
((xout) 'shrsout)
'xout) ((xin)
((stksplit) 'xin)
'stksplit) ((xout)
((reinvdiv) 'xout)
'reinvdiv) ((stksplit)
((reinvint) 'stksplit)
'reinvint) ((reinvdiv)
((reinvsg) 'reinvdiv)
'reinvsg) ((reinvint)
((reinvsh) 'reinvint)
'reinvsh) ((reinvsg)
((reinvlg reinvkur) 'reinvsg)
'reinvlg) ((reinvsh)
((miscinc) 'reinvsh)
'miscinc) ((reinvlg reinvkur)
((miscincx) 'reinvlg)
'miscincx) ((miscinc)
((miscexp) 'miscinc)
'miscexp) ((miscincx)
((miscexpx) 'miscincx)
'miscexpx) ((miscexp)
(else 'miscexp)
(display "qif-parse:parse-action-field : unknown action field ") ((miscexpx)
(write read-value) (newline) 'miscexpx)
'unknown)))) (else
(display "qif-parse:parse-action-field : unknown action field ")
(write read-value) (newline)
#f)))
#f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-cleared-field : in a C (cleared) field in a QIF transaction, ;; parse-cleared-field : in a C (cleared) field in a QIF transaction,
@ -479,7 +483,8 @@
(let ((retval formats)) (let ((retval formats))
(for-each (for-each
(lambda (amt) (lambda (amt)
(set! retval (qif-parse:check-number-format amt retval))) (if amt
(set! retval (qif-parse:check-number-format amt retval))))
amt-strings) amt-strings)
retval)) retval))

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

@ -24,6 +24,7 @@
separator)) separator))
(check-full-name #f) (check-full-name #f)
(make-new-acct #f) (make-new-acct #f)
(set-security #t)
(default-currency (default-currency
(gnc:option-value (gnc:option-value
(gnc:lookup-global-option "International" "Default Currency")))) (gnc:lookup-global-option "International" "Default Currency"))))
@ -70,7 +71,6 @@
(gnc:account-set-security (gnc:account-set-security
new-acct (gnc:account-get-security same-gnc-account)))) new-acct (gnc:account-get-security same-gnc-account))))
;; make sure that if this is a nested account foo:bar:baz, ;; make sure that if this is a nested account foo:bar:baz,
;; foo:bar and foo exist also. ;; foo:bar and foo exist also.
(if last-colon (if last-colon
@ -81,53 +81,87 @@
(set! parent-acct (qif-import:find-or-make-acct (set! parent-acct (qif-import:find-or-make-acct
parent-name gnc-acct-hash parent-name gnc-acct-hash
gnc-type qif-info gnc-type qif-info
acct-group)) acct-group)))
;; if this is a new account, use the
;; parameters passed in
(if make-new-acct
(begin
(gnc:account-set-name new-acct acct-name)
(gnc:account-set-currency new-acct default-currency)
(if gnc-type (gnc:account-set-type new-acct gnc-type))
(cond ((and (qif-acct? qif-info)
(qif-acct:description qif-info))
(gnc:account-set-description
new-acct (qif-acct:description qif-info)))
((and (qif-cat? qif-info)
(qif-cat:description qif-info))
(gnc:account-set-description
new-acct (qif-cat:description qif-info)))
((and (qif-xtn? qif-info)
(qif-xtn:security-name qif-info))
(gnc:account-set-security
new-acct (qif-xtn:security-name qif-info)))
((string? qif-info)
(gnc:account-set-description
new-acct qif-info)))))
(gnc:account-commit-edit new-acct)
(gnc:insert-subaccount parent-acct new-acct))
(begin (begin
(if make-new-acct (set! acct-name gnc-name)))
(begin
(gnc:account-set-name new-acct gnc-name)
(gnc:account-set-currency new-acct default-currency)
(cond ((and (qif-acct? qif-info)
(qif-acct:description qif-info))
(gnc:account-set-description
new-acct (qif-acct:description qif-info)))
((and (qif-cat? qif-info)
(qif-cat:description qif-info))
(gnc:account-set-description
new-acct (qif-cat:description qif-info)))
((string? qif-info)
(gnc:account-set-description
new-acct qif-info)))
(if gnc-type (gnc:account-set-type new-acct gnc-type))))
(gnc:account-commit-edit new-acct) ;; if this is a new account, use the
(gnc:group-insert-account acct-group new-acct))) ;; parameters passed in
(if make-new-acct
(begin
(gnc:account-set-name new-acct acct-name)
(if (and gnc-type
(eq? GNC-EQUITY-TYPE gnc-type)
(qif-xtn? qif-info)
(qif-xtn:security-name qif-info))
;; this is the special case of the
;; "retained holdings" equity account
(begin
(gnc:account-set-currency
new-acct (qif-xtn:security-name qif-info))
(set! set-security #f))
(begin
(gnc:account-set-currency new-acct
default-currency)
(set! set-security #t)))
(if gnc-type (gnc:account-set-type new-acct gnc-type))
(cond ((and (qif-acct? qif-info)
(qif-acct:description qif-info))
(gnc:account-set-description
new-acct (qif-acct:description qif-info)))
((and (qif-cat? qif-info)
(qif-cat:description qif-info))
(gnc:account-set-description
new-acct (qif-cat:description qif-info)))
((and (qif-xtn? qif-info)
(qif-xtn:security-name qif-info)
set-security)
(gnc:account-set-security
new-acct (qif-xtn:security-name qif-info)))
((string? qif-info)
(gnc:account-set-description
new-acct qif-info)))))
(gnc:account-commit-edit new-acct)
(if parent-acct
(gnc:insert-subaccount parent-acct new-acct)
(gnc:group-insert-account acct-group new-acct))
; (begin
; (if make-new-acct
; (begin
; (gnc:account-set-name new-acct gnc-name)
; (if (and gnc-type
; (eq? GNC-EQUITY-TYPE gnc-type)
; (qif-xtn? qif-info)
; (qif-xtn:qif-security-name qif-info))
; ;; this is the special case of the
; ;; "retained holdings" equity account
; (begin
; (gnc:account-set-currency
; new-acct (qif-xtn:security-name qif-info))
; (set! set-security #f))
; (begin
; (gnc:account-set-currency new-acct
; default-currency)
; (set! set-security #t)))
; (cond ((and (qif-acct? qif-info)
; (qif-acct:description qif-info))
; (gnc:account-set-description
; new-acct (qif-acct:description qif-info)))
; ((and (qif-cat? qif-info)
; (qif-cat:description qif-info))
; (gnc:account-set-description
; new-acct (qif-cat:description qif-info)))
; ((string? qif-info)
; (gnc:account-set-description
; new-acct qif-info)))
; (if gnc-type (gnc:account-set-type new-acct gnc-type))))
; (gnc:account-commit-edit new-acct)
(hash-set! gnc-acct-hash gnc-name new-acct) (hash-set! gnc-acct-hash gnc-name new-acct)
new-acct)))) new-acct))))
@ -146,6 +180,7 @@
(account-group (gnc:get-current-group)) (account-group (gnc:get-current-group))
(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-qif-files-list (sorted-qif-files-list
(sort qif-files-list (sort qif-files-list
(lambda (a b) (lambda (a b)
@ -160,16 +195,10 @@
(for-each (for-each
(lambda (hashpair) (lambda (hashpair)
(let* ((acctinfo (cdr hashpair)) (let* ((acctinfo (cdr hashpair))
(qif-name (list-ref acctinfo 0)) (gnc-xtns (list-ref acctinfo 4)))
(gnc-name (list-ref acctinfo 1))
(gnc-type (list-ref acctinfo 2))
(gnc-new (list-ref acctinfo 3))
(gnc-xtns (list-ref acctinfo 4))
(qif-info (list-ref acctinfo 5)))
(if (> gnc-xtns 0) (if (> gnc-xtns 0)
(qif-import:find-or-make-acct gnc-name gnc-acct-hash (set! sorted-accounts-list
gnc-type qif-info (cons acctinfo sorted-accounts-list)))))
account-group))))
bin)) bin))
(vector->list qif-acct-map)) (vector->list qif-acct-map))
@ -178,19 +207,41 @@
(for-each (for-each
(lambda (hashpair) (lambda (hashpair)
(let* ((acctinfo (cdr hashpair)) (let* ((acctinfo (cdr hashpair))
(qif-name (list-ref acctinfo 0)) (gnc-xtns (list-ref acctinfo 4)))
(gnc-name (list-ref acctinfo 1))
(gnc-type (list-ref acctinfo 2))
(gnc-new (list-ref acctinfo 3))
(gnc-xtns (list-ref acctinfo 4))
(qif-info (list-ref acctinfo 5)))
(if (> gnc-xtns 0) (if (> gnc-xtns 0)
(qif-import:find-or-make-acct gnc-name gnc-acct-hash (set! sorted-accounts-list
gnc-type qif-info (cons acctinfo sorted-accounts-list)))))
account-group))))
bin)) bin))
(vector->list qif-cat-map)) (vector->list qif-cat-map))
;; sort the account info on the depth of the account path. if a
;; short part is explicitly mentioned, make sure it gets created
;; before the deeper path, which will create the parent accounts
;; without the information about their type.
(set! sorted-accounts-list
(sort sorted-accounts-list
(lambda (a b)
(let ((a-depth
(length (string-split-on (cadr a) #\:)))
(b-depth
(length (string-split-on (cadr b) #\:))))
(< a-depth b-depth)))))
(for-each
(lambda (acctinfo)
(let ((qif-name (list-ref acctinfo 0))
(gnc-name (list-ref acctinfo 1))
(gnc-type (list-ref acctinfo 2))
(gnc-new (list-ref acctinfo 3))
(gnc-xtns (list-ref acctinfo 4))
(qif-info (list-ref acctinfo 5)))
(qif-import:find-or-make-acct gnc-name gnc-acct-hash
gnc-type qif-info
account-group)))
sorted-accounts-list)
;; before trying to mark transactions, prune down the list of ;; before trying to mark transactions, prune down the list of
;; ones to match. ;; ones to match.
(for-each (for-each
@ -269,11 +320,26 @@
(currency (qif-file:currency qif-file)) (currency (qif-file:currency qif-file))
(qif-payee (qif-xtn:payee qif-xtn)) (qif-payee (qif-xtn:payee qif-xtn))
(qif-number (qif-xtn:number qif-xtn)) (qif-number (qif-xtn:number qif-xtn))
(qif-action (qif-xtn:action qif-xtn))
(qif-security (qif-xtn:security-name qif-xtn)) (qif-security (qif-xtn:security-name qif-xtn))
(qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn)))) (qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn))))
(qif-from-acct (qif-xtn:from-acct qif-xtn)) (qif-from-acct (qif-xtn:from-acct qif-xtn))
(qif-cleared (qif-xtn:cleared qif-xtn))) (qif-cleared (qif-xtn:cleared qif-xtn)))
;; set properties of the whole transaction
(apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn))
(if qif-payee
(gnc:transaction-set-description gnc-xtn qif-payee))
(if qif-number
(gnc:transaction-set-xnum gnc-xtn qif-number))
(if qif-memo
(gnc:split-set-memo gnc-near-split qif-memo))
(if (or (eq? qif-cleared 'cleared)
(eq? qif-cleared 'reconciled))
(gnc:split-set-reconcile gnc-near-split #\c))
(if (not qif-security) (if (not qif-security)
(begin (begin
;; NON-STOCK TRANSACTIONS: the near account is the current ;; NON-STOCK TRANSACTIONS: the near account is the current
@ -346,8 +412,7 @@
;; "action" encoded in the Number field. It's generally the ;; "action" encoded in the Number field. It's generally the
;; security account (for buys, sells, and reinvests) but can ;; security account (for buys, sells, and reinvests) but can
;; also be an interest, dividend, or SG/LG account. ;; also be an interest, dividend, or SG/LG account.
(let ((action-sym (qif-parse:parse-action-field qif-number)) (let ((share-price (qif-xtn:share-price qif-xtn))
(share-price (qif-xtn:share-price qif-xtn))
(num-shares (qif-xtn:num-shares qif-xtn)) (num-shares (qif-xtn:num-shares qif-xtn))
(split-amt (qif-split:amount (car (qif-xtn:splits qif-xtn)))) (split-amt (qif-split:amount (car (qif-xtn:splits qif-xtn))))
(qif-accts #f) (qif-accts #f)
@ -356,9 +421,9 @@
(far-acct-info #f) (far-acct-info #f)
(far-acct-name #f) (far-acct-name #f)
(far-acct #f) (far-acct #f)
(defer-share-price #f)
(gnc-far-split (gnc:split-create))) (gnc-far-split (gnc:split-create)))
(if (not share-price) (set! share-price 0.0))
(if (not num-shares) (set! num-shares 0.0)) (if (not num-shares) (set! num-shares 0.0))
(if (not split-amt) (set! split-amt 0.0)) (if (not split-amt) (set! split-amt 0.0))
@ -395,28 +460,49 @@
;; the amounts and signs: are shares going in or out? ;; the amounts and signs: are shares going in or out?
;; are amounts currency or shares? ;; are amounts currency or shares?
(case action-sym (case qif-action
((buy buyx reinvint reinvdiv reinvsg reinvsh reinvlg shrsin) ((buy buyx reinvint reinvdiv reinvsg reinvsh reinvlg)
(if (not share-price) (set! share-price 0.0))
(gnc:split-set-share-price gnc-near-split share-price) (gnc:split-set-share-price gnc-near-split share-price)
(gnc:split-set-share-price gnc-far-split share-price) (gnc:split-set-share-price gnc-far-split share-price)
(gnc:split-set-share-amount gnc-near-split num-shares) (gnc:split-set-share-amount gnc-near-split num-shares)
(gnc:split-set-share-amount gnc-far-split (- num-shares))) (gnc:split-set-share-amount gnc-far-split (- num-shares)))
((sell sellx) ((sell sellx)
(if (not share-price) (set! share-price 0.0))
(gnc:split-set-share-price gnc-near-split share-price) (gnc:split-set-share-price gnc-near-split share-price)
(gnc:split-set-share-price gnc-far-split share-price) (gnc:split-set-share-price gnc-far-split share-price)
(gnc:split-set-share-amount gnc-near-split (- num-shares)) (gnc:split-set-share-amount gnc-near-split (- num-shares))
(gnc:split-set-share-amount gnc-far-split num-shares)) (gnc:split-set-share-amount gnc-far-split num-shares))
((cgshort cgshortx cglong cglongx intinc intincx div divx ((cgshort cgshortx cglong cglongx intinc intincx div divx
miscinc miscincx miscexp miscexpx xin) miscinc miscincx xin)
(gnc:split-set-base-value gnc-near-split split-amt currency) (gnc:split-set-base-value gnc-near-split split-amt currency)
(gnc:split-set-base-value gnc-far-split (- split-amt) currency)) (gnc:split-set-base-value gnc-far-split (- split-amt) currency))
((xout) ((xout miscexp miscexpx )
(gnc:split-set-base-value gnc-near-split (- split-amt) currency) (gnc:split-set-base-value gnc-near-split (- split-amt) currency)
(gnc:split-set-base-value gnc-far-split split-amt currency)) (gnc:split-set-base-value gnc-far-split split-amt currency))
((shrsin)
;; for shrsin, the near account is the security account.
;; we'll need to set the share-price after a little
;; trickery post-adding-to-account
(if (not share-price)
(set! defer-share-price #t)
(gnc:split-set-share-price gnc-near-split share-price))
(gnc:split-set-share-amount gnc-near-split num-shares)
(gnc:split-set-base-value gnc-far-split num-shares
qif-security))
((shrsout)
;; shrsout is like shrsin
(if (not share-price)
(set! defer-share-price #t)
(gnc:split-set-share-price gnc-near-split share-price))
(gnc:split-set-share-amount gnc-near-split (- num-shares))
(gnc:split-set-base-value gnc-far-split (- num-shares)
qif-security))
;; stock splits are a pain in the butt: QIF just specifies ;; stock splits are a pain in the butt: QIF just specifies
;; the split ratio, not the number of shares in and out, ;; the split ratio, not the number of shares in and out,
;; so we have to fetch the number of shares from the ;; so we have to fetch the number of shares from the
@ -426,13 +512,14 @@
(in-shares (in-shares
(gnc:account-get-share-balance near-acct)) (gnc:account-get-share-balance near-acct))
(out-shares (* in-shares splitratio))) (out-shares (* in-shares splitratio)))
(if (not share-price) (set! share-price 0.0))
(gnc:split-set-share-price gnc-near-split (gnc:split-set-share-price gnc-near-split
(/ share-price splitratio)) (/ share-price splitratio))
(gnc:split-set-share-price gnc-far-split share-price) (gnc:split-set-share-price gnc-far-split share-price)
(gnc:split-set-share-amount gnc-near-split out-shares) (gnc:split-set-share-amount gnc-near-split out-shares)
(gnc:split-set-share-amount gnc-far-split (- in-shares)))) (gnc:split-set-share-amount gnc-far-split (- in-shares))))
(else (else
(display "symbol = " ) (write action-sym) (newline))) (display "symbol = " ) (write qif-action) (newline)))
(let ((cleared (qif-split:matching-cleared (let ((cleared (qif-split:matching-cleared
(car (qif-xtn:splits qif-xtn))))) (car (qif-xtn:splits qif-xtn)))))
@ -446,22 +533,12 @@
(gnc:account-insert-split near-acct gnc-near-split) (gnc:account-insert-split near-acct gnc-near-split)
(gnc:transaction-append-split gnc-xtn gnc-far-split) (gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct gnc-far-split))))) (gnc:account-insert-split far-acct gnc-far-split)
;; set properties of the whole transaction
(apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn))
(if qif-payee
(gnc:transaction-set-description gnc-xtn qif-payee))
(if qif-number
(gnc:transaction-set-xnum gnc-xtn qif-number))
(if qif-memo
(gnc:split-set-memo gnc-near-split qif-memo))
(if (or (eq? qif-cleared 'cleared)
(eq? qif-cleared 'reconciled))
(gnc:split-set-reconcile gnc-near-split #\c))
;; now find the share price if we need to
;; (shrsin and shrsout xtns)
(if defer-share-price
(qif-import:set-share-price gnc-near-split))))))
;; return the modified transaction (though it's ignored). ;; return the modified transaction (though it's ignored).
gnc-xtn)) gnc-xtn))
@ -491,7 +568,7 @@
(amount (- (qif-split:amount split))) (amount (- (qif-split:amount split)))
(memo (qif-split:memo split)) (memo (qif-split:memo split))
(security-name (qif-xtn:security-name xtn)) (security-name (qif-xtn:security-name xtn))
(action (qif-xtn:number xtn)) (action (qif-xtn:action xtn))
(bank-xtn? (not security-name)) (bank-xtn? (not security-name))
(cleared? #f) (cleared? #f)
(done #f)) (done #f))
@ -502,57 +579,58 @@
(if near (if near
(set! near-acct-name near) (set! near-acct-name near)
(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)))
(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 action
;; we need to do some special massaging to get
;; transactions to match up. Quicken thinks the near
;; and far accounts are different than we do.
(case action
((intincx divx cglongx cgshortx miscincx miscexpx)
(set! amount (- amount))
(set! near-acct-name (qif-xtn:from-acct xtn))
(set! far-acct-name (qif-split:category split)))
((xout sellx)
(set! amount (- amount)))))))
;; 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 of every file that has any transactions from
;; the far-acct-name. ;; the far-acct-name.
(let file-loop ((files qif-files)) (let file-loop ((files qif-files))
(if (and (let xtn-loop ((xtns (qif-file:markable-xtns (car files))))
(member near-acct-name (if (not (qif-xtn:mark (car xtns)))
(qif-file:accts-mentioned (car files))) (let split-loop ((splits (qif-xtn:splits (car xtns))))
(member far-acct-name (if (qif-split:split-matches?
(qif-file:accts-mentioned (car files)))) (car splits) (car xtns)
near-acct-name date amount memo)
(begin
(qif-split:set-mark! (car splits) #t)
(set! cleared? (qif-xtn:cleared (car xtns)))
(set! done #t)
(qif-xtn:merge-xtns xtn split (car xtns) (car splits))
(let ((all-marked #t))
(for-each
(lambda (s) (if (not (qif-split:mark s))
(set! all-marked #f)))
(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 (eq? qif-file (car files))) (if (and (not done)
;; (or (not bank-xtn?) (not (null? (cdr xtns))))
;; (string=? far-acct-name (xtn-loop (cdr xtns))))
;; (qif-file:account (car files)))))
(let xtn-loop ((xtns (qif-file:markable-xtns (car files))))
(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
;;; (display "found ")(write (car splits))(newline)
(qif-split:set-mark! (car splits) #t)
(set! cleared? (qif-xtn:cleared (car xtns)))
(set! done #t)
(let ((all-marked #t))
(for-each
(lambda (s) (if (not (qif-split:mark s))
(set! all-marked #f)))
(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 files))))
(file-loop (cdr files)))) (file-loop (cdr files))))
cleared?)) cleared?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-split:split-matches? ;; qif-split:split-matches?
;; check if a split matches date, amount, and other criteria ;; check if a split matches date, amount, and other criteria
@ -563,8 +641,18 @@
;; account name matches ;; account name matches
(string=? acct-name (qif-split:category split)) (string=? acct-name (qif-split:category split))
;; is the amount right? ;; is the amount right? flip the sign for sellx and xout
(eqv? amount (qif-split:amount split)) ;; 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))))))
(eqv? 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)))
@ -580,6 +668,7 @@
;; ignore it for now ;; ignore it for now
)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (qif-split:accounts-affected split xtn) ;; (qif-split:accounts-affected split xtn)
;; Get the near and far ends of a split, returned as a list ;; Get the near and far ends of a split, returned as a list
@ -589,7 +678,8 @@
(let ((near-acct-name #f) (let ((near-acct-name #f)
(far-acct-name #f) (far-acct-name #f)
(security (qif-xtn:security-name xtn)) (security (qif-xtn:security-name xtn))
(action (qif-xtn:number xtn))) (action (qif-xtn:action xtn))
(from-acct (qif-xtn:from-acct xtn)))
;; for non-security transactions, the near account is the ;; for non-security transactions, the near account is the
;; acct in which the xtn is, and the far is the account ;; acct in which the xtn is, and the far is the account
@ -598,52 +688,121 @@
(if (not security) (if (not security)
;; non-security transactions ;; non-security transactions
(begin (begin
(set! near-acct-name (qif-xtn:from-acct xtn)) (set! near-acct-name from-acct)
(set! far-acct-name (qif-split:category split))) (set! far-acct-name (qif-split:category split)))
;; security transactions : the near end is either the ;; security transactions : the near end is either the
;; brokerage, the stock, or the category ;; brokerage, the stock, or the category
(let ((action-sym (qif-parse:parse-action-field action))) (begin
(case action-sym (case action
((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh ((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh
reinvlg shrsin stksplit) reinvlg shrsin shrsout stksplit)
(set! near-acct-name security)) (set! near-acct-name (default-stock-acct from-acct security)))
((div cgshort cglong intinc miscinc miscexp xin xout) ((div cgshort cglong intinc miscinc miscexp xin xout)
(set! near-acct-name (qif-xtn:from-acct xtn))) (set! near-acct-name from-acct))
((divx cgshortx cglongx intincx miscintx miscexpx) ((divx cgshortx cglongx intincx miscincx miscexpx)
(set! near-acct-name (set! near-acct-name
(qif-split:category (car (qif-xtn:splits xtn))))) (qif-split:category (car (qif-xtn:splits xtn))))))
(else
(set! near-acct-name (qif-xtn:from-acct xtn))
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; the far split: where is the money coming from? ;; the far split: where is the money coming from?
;; Either the brokerage account, the category, ;; Either the brokerage account, the category,
;; or an external account ;; or an external account
(case action-sym (case action
((buy sell) ((buy sell)
(set! far-acct-name (qif-xtn:from-acct xtn))) (set! far-acct-name from-acct))
((buyx sellx miscinc miscincx miscexp miscexpx xin xout) ((buyx sellx miscinc miscincx miscexp miscexpx xin xout)
(set! far-acct-name (set! far-acct-name
(qif-split:category (car (qif-xtn:splits xtn))))) (qif-split:category (car (qif-xtn:splits xtn)))))
((stksplit) ((stksplit)
(set! far-acct-name security)) (set! far-acct-name (default-stock-acct from-acct security)))
((cgshort cgshortx reinvsg reinvsh) ((cgshort cgshortx reinvsg reinvsh)
(set! far-acct-name (set! far-acct-name
(default-cgshort-acct security))) (default-cgshort-acct from-acct security)))
((cglong cglongx reinvlg) ((cglong cglongx reinvlg)
(set! far-acct-name (set! far-acct-name
(default-cglong-acct security))) (default-cglong-acct from-acct security)))
((intinc intincx reinvint) ((intinc intincx reinvint)
(set! far-acct-name (set! far-acct-name
(default-interest-acct security))) (default-interest-acct from-acct security)))
((div divx reinvdiv) ((div divx reinvdiv)
(set! far-acct-name (set! far-acct-name
(default-dividend-acct security))) (default-dividend-acct from-acct security)))
((shrsin) ((shrsin shrsout)
(set! far-acct-name (set! far-acct-name
(default-equity-account)))))) (default-equity-holding security))))))
(list near-acct-name far-acct-name))) (list near-acct-name far-acct-name)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-xtn:marge-xtns
;; merge-xtns merges any additional information from other-xtn into
;; xtn. this needs to be fleshed out a bit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-xtn:merge-xtns xtn split other-xtn other-split)
;; merge transaction fields
(let ((action (qif-xtn:action xtn))
(o-action (qif-xtn:action other-xtn))
(security (qif-xtn:security-name other-xtn)))
(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:set-action! xtn o-action)
(qif-xtn:set-security-name! xtn (qif-xtn:security-name other-xtn))
(qif-xtn:set-num-shares! xtn (qif-xtn:num-shares other-xtn))
(qif-xtn:set-share-price! xtn (qif-xtn:share-price other-xtn))
(qif-xtn:set-commission! xtn (qif-xtn:commission other-xtn))
(qif-xtn:set-from-acct!
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)
(case o-action
((buyx sellx cgshortx cglongx intincx divx)
(qif-xtn:set-action! xtn o-action)
(qif-xtn:set-security-name! xtn
(qif-xtn:security-name other-xtn))
(qif-xtn:set-num-shares! xtn (qif-xtn:num-shares other-xtn))
(qif-xtn:set-share-price! xtn (qif-xtn:share-price other-xtn))
(qif-xtn:set-commission! xtn (qif-xtn:commission other-xtn))
(qif-split:set-amount! split (qif-split:amount other-split))
(qif-split:set-class! split (qif-split:class other-split))
(qif-xtn:set-from-acct!
xtn (qif-xtn:from-acct other-xtn))
(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)))))))
;; merge split fields
(write xtn) (newline)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:set-share-price split
;; find the split that precedes 'split' in the account and set split's
;; share price to that.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-import:set-share-price split)
(let* ((account (gnc:split-get-account split))
(numsplits (gnc:account-get-split-count account)))
(let loop ((i 0)
(last-split #f))
(let ((ith-split (gnc:account-get-split account i)))
(if (pointer-token-eq? ith-split split)
(if last-split
(gnc:split-set-share-price
split (gnc:split-get-share-price last-split)))
(if (< i numsplits) (loop (+ 1 i) ith-split)))))))