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

Bug#481528: Relax duplicate matching criteria on imported QIF transactions that

Browse Source 
contain only a debit/credit pair so that they have a chance of match existing
transactions with more than two splits.
BP


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@16953 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Charles Day 2008-02-23 04:54:51 +00:00
parent e2cff72ade
commit 848808c4c2
1 changed files with 77 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
src/import-export/qif-import/qif-merge-groups.scm
View File

@ -5,6 +5,12 @@
;;; Copyright 2001 Bill Gribble <grib@billgribble.com>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:account-tree-get-transactions
;;
;; Given an account tree, this procedure returns a list of all
;; transactions whose splits only use accounts in the tree.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:account-tree-get-transactions root)
(let ((accounts (gnc-account-get-descendants-sorted root)))
(if (null? accounts)
@ -29,9 +35,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:account-tree-find-duplicates
;;
;; This procedure compares two account trees, given by old-root
;; and new-root, and returns a list of splits/transactions in
;; old-root that may be duplicates.
;; Given two account trees, old-root and new-root, a search is
;; performed to determine, for each transaction in new-root,
;; whether there are any transactions in old-root that may be
;; duplicated by it.
;;
;; The search results are returned in an association list, with
;; new-root transactions as the keys. The value associated with
;; each key is a second association list of possibly duplicated
;; transactions in the old-root, taking the form:
;; ( (old-xtn . #f) (old-xtn . #f) (old-xtn . #f) ... )
;;
;; The druid can then ask the user for a final determination,
;; and change #f to #t where duplication is found.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:account-tree-find-duplicates old-root new-root window)
@ -69,7 +85,8 @@
;; that matches possibly duplicate transactions in the old tree.
(for-each
(lambda (xtn)
(let ((query (qof-query-create-for-splits)))
(let ((query (qof-query-create-for-splits))
(num-splits 0))
(set! work-done (+ 1 work-done))
(if (not (null? progress-dialog))
(begin
@ -92,19 +109,19 @@
(incdate date WeekDelta)
QOF-QUERY-AND))
;; For each split in the transaction, add a term
;; to match the properties of one split.
;; For each split in the new transaction, add a
;; term that can match on its properties.
(let ((q-splits (qof-query-create-for-splits)))
(for-each
(lambda (split)
(set! num-splits (+ num-splits 1))
(let ((sq (qof-query-create-for-splits)))
(qof-query-set-book sq (gnc-account-get-book old-root))
;; We want to match the account in the old tree that
;; has the same name as an account in the new tree.
;; If there's not one (indicating a new account),
;; the match will be NULL and the query won't find
;; anything. Optimize this later.
;; Require a match on the account name. If the name
;; doesn't exist in the old tree (indicating a new
;; account), the match will be NULL and the query
;; won't find anything. Optimize this later.
(xaccQueryAddSingleAccountMatch
sq
(gnc-account-lookup-by-full-name old-root
@ -112,7 +129,7 @@
(xaccSplitGetAccount split)))
QOF-QUERY-AND)
;; We want the value of the split in the new tree
;; Require the value of the split in the new tree
;; to match the the value of the split in the old
;; tree. We should really check for fuzziness.
(xaccQueryAddValueMatch sq
@ -122,9 +139,9 @@
QOF-QUERY-AND)
;; Now merge into the split query. Reminder: q-splits
;; is set up to match any split that matches any split
;; in the new transaction; every split in an old
;; transaction must pass that filter.
;; must be merged with an OR. Otherwise, nothing will
;; match. (For example, something can be equal to 4 or
;; to -4, but not both.)
(let ((q-new (qof-query-merge q-splits
sq
QOF-QUERY-OR)))
@ -133,8 +150,8 @@
(set! q-splits q-new))))
(xaccTransGetSplitList xtn))
;; Now q-splits will match any split that is the same as one
;; split in the old-root transaction. Merge it in.
;; Now q-splits will find every split that is the same as
;; any one split of the new-root transaction. Merge it in.
(let ((q-new (qof-query-merge query
q-splits
QOF-QUERY-AND)))
@ -142,16 +159,34 @@
(qof-query-destroy q-splits)
(set! query q-new)))
;; Now that we have built a query, get transactions in the old
;; account tree that match it.
(let ((old-xtns (xaccQueryGetTransactions query
QUERY-TXN-MATCH-ALL)))
;; Now that we have built a query that finds matching splits
;; in the old tree, run it and build a list of transactions
;; from the results.
;;
;; If the transaction from the new tree has more than two
;; splits, then we'll assume that it fully reflects what
;; occurred, and only consider transactions in the old tree
;; that match with every single split.
;;
;; All other new transactions could be incomplete, so we'll
;; consider transactions from the old tree to be possible
;; duplicates even if only one split matches.
;;
;; For more information, see bug 481528.
(let ((old-xtns (xaccQueryGetTransactions
query
(if (> num-splits 2)
QUERY-TXN-MATCH-ALL
QUERY-TXN-MATCH-ANY))))
;; Turn the resulting list of possibly duplicated
;; transactions into an association list.
(set! old-xtns (map
(lambda (elt)
(cons elt #f)) old-xtns))
;; If anything matched the query, push it onto the matches
;; list along with the transaction.
;; If anything matched the query, add it to our "matches"
;; association list, keyed by the new-root transaction.
(if (not (null? old-xtns))
(set! matches (cons (cons xtn old-xtns) matches))))
@ -169,6 +204,17 @@
;; tree, duplicate checking is unnecessary. Return an empty list.
'())))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:prune-matching-transactions
;;
;; The parameter, match-list, is an association list of the form
;; returned by gnc:account-tree-find-duplicates. This procedure
;; looks through the list and discards any transaction that has
;; been definitively determined to be a duplicate of one of the
;; possible matches.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:prune-matching-transactions match-list)
(for-each
(lambda (match)
@ -187,6 +233,14 @@
(xaccTransCommitEdit new-xtn)))))
match-list))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gnc:account-tree-catenate-and-merge
;;
;; The procedure moves the entire contents of one account tree,
;; new-root, to a second account tree, old-root, and merges any
;; duplicated accounts.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:account-tree-catenate-and-merge old-root new-root)
;; stuff the new accounts into the old account tree and merge the accounts
(gnc-account-join-children old-root new-root)