r21696 - gnucash/branches/2.4 - [r21646] Remove src/import-export/qif-io-core
John Ralls
jralls at code.gnucash.org
Fri Dec 9 18:10:58 EST 2011
Author: jralls
Date: 2011-12-09 18:10:58 -0500 (Fri, 09 Dec 2011)
New Revision: 21696
Trac: http://svn.gnucash.org/trac/changeset/21696
Removed:
gnucash/branches/2.4/src/import-export/qif-io-core/Makefile.am
gnucash/branches/2.4/src/import-export/qif-io-core/README
gnucash/branches/2.4/src/import-export/qif-io-core/gncmod-qifiocore.c
gnucash/branches/2.4/src/import-export/qif-io-core/qif-acct-table.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-bank-xtn-import.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-file.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-format-check.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-invst-xtn-import.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-io-core.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-objects.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-parse.scm
gnucash/branches/2.4/src/import-export/qif-io-core/qif-record-xform.scm
gnucash/branches/2.4/src/import-export/qif-io-core/test/Makefile.am
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/category-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-format-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/file-formats-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/import-phase-1-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-format-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/data/reader-data.txt
gnucash/branches/2.4/src/import-export/qif-io-core/test/dump-qifobj.scm
gnucash/branches/2.4/src/import-export/qif-io-core/test/qiftest.gnc
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats.scm
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1.scm
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module.scm
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser.scm
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader
gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader.scm
Modified:
gnucash/branches/2.4/configure.ac
Log:
[r21646] Remove src/import-export/qif-io-core
This directory was created 10 years ago to hold a rewritten qif
importer. It was never substantively worked on after.
Modified: gnucash/branches/2.4/configure.ac
===================================================================
--- gnucash/branches/2.4/configure.ac 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/configure.ac 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1376,8 +1376,6 @@
src/import-export/qif/test/Makefile
src/import-export/qif-import/schemas/Makefile
src/import-export/qif-import/test/Makefile
- src/import-export/qif-io-core/Makefile
- src/import-export/qif-io-core/test/Makefile
src/import-export/schemas/Makefile
src/import-export/ofx/Makefile
src/import-export/ofx/test/Makefile
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/Makefile.am
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/Makefile.am 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/Makefile.am 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,51 +0,0 @@
-SUBDIRS = . test
-
-pkglib_LTLIBRARIES = libgncmod-qifiocore.la
-
-AM_CPPFLAGS = -I${top_srcdir}/src/gnc-module ${GUILE_INCS} ${GLIB_CFLAGS}
-
-libgncmod_qifiocore_la_SOURCES = gncmod-qifiocore.c
-
-noinst_DATA = .scm-links
-
-gncscmdir = ${GNC_SHAREDIR}/scm
-gncscm_DATA = \
- qif-acct-table.scm \
- qif-bank-xtn-import.scm \
- qif-file.scm \
- qif-format-check.scm \
- qif-invst-xtn-import.scm \
- qif-objects.scm \
- qif-parse.scm \
- qif-record-xform.scm
-
-if GNUCASH_SEPARATE_BUILDDIR
-SCM_FILE_LINKS = \
- ${gncscm_DATA}
-endif
-
-.scm-links:
- $(RM) -rf gnucash
- mkdir -p gnucash
- mkdir -p gnucash/import-export
-if GNUCASH_SEPARATE_BUILDDIR
- for X in ${SCM_FILE_LINKS} ; do \
- $(LN_S) -f ${srcdir}/$$X . ; \
- done
-endif
- ( cd gnucash/import-export; for A in $(gncscmmod_DATA) ; do $(LN_S) -f ../../$$A . ; done )
-if ! OS_WIN32
-# Windows knows no "ln -s" but uses "cp": must copy every time (see bug #566567).
- touch .scm-links
-endif
-
-gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/import-export/
-gncscmmod_DATA = qif-io-core.scm
-
-clean-local:
- $(RM) -rf qif-import
-
-CLEANFILES = .scm-links
-DISTCLEANFILES = ${SCM_FILE_LINKS}
-
-INCLUDES = -DG_LOG_DOMAIN=\"gnc.import.qif.core\"
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/README
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/README 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/README 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,57 +0,0 @@
-qif-io-core module: top-level docs
-----------------------------------
-
-The file:
-
-A QIF file is a line-oriented text file. A file consists of a series
-of objects; each object is either a "bang switch" or a "record".
-
-A bang switch is a single line starting with the "!" character.
-
-A record is a set of newline-delimited tag-value pairs, terminated by
-a line starting with "^". The tag is the first character of the line,
-the value is the remainder of the line.
-
-There are several different types of records: bank transactions,
-investment transactions, accounts, classes, categories, securities are
-handled by this module. Currently unhandled are memorized
-transactions and prices.
-
-Tests for reading and writing various kinds of records from sample
-QIF files are in test/test-readwrite.scm.
-
-Interpreting the file:
-
-We read each "record" and convert it to a Scheme structure depending
-on the record type. Type is determined by "bang switches" indicating
-that the following records are of a certain type.
-
-qif-io:read-file reads records and converts them into the appropriate
-Scheme data structure. All values are strings.
-
-current scheme (with qif-import module):
- - translate strings to gnucash data types. transform transactions to
- make them look more like they will look in gnucash (account types,
- balance signs, etc)
- - build the map of gnucash accounts and commodities
- - eliminate duplicate transactions within the qif files
- - translate to gnucash transactions
- - eliminate duplicates within the gnucash files
-
-new plan:
- - scan strings in transactions to make sure we know how to interpret
- them
- - build the map of gnucash accounts and commodities
- - go to gnc transactions
- - find matches within the gnc transaction set and eliminate them
- automatically
- - find matches between the new set and the existing one
-
-i.e. in the new scheme we do as little interpretation and editing as
-possible in the qif realm. we translate to gnc transactions as early
-as possible and work in that domain. If nothing else it will be
-faster. It's also clearer because you know the QIF data structure
-never contains anything except uninterpreted strings from the QIF
-file. with the qif-import module you're never sure what's in those
-slots.
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/gncmod-qifiocore.c
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/gncmod-qifiocore.c 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/gncmod-qifiocore.c 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,66 +0,0 @@
-/*********************************************************************
- * gnc-mod-qifiocore.c
- * module definition/initialization for the QIF i/o module
- *
- * Copyright (c) 2001 Linux Developers Group, Inc.
- *********************************************************************/
-
-#include <gmodule.h>
-#include <libguile.h>
-
-#include "gnc-module.h"
-#include "gnc-module-api.h"
-
-GNC_MODULE_API_DECL(libgncmod_qifiocore)
-
-/* version of the gnc module system interface we require */
-int libgncmod_qifiocore_gnc_module_system_interface = 0;
-
-/* module versioning uses libtool semantics. */
-int libgncmod_qifiocore_gnc_module_current = 0;
-int libgncmod_qifiocore_gnc_module_revision = 0;
-int libgncmod_qifiocore_gnc_module_age = 0;
-
-
-char *
-libgncmod_qifiocore_gnc_module_path(void)
-{
- return g_strdup("gnucash/qif-io/core");
-}
-
-char *
-libgncmod_qifiocore_gnc_module_description(void)
-{
- return g_strdup("Core components of QIF import/export (non-GUI)");
-}
-
-int
-libgncmod_qifiocore_gnc_module_init(int refcount)
-{
- /* load the engine (we depend on it) */
- if (!gnc_module_load("gnucash/engine", 0))
- {
- return FALSE;
- }
-
- /* load the engine (we depend on it) */
- if (!gnc_module_load("gnucash/app-utils", 0))
- {
- return FALSE;
- }
-
- /* load the QIF Scheme code */
- if (scm_c_eval_string("(use-modules (gnucash import-export qif-io-core))") ==
- SCM_BOOL_F)
- {
- return FALSE;
- }
-
- return TRUE;
-}
-
-int
-libgncmod_qifiocore_gnc_module_end(int refcount)
-{
- return TRUE;
-}
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-acct-table.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-acct-table.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-acct-table.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,126 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-acct-table.scm
-;;; handle tables of qif-to-gnucash account mappings
-;;;
-;;; Copyright (c) 2001 Linux Developers Group, Inc.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:acct-table-lookup
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:acct-table-lookup table name type)
- (case type
- ((account)
- (hash-ref (qif-io:acct-table-accounts table) name))
- ((category)
- (hash-ref (qif-io:acct-table-categories table) name))
- ((security)
- (hash-ref (qif-io:acct-table-securities table) name))
- ((brokerage)
- (hash-ref (qif-io:acct-table-brokerage-accts table) name))
- (else
- (throw 'qif-io:unknown-acct-type type))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:acct-table-insert!
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:acct-table-insert! table name type gnc-acct)
- (case type
- ((account)
- (hash-set! (qif-io:acct-table-accounts table) name gnc-acct))
- ((category)
- (hash-set! (qif-io:acct-table-categories table) name gnc-acct))
- ((security)
- (hash-set! (qif-io:acct-table-securities table) name gnc-acct))
- ((brokerage)
- (hash-set! (qif-io:acct-table-brokerage-accts table) name gnc-acct))
- (else
- (throw 'qif-io:unknown-acct-type 'qif-io:acct-table-insert! type))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:acct-table-make-gnc-acct-tree
-;; fill in information for the gnucash accounts and organize them
-;; in a group tree
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:acct-table-make-gnc-acct-tree acct-table qif-file commodity)
- (let ((root (xaccMallocAccount (gnc-get-current-book))))
- ;; poke through the qif-file accounts to see if any of them
- ;; show up in the data
- (let ((qif-acct-table (qif-io:acct-table-accounts acct-table)))
- (for-each
- (lambda (qif-acct)
- (let* ((name (qif-io:account-name qif-acct))
- (type (qif-io:account-type qif-acct))
- (desc (qif-io:account-description qif-acct))
- (gnc-acct (hash-ref qif-acct-table name)))
- (if (and gnc-acct (not (null? gnc-acct)))
- (let ((gnc-type (qif-io:parse-acct-type type)))
- (xaccAccountBeginEdit gnc-acct)
- (if gnc-type
- (xaccAccountSetType gnc-acct gnc-type)
- (xaccAccountSetType gnc-acct GNC-BANK-TYPE))
- (if desc
- (xaccAccountSetDescription gnc-acct desc))
- (xaccAccountCommitEdit gnc-acct)))))
- (qif-io:file-accounts qif-file))
-
- (hash-fold
- (lambda (name acct p)
- (let ((cmdty (xaccAccountGetCommodity acct)))
- (if (null? cmdty)
- (begin
- (xaccAccountBeginEdit acct)
- (xaccAccountSetCommodity acct commodity)
- (xaccAccountCommitEdit acct))))
- (let ((type (xaccAccountGetType acct)))
- (if (= type -1)
- (xaccAccountSetType acct GNC-BANK-TYPE)))
- (gnc-account-append-child root acct)
- #t) #t (qif-io:acct-table-accounts acct-table)))
-
- ;; now the categories
- (let ((qif-cat-table (qif-io:acct-table-categories acct-table)))
- ;; poke through the qif-file accounts to see if any of them
- ;; show up in the data
- (for-each
- (lambda (qif-cat)
- (let* ((name (qif-io:category-name qif-cat))
- (income? (qif-io:category-income-cat qif-cat))
- (desc (qif-io:category-description qif-cat))
- (gnc-acct (hash-ref qif-cat-table name)))
- (if (and gnc-acct (not (null? gnc-acct)))
- (begin
- (xaccAccountBeginEdit gnc-acct)
- (cond (income?
- (xaccAccountSetType gnc-acct GNC-INCOME-TYPE))
- (#t
- (xaccAccountSetType gnc-acct GNC-EXPENSE-TYPE)))
- (xaccAccountSetDescription gnc-acct desc)
- (xaccAccountCommitEdit gnc-acct)))))
- (qif-io:file-categories qif-file))
-
- (hash-fold
- (lambda (name acct p)
- (let ((cmdty (xaccAccountGetCommodity acct)))
- (if (null? cmdty)
- (begin
- (xaccAccountBeginEdit acct)
- (xaccAccountSetCommodity acct commodity)
- (xaccAccountCommitEdit acct))))
- (let ((type (xaccAccountGetType acct)))
- (if (= type -1)
- (xaccAccountSetType acct GNC-EXPENSE-TYPE)))
- (gnc-account-append-child root acct)
- #t) #t (qif-io:acct-table-categories acct-table)))
-
- ;; the securities
-
- ;; the other brokerage-related accounts
-
- root))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-bank-xtn-import.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-bank-xtn-import.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-bank-xtn-import.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,146 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-bank-xtn-import.scm
-;;; routines for converting a QIF bank-type transaction to a gnc
-;;; transaction
-;;;
-;;; Copyright (c) 2001 Linux Developers Group, Inc.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:bank-xtn-opening-bal-acct
-;; if this is an "opening balance" transaction, return the
-;; account name from the transfer field
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:bank-xtn-opening-bal-acct qif-xtn)
- (let ((payee (qif-io:bank-xtn-payee qif-xtn)))
- (if (and (string? payee)
- (string-ci=? payee "Opening Balance"))
- (let ((category (qif-io:bank-xtn-category qif-xtn)))
- (if (string? category)
- (let ((parsed-cat (qif-io:parse-category category)))
- (if (list-ref parsed-cat 1)
- (car parsed-cat)
- #f))
- #f))
- #f)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:bank-xtn-import
-;; translate a single bank transaction into a GNC transaction
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:bank-xtn-import qif-xtn qif-file gnc-acct-info commodity)
- (let* ((format-info
- (qif-io:file-bank-xtn-format qif-file))
- (gnc-xtn (xaccMallocTransaction (gnc-get-current-book)))
- (near-split-amt
- ;; the u-amount has a larger range and is more correct,
- ;; but is optional
- (let ((uamt (qif-io:bank-xtn-u-amount qif-xtn)))
- (if uamt
- (qif-io:parse-number/format
- uamt (qif-io:bank-xtn-u-amount format-info))
- (qif-io:parse-number/format
- (qif-io:bank-xtn-t-amount qif-xtn)
- (qif-io:bank-xtn-t-amount format-info))))))
-
- ;; utility to make a new split and add it both to an
- ;; account and to the transaction
- (define (add-split acct-info amount memo reconcile)
- (let* ((acct-name (car acct-info))
- (acct-type (cdr acct-info))
- (acct (qif-io:acct-table-lookup
- gnc-acct-info acct-name acct-type))
- (split (xaccMallocSplit (gnc-get-current-book))))
- ;; make the account if necessary
- (if (or (not acct) (null? acct))
- (begin
- (set! acct (xaccMallocAccount (gnc-get-current-book)))
- (xaccAccountBeginEdit acct)
- (xaccAccountSetName acct acct-name)
- (xaccAccountCommitEdit acct)
- (qif-io:acct-table-insert! gnc-acct-info
- acct-name acct-type acct)))
- ;; fill in the split
- (xaccSplitSetAmount split amount)
- (xaccSplitSetValue split amount)
- (xaccSplitSetMemo split memo)
- (xaccSplitSetReconcile split reconcile)
-
- ;; add it to the account and the transaction
- (xaccAccountBeginEdit acct)
- (xaccSplitSetAccount split acct)
- (xaccAccountCommitEdit acct)
- (xaccSplitSetParent split gnc-xtn)
- split))
-
- (xaccTransBeginEdit gnc-xtn)
- (xaccTransSetCurrency gnc-xtn commodity)
-
- ;; set the transaction date, number and description
- (let ((date (qif-io:parse-date/format
- (qif-io:bank-xtn-date qif-xtn)
- (qif-io:bank-xtn-date format-info))))
- (apply xaccTransSetDate gnc-xtn date))
-
- (xaccTransSetNum gnc-xtn (qif-io:bank-xtn-number qif-xtn))
- (xaccTransSetDescription gnc-xtn (qif-io:bank-xtn-payee qif-xtn))
-
- ;; create the near split (the one that goes to the source-acct)
- (let* ((near-acct-name (qif-io:bank-xtn-source-acct qif-xtn)))
- (if (not near-acct-name)
- (set! near-acct-name (qif-io:file-default-src-acct qif-file)))
- (add-split (cons near-acct-name 'account) near-split-amt
- (qif-io:bank-xtn-memo qif-xtn)
- (qif-io:parse-cleared-field
- (qif-io:bank-xtn-cleared qif-xtn))))
-
- ;; create any far splits. If no "S" splits were specified,
- ;; make a magic mirroring split.
- (let ((qif-splits (qif-io:bank-xtn-splits qif-xtn)))
- (if (or (not (list? qif-splits)) (null? qif-splits))
- ;; common case: no splits are specified. Make one with the
- ;; appropriate category and an amount that's the opposite of
- ;; the near-split amount. Reuse the memo.
- (let* ((category (qif-io:bank-xtn-category qif-xtn))
- (parsed-cat
- (if category (qif-io:parse-category category) #f))
- (acct-name
- (if parsed-cat (list-ref parsed-cat 0) #f))
- (acct-is-acct
- (if parsed-cat (list-ref parsed-cat 1) #f)))
- (add-split (cons acct-name
- (if acct-is-acct 'account 'category))
- (gnc-numeric-neg near-split-amt)
- (qif-io:bank-xtn-memo qif-xtn) #\n))
-
- ;; split case: iterate over a list of qif splits and make a
- ;; separate far-end split for each.
- (let ((amt-format
- (qif-io:split-amount
- (car (qif-io:bank-xtn-splits format-info)))))
- (for-each
- (lambda (split)
- (let* ((category (qif-io:split-category split))
- (parsed-cat
- (if category (qif-io:parse-category category) #f))
- (acct-name
- (if parsed-cat (list-ref parsed-cat 0) #f))
- (acct-is-acct
- (if parsed-cat (list-ref parsed-cat 1) #f))
- (amount
- (qif-io:parse-number/format
- (qif-io:split-amount split) amt-format)))
- (add-split (cons acct-name
- (if acct-is-acct 'account 'category))
- (gnc-numeric-neg amount)
- (qif-io:split-memo split) #\n)))
- qif-splits))))
-
- ;; we're done.
- (xaccTransCommitEdit gnc-xtn)
- gnc-xtn))
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-file.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-file.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-file.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,401 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-file.scm
-;;; read a QIF file into a <qif-file> object
-;;;
-;;; Copyright (c) 2001 Linux Developers Group
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(debug-enable 'debug)
-(debug-enable 'backtrace)
-
-(define end-of-line (string #\cr #\nl))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:read-record
-;; this reads a "record", which is a block of tag-value lines ended
-;; by a line starting with "^". A line starting with "!" generates
-;; an exception.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:read-record port)
- (if (not (input-port? port))
- (throw 'qif-io:arg-type 'input-port port))
-
- (let ((byte-count 0)
- (eof? #f)
- (record '()))
- (let line-loop ((line (read-delimited end-of-line port)))
- (if (and (string? line)
- (not (string=? line "")))
- (let ((tag (string-ref line 0))
- (value (substring line 1)))
- (set! byte-count (+ (string-length line) byte-count))
- (case tag
- ((#\^) #t)
- ((#\!)
- (throw 'qif-io:parser-state value))
- (else
- (set! record (cons (cons tag value) record))
- (line-loop (read-delimited end-of-line port)))))
- (if (eof-object? line)
- (set! eof? #t)
- (if (not (string? line))
- (throw 'qif-io:record-error 'qif-io:read-record line)
- (line-loop (read-delimited end-of-line port))))))
- (list (reverse record) byte-count eof?)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:write-record pairs port
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:write-record record-pairs port)
- (if (not (list? record-pairs))
- (throw 'qif-io:arg-type 'list record-pairs))
- (if (not (output-port? port))
- (throw 'qif-io:arg-type 'output-port port))
- (for-each
- (lambda (kvp)
- (format port "~A~A\n" (car kvp) (cdr kvp)))
- record-pairs)
- (format port "^\n"))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:read-file path
-;; suck in all the transactions; don't do any string interpretation,
-;; just store the fields "raw".
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:read-file file-obj path progress-thunk)
- (define (string-prune arg)
- (string-remove-trailing-space arg))
-
- (if (not (string? path))
- (throw 'qif-io:arg-type 'string path))
-
- (let* ((port
- (catch #t
- (lambda ()
- (open-input-file path))
- (lambda (tag . args)
- (throw 'qif-io:file-error path))))
- (file-stats (stat path))
- (file-size (stat:size file-stats))
- (bytes-read 0)
- (exception #f)
- (record #f)
- (record-info #f)
- (record-type #f)
- (bank-xtns '())
- (invst-xtns '())
- (accounts '())
- (classes '())
- (categories '())
- (securities '())
- (autoswitch #t)
- (autoswitch-acct #f)
- (opening-bal-acct #f)
- (some-bank-need-src-acct #f)
- (some-invst-need-src-acct #f))
- (let record-loop ()
- (catch #t
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; record processor
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (lambda ()
- ;; read the record
- (set! record-info (qif-io:read-record port))
- (set! record (car record-info))
- (set! bytes-read (+ bytes-read (cadr record-info)))
- (if (procedure? progress-thunk)
- (progress-thunk bytes-read file-size))
-
- ;; convert it to the relevant struct
- (if (not (null? record))
- (case record-type
- ;; bank transactions
- ((bank-xtn)
- (let ((xtn (qif-io:record->bank-xtn record)))
- (if autoswitch-acct
- (qif-io:bank-xtn-set-source-acct!
- xtn autoswitch-acct)
- ;; the Opening Balance transaction is special.
- ;; if there's no autoswitch account set, the OB
- ;; will set it. But beware because it doesn't
- ;; have to be the first xtn.
- (let ((obacct
- (qif-io:bank-xtn-opening-bal-acct xtn)))
- (if obacct
- (begin
- (qif-io:bank-xtn-set-source-acct!
- xtn obacct)
- (set! autoswitch-acct obacct)
- (set! opening-bal-acct obacct))
- (set! some-bank-need-src-acct #t))))
- (set! bank-xtns (cons xtn bank-xtns))))
-
- ;; investment transactions
- ((invst-xtn)
- (let ((xtn (qif-io:record->invst-xtn record)))
- (if autoswitch-acct
- (qif-io:invst-xtn-set-source-acct!
- xtn autoswitch-acct)
- (set! some-invst-need-src-acct #t))
- (set! invst-xtns (cons xtn invst-xtns))))
-
- ;; account records
- ((account)
- (let ((account (qif-io:record->account record)))
- (if autoswitch
- (set! autoswitch-acct
- (qif-io:account-name account))
- (set! accounts (cons account accounts)))))
-
- ;; class records
- ((class)
- (set! classes
- (cons (qif-io:record->class record)
- classes)))
-
- ;; category records
- ((category)
- (set! categories
- (cons (qif-io:record->category record)
- categories)))
-
- ;; anything we don't know about
- ((unknown) #t)
- (else
- (throw 'qif-io:format-error path record-type)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; record exception handler
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (lambda (key . args)
- (set! exception #t)
- (case key
- ;; when the parser sees a ! line, it throws this
- ;; exception
- ((qif-io:parser-state)
- (let ((new-state (string-prune (car args))))
- (cond ((or (string-ci=? new-state "type:bank")
- (string-ci=? new-state "type:cash")
- (string-ci=? new-state "type:ccard")
- (string-ci=? new-state "type:oth a")
- (string-ci=? new-state "type:oth l"))
- (set! record-type 'bank-xtn))
- ((or (string-ci=? new-state "type:invst")
- (string-ci=? new-state "type:port"))
- (set! record-type 'invst-xtn))
- ((string-ci=? new-state "account")
- (set! record-type 'account))
- ((string-ci=? new-state "type:class")
- (set! record-type 'class))
- ((string-ci=? new-state "type:cat")
- (set! record-type 'category))
- ((string-ci=? new-state "type:security")
- (set! record-type 'security))
- ((string-ci=? new-state "option:autoswitch")
- (set! autoswitch #f))
- ((string-ci=? new-state "clear:autoswitch")
- (set! autoswitch #t))
- (#t
- (set! record-type 'unknown)))))
- ((qif-io:record-error)
- (format #t "record processing error ~S\n" args))
- (else
- (apply throw key args)))))
-
- ;; third element of record-info tells whether an eof was
- ;; encountered
- (if (or exception (and (list? record-info) (not (caddr record-info))))
- (begin
- (set! exception #f)
- (record-loop))))
-
- ;; if any bank transactions don't have a source account, we need
- ;; to set it for them (if we found an Opening Balance record) or
- ;; set a flag in the file struct so that we can ask the user.
-
- (if some-bank-need-src-acct
- (if opening-bal-acct
- (begin
- (for-each
- (lambda (xtn)
- (if (not (qif-io:bank-xtn-src-acct xtn))
- (qif-io:bank-xtn-set-src-acct! xtn opening-bal-acct)))
- bank-xtns)
- (set! some-bank-need-src-acct #f))))
- (if (or some-bank-need-src-acct some-invst-need-src-acct)
- (qif-io:file-set-xtns-need-acct?! file-obj #t))
-
- ;; done reading all the records. fill in the qif-file object.
- (qif-io:file-set-bank-xtns! file-obj (reverse bank-xtns))
- (qif-io:file-set-invst-xtns! file-obj (reverse invst-xtns))
- (qif-io:file-set-accounts! file-obj (reverse accounts))
- (qif-io:file-set-categories! file-obj (reverse categories))
- (qif-io:file-set-classes! file-obj (reverse classes))
- (qif-io:file-set-securities! file-obj (reverse securities))
- #t))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:write-file file-obj path
-;; write a <qif-file> out. all objects must have fields in
-;; string form.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:write-file qif-obj path)
- (if (not (string? path))
- (throw 'qif-io:arg-type 'string path))
- (if (not (qif-io:file? qif-obj))
- (throw 'qif-io:arg-type 'qif-io:file qif-obj))
-
- (let ((port (open-output-file path))
- (accts (qif-io:file-accounts qif-obj))
- (cats (qif-io:file-categories qif-obj))
- (classes (qif-io:file-classes qif-obj))
- (bank-xtns (qif-io:file-bank-xtns qif-obj))
- (invst-xtns (qif-io:file-invst-xtns qif-obj)))
-
- ;; write out the list of "classes" (user tags on transactions...
- ;; these will be dummies since Gnucash doesn't do tags the same
- ;; way)
- (if (not (null? classes))
- (begin
- (format port "!Type:Class\n")
- (for-each
- (lambda (class)
- (qif-io:write-record (qif-io:class->record class) port))
- classes)))
-
- ;; write out the list of "categories" (income and expense
- ;; accounts)
- (if (not (null? cats))
- (begin
- (format port "!Type:Cat\n")
- (for-each
- (lambda (cat)
- (qif-io:write-record (qif-io:category->record cat) port))
- cats)))
-
- ;; write out the list of "accounts" (asset and liability
- ;; accounts)
- (if (not (null? accts))
- (begin
- (format port "!Option:Autoswitch\n")
- (format port "!Account\n")
- (for-each
- (lambda (acct)
- (qif-io:write-record (qif-io:account->record acct) port))
- accts)
- (format port "!Clear:Autoswitch\n")))
-
- ;; write out bank transactions. Make sure to preface each
- ;; section with the source-account record.
- (if (not (null? bank-xtns))
- (let ((this-acct '())
- (not-this-acct '()))
- ;; first write out all the transactions that don't have
- ;; a source-acct string
- (for-each
- (lambda (xtn)
- (if (not (string? (qif-io:bank-xtn-source-acct xtn)))
- (set! this-acct (cons xtn this-acct))
- (set! not-this-acct (cons xtn not-this-acct))))
- bank-xtns)
- (if (not (null? this-acct))
- (begin
- (format port "!Type:Bank\n")
- (for-each
- (lambda (xtn)
- (qif-io:write-record (qif-io:bank-xtn->record xtn) port))
- this-acct)))
- (set! bank-xtns (reverse not-this-acct))
- (set! this-acct '())
- (set! not-this-acct '())
-
- ;; iterate over accounts, writing out all the bank xtns
- ;; that are in that account
- (for-each
- (lambda (acct)
- (for-each
- (lambda (xtn)
- (if (and (string? (qif-io:bank-xtn-source-acct xtn))
- (string=? (qif-io:account-name acct)
- (qif-io:bank-xtn-source-acct xtn)))
- (set! this-acct (cons xtn this-acct))
- (set! not-this-acct (cons xtn not-this-acct))))
- bank-xtns)
- (if (not (null? this-acct))
- (begin
- (format port "!Account\n")
- (qif-io:write-record (qif-io:account->record acct) port)
- (format port "!Type:~A\n"
- (qif-io:account-type acct))
- (set! this-acct (reverse this-acct))
- (for-each
- (lambda (xtn)
- (qif-io:write-record (qif-io:bank-xtn->record xtn)
- port))
- this-acct)))
- (set! bank-xtns (reverse not-this-acct))
- (set! this-acct '())
- (set! not-this-acct '()))
- accts)))
-
- ;; write out invst transactions. Make sure to preface each
- ;; section with the source-account record.
- (if (not (null? invst-xtns))
- (let ((this-acct '())
- (not-this-acct '()))
- ;; first write out all the transactions that don't have
- ;; a source-acct string
- (for-each
- (lambda (xtn)
- (if (not (string? (qif-io:invst-xtn-source-acct xtn)))
- (set! this-acct (cons xtn this-acct))
- (set! not-this-acct (cons xtn not-this-acct))))
- invst-xtns)
- (if (not (null? this-acct))
- (begin
- (format port "!Type:Invst\n")
- (for-each
- (lambda (xtn)
- (qif-io:write-record (qif-io:invst-xtn->record xtn) port))
- this-acct)))
- (set! invst-xtns (reverse not-this-acct))
- (set! this-acct '())
- (set! not-this-acct '())
-
- ;; iterate over accounts, writing out all the invst xtns
- ;; that are in that account
- (for-each
- (lambda (acct)
- (for-each
- (lambda (xtn)
- (if (and (string? (qif-io:invst-xtn-source-acct xtn))
- (string=? (qif-io:account-name acct)
- (qif-io:invst-xtn-source-acct xtn)))
- (set! this-acct (cons xtn this-acct))
- (set! not-this-acct (cons xtn not-this-acct))))
- invst-xtns)
- (if (not (null? this-acct))
- (begin
- (format port "!Account\n")
- (qif-io:write-record (qif-io:account->record acct) port)
- (format port "!Type:~A\n"
- (qif-io:account-type acct))
- (set! this-acct (reverse this-acct))
- (for-each
- (lambda (xtn)
- (qif-io:write-record (qif-io:invst-xtn->record xtn)
- port))
- this-acct)))
- (set! invst-xtns (reverse not-this-acct))
- (set! this-acct '())
- (set! not-this-acct '()))
- accts)))
- (close-output-port port)))
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-format-check.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-format-check.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-format-check.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,230 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-format-check.scm
-;;; scan a set of QIF data records to try to guess how to
-;;; interpret number and date fields
-;;;
-;;; Copyright (c) 2001 Linux Developers Group
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:file-setup-data-formats file
-;;
-;; we try to find a unique data format for all the relevant fields.
-;; if that fails, we throw an exception with a continuation proc that
-;; allows us to resume work.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:setup-data-formats file)
- ;; first: narrow down the possible field formats
- (qif-io:check-possible-formats file)
-
- ;; then: make sure there's exactly one format per slot.
- (let ((invst-format-info (qif-io:file-invst-xtn-format file))
- (invst-field-info
- (list (list qif-io:invst-xtn-date
- qif-io:invst-xtn-set-date! "Date" 'date)
- (list qif-io:invst-xtn-t-amount
- qif-io:invst-xtn-set-t-amount! "Total" 'amount)
- (list qif-io:invst-xtn-u-amount
- qif-io:invst-xtn-set-u-amount! "UTotal" 'amount)
- (list qif-io:invst-xtn-$-amount
- qif-io:invst-xtn-set-$-amount! "$Total" 'amount)
- (list qif-io:invst-xtn-share-amount
- qif-io:invst-xtn-set-share-amount! "Num Shares" 'amount)
- (list qif-io:invst-xtn-share-price
- qif-io:invst-xtn-set-share-price! "Share Price" 'amount)
- (list qif-io:invst-xtn-commission
- qif-io:invst-xtn-set-commission! "Commission" 'amount)))
- (bank-format-info (qif-io:file-bank-xtn-format file))
- (bank-field-info
- (list (list qif-io:bank-xtn-date
- qif-io:bank-xtn-set-date! "Date" 'date)
- (list qif-io:bank-xtn-t-amount
- qif-io:bank-xtn-set-t-amount! "Total" 'amount)
- (list qif-io:bank-xtn-u-amount
- qif-io:bank-xtn-set-u-amount! "UTotal" 'amount)
- (list (lambda (format-xtn)
- (let ((splits (qif-io:bank-xtn-splits format-xtn)))
- (qif-io:split-amount (car splits))))
- (lambda (format-xtn format-obj)
- (let ((splits (qif-io:bank-xtn-splits format-xtn)))
- (qif-io:split-set-amount! (car splits) format-obj)))
- "Split total" 'amount))))
-
- ;; 'format-info' is some object. 'field-info' tells us how to get
- ;; and set its fields. next-proc tells us what to do when we
- ;; finish.
- (define (do-xtn-format format-info field-info next-proc)
- (let loop ((fields field-info))
- (let* ((this-field (car fields))
- (getter (car this-field))
- (setter (cadr this-field))
- (field-name (caddr this-field))
- (field-type (cadddr this-field))
- (formats (getter format-info)))
- (cond
- ((null? formats)
- (throw 'qif-io:inconsistent-data-format field-name))
- ((not (list? formats))
- (if (not (null? (cdr fields))) (loop (cdr fields))))
- ((null? (cdr formats))
- (setter format-info (car formats))
- (if (not (null? (cdr fields))) (loop (cdr fields))))
- (#t
- ;; if there are multiple possible formats, throw an
- ;; exception. the catcher should determine which of
- ;; 'formats' is correct and call the thunk with it as an
- ;; arg.
- (throw 'qif-io:ambiguous-data-format field-type field-name formats
- (lambda (correct-format)
- (setter format-info correct-format)
- (if (not (null? (cdr fields))) (loop (cdr fields)))
- (next-proc)))))))
- ;; we call next-proc here if there was no exception during the
- ;; normal loop execution.
- (next-proc))
-
- ;; do the work. We pass the investment format processing as a
- ;; continuation-proc so that it gets done no matter how we get out
- ;; of the loop in do-xtn-format
- (do-xtn-format
- bank-format-info bank-field-info
- (lambda ()
- (do-xtn-format
- invst-format-info invst-field-info
- (lambda () #t))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; check-field-formats
-;; this is is the engine that runs all the format tests on the qif
-;; transactions. we apply the 'checker' to the value returned by the
-;; 'getter' for each object. we successively narrow 'formats' as we
-;; go along. If there are no non-#f elements to check we return
-;; #f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (check-field-formats getter equiv-thunk checker formats objects)
- (let ((good-formats formats)
- (records-checked #f))
- ;; loop over objects. If the formats list ever gets empty
- ;; we can stop right there.
- (if (not (null? objects))
- (let loop ((current (car objects))
- (rest (cdr objects)))
- (let ((val (getter current)))
- (if val
- (begin
- (set! records-checked #t)
- (set! good-formats (checker val good-formats)))))
- (if (and (not (null? good-formats))
- (not (null? rest)))
- (loop (car rest) (cdr rest)))))
-
- ;; we're done. Return the formats that work for all the values.
- (if records-checked good-formats #f)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; check-possible-formats builds the file's format objects for
-;; investment and bank transactions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:check-possible-formats file)
- (let ((bank-formats (qif-io:make-empty-bank-xtn)))
- ;; bank transactions
- (qif-io:bank-xtn-set-date!
- bank-formats
- (check-field-formats
- qif-io:bank-xtn-date equal?
- qif-io:check-date-format '(m-d-y d-m-y y-m-d y-d-m)
- (qif-io:file-bank-xtns file)))
-
- (qif-io:bank-xtn-set-t-amount!
- bank-formats
- (check-field-formats
- qif-io:bank-xtn-t-amount gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-bank-xtns file)))
-
- (qif-io:bank-xtn-set-u-amount!
- bank-formats
- (check-field-formats
- qif-io:bank-xtn-u-amount gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-bank-xtns file)))
-
- (let ((split (qif-io:make-empty-split)))
- (define (get-split-amounts xtn)
- (map (lambda (split)
- (qif-io:split-amount split))
- (qif-io:bank-xtn-splits xtn)))
- (qif-io:split-set-amount!
- split
- (check-field-formats
- get-split-amounts gnc-numeric-equal
- qif-io:check-multi-number-format '(decimal comma)
- (qif-io:file-bank-xtns file)))
- (qif-io:bank-xtn-set-splits! bank-formats (list split)))
-
- ;; stuff the formats into the file
- (qif-io:file-set-bank-xtn-format! file bank-formats))
-
- (let ((invst-formats (qif-io:make-empty-invst-xtn)))
- ;; invst transactions
- (qif-io:invst-xtn-set-date!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-date equal?
- qif-io:check-date-format '(m-d-y d-m-y y-m-d y-d-m)
- (qif-io:file-invst-xtns file)))
-
- (qif-io:invst-xtn-set-t-amount!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-t-amount gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-invst-xtns file)))
-
- (qif-io:invst-xtn-set-u-amount!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-u-amount gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-invst-xtns file)))
-
- (qif-io:invst-xtn-set-$-amount!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-$-amount gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-invst-xtns file)))
-
- (qif-io:invst-xtn-set-share-amount!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-share-amount gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-invst-xtns file)))
-
- (qif-io:invst-xtn-set-share-price!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-share-price gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-invst-xtns file)))
-
- (qif-io:invst-xtn-set-commission!
- invst-formats
- (check-field-formats
- qif-io:invst-xtn-commission gnc-numeric-equal
- qif-io:check-number-format '(decimal comma)
- (qif-io:file-invst-xtns file)))
-
- ;; stuff the formats into the file
- (qif-io:file-set-invst-xtn-format! file invst-formats)))
-
-
-
-
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-invst-xtn-import.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-invst-xtn-import.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-invst-xtn-import.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,314 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-invst-xtn-import.scm
-;;; routines for converting a QIF investment transaction to a gnc
-;;; transaction
-;;;
-;;; Copyright (c) 2001 Linux Developers Group, Inc.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; account name generators. these are changeable by the user during
-;; the mapping phase but you have to start somewhere.
-
-(define (default-stock-acct brokerage security)
- (string-append brokerage ":" security))
-
-(define (default-dividend-acct brokerage security)
- (string-append (_ "Dividends") ":"
- brokerage ":"
- security))
-
-(define (default-interest-acct brokerage security)
- (string-append (_ "Interest") ":"
- brokerage ":"
- security))
-
-(define (default-capital-return-acct brokerage security)
- (string-append (_ "Cap Return") ":"
- brokerage ":"
- security))
-
-(define (default-cglong-acct brokerage security)
- (string-append (_ "Cap. gain (long)") ":"
- brokerage ":"
- security))
-
-(define (default-cgmid-acct brokerage security)
- (string-append (_ "Cap. gain (mid)") ":"
- brokerage ":"
- security))
-
-(define (default-cgshort-acct brokerage security)
- (string-append (_ "Cap. gain (short)") ":"
- brokerage ":"
- security))
-
-(define (default-equity-holding security) (_ "Retained Earnings"))
-
-(define (default-equity-account) (_ "Retained Earnings"))
-
-(define (default-commission-acct brokerage)
- (string-append (_ "Commissions") ":"
- brokerage))
-
-(define (default-margin-interest-acct brokerage)
- (string-append (_ "Margin Interest") ":"
- brokerage))
-
-(define (default-unspec-acct)
- (_ "Unspecified"))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (qif-io:invst-xtn-accounts-affected xtn)
-;; What accounts are affected by the transaction? it depends on
-;; the 'action' field.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:invst-xtn-accounts-affected xtn)
- (let* ((near-acct #f)
- (far-acct #f)
- (security (qif-io:invst-xtn-security xtn))
- (action (qif-io:parse-action-field (qif-io:invst-xtn-action xtn)))
- (from-acct (qif-io:invst-xtn-source-acct xtn))
- (category (qif-io:invst-xtn-category xtn))
- (parsed-cat
- (if category (qif-io:parse-category category)
- (list "" #f #f #f #f #f))))
-
- ;; the "near split", i.e. the split that would normally go to the
- ;; source account.
- (case action
- ((buy buyx sell sellx reinvint reinvdiv reinvsg reinvsh
- reinvlg reinvmd shrsin shrsout stksplit)
- (set! near-acct
- (cons (default-stock-acct from-acct security) 'security)))
- ((div cgshort cglong cgmid intinc miscinc miscexp
- rtrncap margint xin xout)
- (set! near-acct (cons from-acct 'account)))
- ((divx cgshortx cglongx cgmidx intincx rtrncapx margintx)
- (set! near-acct
- (cons (car parsed-cat)
- (if (list-ref parsed-cat 1) 'account 'category))))
- ((miscincx miscexpx)
- (set! near-acct
- (cons (list-ref parsed-cat 3)
- (if (list-ref parsed-cat 4) 'account 'category))))
- (else
- (throw 'qif-io:unhandled-action action)))
-
- ;; the far split: where is the money coming from? Either the
- ;; brokerage account, the category, or an external account
- (case action
- ((buy sell)
- (set! far-acct
- (cons from-acct 'account)))
- ((buyx sellx miscinc miscincx miscexp miscexpx xin xout)
- (set! far-acct
- (cons (list-ref parsed-cat 0)
- (if (list-ref parsed-cat 1) 'account 'category))))
- ((stksplit)
- (set! far-acct
- (cons (default-stock-acct from-acct security) 'security)))
- ((cgshort cgshortx reinvsg reinvsh)
- (set! far-acct
- (cons (default-cgshort-acct from-acct security) 'brokerage)))
- ((cglong cglongx reinvlg)
- (set! far-acct
- (cons (default-cglong-acct from-acct security) 'brokerage)))
- ((cgmid cgmidx reinvmd)
- (set! far-acct
- (cons (default-cgmid-acct from-acct security) 'brokerage)))
- ((intinc intincx reinvint)
- (set! far-acct
- (cons (default-interest-acct from-acct security) 'brokerage)))
- ((margint margintx)
- (set! far-acct
- (cons (default-margin-interest-acct from-acct) 'brokerage)))
- ((rtrncap rtrncapx)
- (set! far-acct
- (cons (default-capital-return-acct from-acct) 'brokerage)))
- ((div divx reinvdiv)
- (set! far-acct
- (cons (default-dividend-acct from-acct security) 'brokerage)))
- ((shrsin shrsout)
- (set! far-acct
- (cons (default-equity-holding security) 'account)))
- (else
- (throw 'qif-io:unhandled-action action)))
-
- (list near-acct far-acct (default-commission-acct from-acct))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:invst-xtn-import
-;; translate a single invst transaction into a GNC transaction
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:invst-xtn-import qif-xtn qif-file gnc-acct-info commodity)
- (let ((gnc-xtn (xaccMallocTransaction (gnc-get-current-book)))
- (format-info (qif-io:file-invst-xtn-format qif-file)))
- ;; utility to make a new split and add it both to an
- ;; account and to the transaction
- (define (add-split acct-info amount value memo reconcile)
- (let* ((acct-name (car acct-info))
- (acct-type (cdr acct-info))
- (acct (qif-io:acct-table-lookup
- gnc-acct-info acct-name acct-type))
- (split (xaccMallocSplit (gnc-get-current-book))))
- ;; make the account if necessary
- (if (or (not acct) (null? acct))
- (begin
- (set! acct (xaccMallocAccount (gnc-get-current-book)))
- (xaccAccountSetName acct acct-name)
- (qif-io:acct-table-insert! gnc-acct-info
- acct-name acct-type acct)))
- ;; fill in the split
- (xaccSplitSetAmount split amount)
- (xaccSplitSetValue split value)
- (xaccSplitSetMemo split memo)
- (xaccSplitSetReconcile split reconcile)
-
- ;; add it to the account and the transaction
- (xaccAccountBeginEdit acct)
- (xaccSplitSetAccount split acct)
- (xaccAccountCommitEdit acct)
- (xaccSplitSetParent split gnc-xtn)
- split))
-
- (define (lookup-balance acct-info)
- (let ((acct (qif-io:acct-table-lookup gnc-acct-info
- (car acct-info) (cdr acct-info))))
- (xaccAccountGetBalance acct)))
-
- (if (not (qif-io:invst-xtn-source-acct qif-xtn))
- (qif-io:invst-xtn-set-source-acct!
- qif-xtn (qif-io:file-default-src-acct qif-file)))
-
- (xaccTransBeginEdit gnc-xtn)
- (xaccTransSetCurrency gnc-xtn commodity)
-
- ;; set the transaction date, number and description
- (let ((date (qif-io:parse-date/format
- (qif-io:invst-xtn-date qif-xtn)
- (qif-io:invst-xtn-date format-info))))
- (apply xaccTransSetDate gnc-xtn date))
-
- (xaccTransSetNum gnc-xtn (qif-io:invst-xtn-action qif-xtn))
- (xaccTransSetDescription gnc-xtn (qif-io:invst-xtn-payee qif-xtn))
-
- ;; get the relevant info, including 'near-acct' and 'far-acct',
- ;; the accounts affected by the transaction
- (let* ((action
- (qif-io:parse-action-field (qif-io:invst-xtn-action qif-xtn)))
- (num-shares
- (let ((val (qif-io:invst-xtn-share-amount qif-xtn)))
- (if val
- (qif-io:parse-number/format
- val (qif-io:invst-xtn-share-amount format-info))
- #f)))
- (share-price
- (let ((val (qif-io:invst-xtn-share-price qif-xtn)))
- (if val
- (qif-io:parse-number/format
- val (qif-io:invst-xtn-share-price format-info))
- #f)))
- (commission-val
- (let ((val (qif-io:invst-xtn-commission qif-xtn)))
- (if val
- (qif-io:parse-number/format
- val (qif-io:invst-xtn-commission format-info))
- #f)))
- (total-val
- (let ((uamt (qif-io:invst-xtn-u-amount qif-xtn))
- (tamt (qif-io:invst-xtn-t-amount qif-xtn))
- ($amt (qif-io:invst-xtn-$-amount qif-xtn)))
- (cond
- (uamt
- (qif-io:parse-number/format
- uamt (qif-io:invst-xtn-u-amount format-info)))
- (tamt
- (qif-io:parse-number/format
- tamt (qif-io:invst-xtn-t-amount format-info)))
- ($amt
- (qif-io:parse-number/format
- $amt (qif-io:invst-xtn-$-amount format-info)))
- (#t (gnc-numeric-zero)))))
- (action-val
- (if (and num-shares share-price)
- (gnc-numeric-mul num-shares share-price
- (gnc-numeric-denom total-val)
- GNC-RND-ROUND)
- (gnc-numeric-zero)))
- (cleared
- (qif-io:parse-cleared-field (qif-io:invst-xtn-cleared qif-xtn)))
- (payee (qif-io:invst-xtn-payee qif-xtn))
- (memo (qif-io:invst-xtn-memo qif-xtn))
- (accounts-affected
- (qif-io:invst-xtn-accounts-affected qif-xtn))
- (near-acct (car accounts-affected))
- (far-acct (cadr accounts-affected))
- (commission-acct
- (cons (default-commission-acct
- (qif-io:invst-xtn-source-acct qif-xtn)) 'brokerage))
- (n- (lambda (n) (gnc-numeric-neg n))))
-
- ;; now build the splits. We have to switch on the action
- ;; again to get the signs of the amounts, and whether we use the
- ;; monetary value or share count.
- (case action
- ((buy buyx reinvint reinvdiv reinvsg reinvsh reinvmd reinvlg)
- (add-split near-acct num-shares action-val memo cleared)
- (add-split far-acct (n- total-val) (n- total-val) memo cleared)
- (if commission-val
- (add-split commission-acct commission-val commission-val
- memo cleared)))
-
- ((sell sellx)
- (add-split near-acct (n- num-shares) (n- action-val) memo cleared)
- (add-split far-acct total-val total-val memo cleared)
- (if commission-val
- (add-split commission-acct commission-val commission-val
- memo cleared)))
-
- ;; fixme: can these have commissions?
- ((cgshort cgshortx cgmid cgmidx cglong cglongx intinc intincx
- div divx miscinc miscincx xin rtrncap rtrncapx)
- (add-split near-acct total-val total-val memo cleared)
- (add-split far-acct (n- total-val) (n- total-val) memo #\n))
-
- ;; fixme: can these have commissions?
- ((xout miscexp miscexpx margint margintx)
- (add-split near-acct (n- total-val) (n- total-val) memo cleared)
- (add-split far-acct total-val total-val memo #\n))
- ((shrsin)
- (add-split near-acct num-shares action-val memo cleared)
- (add-split far-acct (n- total-val) (n- total-val) memo cleared)
- (if commission-val
- (add-split commission-acct commission-val commission-val
- memo cleared)))
- ((shrsout)
- (add-split near-acct (n- num-shares) (n- action-val) memo cleared)
- (add-split far-acct total-val total-val memo cleared)
- (if commission-val
- (add-split commission-acct commission-val commission-val
- memo cleared)))
- ((stksplit)
- (let* ((splitratio (gnc-numeric-div
- num-shares (gnc-numeric-create 10 1)
- GNC-DENOM-AUTO GNC-DENOM-REDUCE))
- (in-shares (lookup-balance near-acct))
- (out-shares (n* in-shares splitratio)))
- (add-split near-acct out-shares (n- action-amt) memo cleared)
- (add-split far-acct in-shares action-amt memo cleared)))
- (else
- (throw 'qif-io:unhandled-action action))))
-
- (xaccTransCommitEdit gnc-xtn)
- gnc-xtn))
-
-
-
-
-
-
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-io-core.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-io-core.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-io-core.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,91 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io-core.scm
-;; top-level module for QIF i/o code
-;;
-;; Copyright (c) 2001 Linux Developers Group, Inc.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-module (gnucash import-export qif-io-core))
-(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
-(use-modules (ice-9 regex))
-(use-modules (gnucash gnc-module))
-
-(gnc:module-load "gnucash/engine" 0)
-(gnc:module-load "gnucash/app-utils" 0)
-
-(load-from-path "qif-parse.scm")
-(load-from-path "qif-format-check.scm")
-(load-from-path "qif-file.scm")
-(load-from-path "qif-objects.scm")
-(load-from-path "qif-record-xform.scm")
-(load-from-path "qif-bank-xtn-import.scm")
-(load-from-path "qif-invst-xtn-import.scm")
-(load-from-path "qif-acct-table.scm")
-
-;; qif-parse.scm
-(export qif-io:parse-category)
-(export qif-io:parse-year)
-(export qif-io:parse-acct-type)
-(export qif-io:parse-bang-field)
-(export qif-io:parse-action-field)
-(export qif-io:parse-cleared-field)
-(export qif-io:check-date-format)
-(export qif-io:parse-date/format)
-(export qif-io:check-number-format)
-(export qif-io:check-multi-number-format)
-(export qif-io:parse-number/format)
-
-;; qif-format-check.scm
-(export qif-io:setup-data-formats)
-(export qif-io:check-possible-formats)
-
-;; qif-file.scm
-(export qif-io:read-file)
-(export qif-io:write-file)
-(export qif-io:read-record)
-(export qif-io:write-record)
-
-;; qif-objects.scm
-(export qif-io:make-file)
-(export qif-io:make-empty-file)
-(export qif-io:file-bank-xtns)
-(export qif-io:file-invst-xtns)
-(export qif-io:file-bank-xtn-format)
-(export qif-io:file-invst-xtn-format)
-(export qif-io:file-set-bank-xtn-format!)
-(export qif-io:file-set-invst-xtn-format!)
-(export qif-io:file-xtns-need-acct?)
-(export qif-io:file-set-default-src-acct!)
-
-(export qif-io:make-empty-acct-table)
-(export qif-io:acct-table-accounts)
-(export qif-io:acct-table-categories)
-(export qif-io:acct-table-securities)
-(export qif-io:acct-table-brokerage-accts)
-
-;; qif-record-xform.scm
-(export qif-io:record->bank-xtn)
-(export qif-io:record->invst-xtn)
-(export qif-io:record->account)
-(export qif-io:record->category)
-(export qif-io:record->class)
-(export qif-io:record->security)
-
-(export qif-io:bank-xtn->record)
-(export qif-io:invst-xtn->record)
-(export qif-io:account->record)
-(export qif-io:category->record)
-(export qif-io:class->record)
-(export qif-io:security->record)
-
-;; qif-bank-xtn-import.scm
-(export qif-io:bank-xtn-import)
-(export qif-io:invst-xtn-import)
-
-;; acct-table.scm
-(export qif-io:acct-table-lookup)
-(export qif-io:acct-table-insert!)
-(export qif-io:acct-table-make-gnc-acct-tree)
-
-;; from main
-(export format)
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-objects.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-objects.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-objects.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,350 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-objects.scm
-;;; record type definitions for QIF objects.
-;;;
-;;; Bill Gribble <grib at billgribble.com> 20 Feb 2000
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; this should be a GOOPS class. later, I guess.
-(define <qif-file>
- (make-record-type
- "qif-file"
- '(path
- bank-xtns
- bank-xtn-format
- invst-xtns
- invst-xtn-format
- xtns-need-acct?
- default-src-acct
- accounts
- categories
- classes
- securities)))
-
-(define qif-io:make-file
- (record-constructor <qif-file>))
-(define (qif-io:make-empty-file)
- (qif-io:make-file #f #f #f #f #f #f #f #f #f #f #f))
-
-(define qif-io:file?
- (record-predicate <qif-file>))
-(define qif-io:file-path
- (record-accessor <qif-file> 'path))
-(define qif-io:file-set-path!
- (record-modifier <qif-file> 'path))
-(define qif-io:file-bank-xtns
- (record-accessor <qif-file> 'bank-xtns))
-(define qif-io:file-set-bank-xtns!
- (record-modifier <qif-file> 'bank-xtns))
-(define qif-io:file-bank-xtn-format
- (record-accessor <qif-file> 'bank-xtn-format))
-(define qif-io:file-set-bank-xtn-format!
- (record-modifier <qif-file> 'bank-xtn-format))
-(define qif-io:file-invst-xtns
- (record-accessor <qif-file> 'invst-xtns))
-(define qif-io:file-set-invst-xtns!
- (record-modifier <qif-file> 'invst-xtns))
-(define qif-io:file-invst-xtn-format
- (record-accessor <qif-file> 'invst-xtn-format))
-(define qif-io:file-set-invst-xtn-format!
- (record-modifier <qif-file> 'invst-xtn-format))
-(define qif-io:file-xtns-need-acct?
- (record-accessor <qif-file> 'xtns-need-acct?))
-(define qif-io:file-set-xtns-need-acct?!
- (record-modifier <qif-file> 'xtns-need-acct?))
-(define qif-io:file-default-src-acct
- (record-accessor <qif-file> 'default-src-acct))
-(define qif-io:file-set-default-src-acct!
- (record-modifier <qif-file> 'default-src-acct))
-(define qif-io:file-accounts
- (record-accessor <qif-file> 'accounts))
-(define qif-io:file-set-accounts!
- (record-modifier <qif-file> 'accounts))
-(define qif-io:file-categories
- (record-accessor <qif-file> 'categories))
-(define qif-io:file-set-categories!
- (record-modifier <qif-file> 'categories))
-(define qif-io:file-classes
- (record-accessor <qif-file> 'classes))
-(define qif-io:file-set-classes!
- (record-modifier <qif-file> 'classes))
-(define qif-io:file-securities
- (record-accessor <qif-file> 'securities))
-(define qif-io:file-set-securities!
- (record-modifier <qif-file> 'securities))
-
-
-(define <qif-split>
- (make-record-type
- "qif-split" '(category amount memo)))
-
-(define qif-io:make-split
- (record-constructor <qif-split>))
-(define (qif-io:make-empty-split)
- (qif-io:make-split #f #f #f))
-(define qif-io:split-category
- (record-accessor <qif-split> 'category))
-(define qif-io:split-set-category!
- (record-modifier <qif-split> 'category))
-(define qif-io:split-amount
- (record-accessor <qif-split> 'amount))
-(define qif-io:split-set-amount!
- (record-modifier <qif-split> 'amount))
-(define qif-io:split-memo
- (record-accessor <qif-split> 'memo))
-(define qif-io:split-set-memo!
- (record-modifier <qif-split> 'memo))
-
-
-(define <qif-bank-xtn>
- (make-record-type
- "qif-bank-xtn"
- '(source-acct date number payee memo t-amount u-amount
- cleared category address splits)))
-
-(define qif-io:make-bank-xtn
- (record-constructor <qif-bank-xtn>))
-(define (qif-io:make-empty-bank-xtn)
- (qif-io:make-bank-xtn #f #f #f #f #f #f #f #f #f #f #f))
-(define qif-io:bank-xtn-source-acct
- (record-accessor <qif-bank-xtn> 'source-acct))
-(define qif-io:bank-xtn-set-source-acct!
- (record-modifier <qif-bank-xtn> 'source-acct))
-(define qif-io:bank-xtn-date
- (record-accessor <qif-bank-xtn> 'date))
-(define qif-io:bank-xtn-set-date!
- (record-modifier <qif-bank-xtn> 'date))
-(define qif-io:bank-xtn-number
- (record-accessor <qif-bank-xtn> 'number))
-(define qif-io:bank-xtn-set-number!
- (record-modifier <qif-bank-xtn> 'number))
-(define qif-io:bank-xtn-payee
- (record-accessor <qif-bank-xtn> 'payee))
-(define qif-io:bank-xtn-set-payee!
- (record-modifier <qif-bank-xtn> 'payee))
-(define qif-io:bank-xtn-memo
- (record-accessor <qif-bank-xtn> 'memo))
-(define qif-io:bank-xtn-set-memo!
- (record-modifier <qif-bank-xtn> 'memo))
-(define qif-io:bank-xtn-t-amount
- (record-accessor <qif-bank-xtn> 't-amount))
-(define qif-io:bank-xtn-set-t-amount!
- (record-modifier <qif-bank-xtn> 't-amount))
-(define qif-io:bank-xtn-u-amount
- (record-accessor <qif-bank-xtn> 'u-amount))
-(define qif-io:bank-xtn-set-u-amount!
- (record-modifier <qif-bank-xtn> 'u-amount))
-(define qif-io:bank-xtn-cleared
- (record-accessor <qif-bank-xtn> 'cleared))
-(define qif-io:bank-xtn-set-cleared!
- (record-modifier <qif-bank-xtn> 'cleared))
-(define qif-io:bank-xtn-category
- (record-accessor <qif-bank-xtn> 'category))
-(define qif-io:bank-xtn-set-category!
- (record-modifier <qif-bank-xtn> 'category))
-(define qif-io:bank-xtn-address
- (record-accessor <qif-bank-xtn> 'address))
-(define qif-io:bank-xtn-set-address!
- (record-modifier <qif-bank-xtn> 'address))
-(define qif-io:bank-xtn-splits
- (record-accessor <qif-bank-xtn> 'splits))
-(define qif-io:bank-xtn-set-splits!
- (record-modifier <qif-bank-xtn> 'splits))
-
-(define <qif-invst-xtn>
- (make-record-type
- "qif-invst-xtn"
- '(source-acct date action security payee memo t-amount
- u-amount $-amount share-price share-amount commission
- cleared category address)))
-
-(define qif-io:make-invst-xtn
- (record-constructor <qif-invst-xtn>))
-(define (qif-io:make-empty-invst-xtn)
- (qif-io:make-invst-xtn #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
-(define qif-io:invst-xtn-source-acct
- (record-accessor <qif-invst-xtn> 'source-acct))
-(define qif-io:invst-xtn-set-source-acct!
- (record-modifier <qif-invst-xtn> 'source-acct))
-(define qif-io:invst-xtn-date
- (record-accessor <qif-invst-xtn> 'date))
-(define qif-io:invst-xtn-set-date!
- (record-modifier <qif-invst-xtn> 'date))
-(define qif-io:invst-xtn-action
- (record-accessor <qif-invst-xtn> 'action))
-(define qif-io:invst-xtn-set-action!
- (record-modifier <qif-invst-xtn> 'action))
-(define qif-io:invst-xtn-security
- (record-accessor <qif-invst-xtn> 'security))
-(define qif-io:invst-xtn-set-security!
- (record-modifier <qif-invst-xtn> 'security))
-(define qif-io:invst-xtn-payee
- (record-accessor <qif-invst-xtn> 'payee))
-(define qif-io:invst-xtn-set-payee!
- (record-modifier <qif-invst-xtn> 'payee))
-(define qif-io:invst-xtn-memo
- (record-accessor <qif-invst-xtn> 'memo))
-(define qif-io:invst-xtn-set-memo!
- (record-modifier <qif-invst-xtn> 'memo))
-(define qif-io:invst-xtn-t-amount
- (record-accessor <qif-invst-xtn> 't-amount))
-(define qif-io:invst-xtn-set-t-amount!
- (record-modifier <qif-invst-xtn> 't-amount))
-(define qif-io:invst-xtn-u-amount
- (record-accessor <qif-invst-xtn> 'u-amount))
-(define qif-io:invst-xtn-set-u-amount!
- (record-modifier <qif-invst-xtn> 'u-amount))
-(define qif-io:invst-xtn-$-amount
- (record-accessor <qif-invst-xtn> '$-amount))
-(define qif-io:invst-xtn-set-$-amount!
- (record-modifier <qif-invst-xtn> '$-amount))
-(define qif-io:invst-xtn-share-price
- (record-accessor <qif-invst-xtn> 'share-price))
-(define qif-io:invst-xtn-set-share-price!
- (record-modifier <qif-invst-xtn> 'share-price))
-(define qif-io:invst-xtn-share-amount
- (record-accessor <qif-invst-xtn> 'share-amount))
-(define qif-io:invst-xtn-set-share-amount!
- (record-modifier <qif-invst-xtn> 'share-amount))
-(define qif-io:invst-xtn-commission
- (record-accessor <qif-invst-xtn> 'commission))
-(define qif-io:invst-xtn-set-commission!
- (record-modifier <qif-invst-xtn> 'commission))
-(define qif-io:invst-xtn-cleared
- (record-accessor <qif-invst-xtn> 'cleared))
-(define qif-io:invst-xtn-set-cleared!
- (record-modifier <qif-invst-xtn> 'cleared))
-(define qif-io:invst-xtn-category
- (record-accessor <qif-invst-xtn> 'category))
-(define qif-io:invst-xtn-set-category!
- (record-modifier <qif-invst-xtn> 'category))
-(define qif-io:invst-xtn-address
- (record-accessor <qif-invst-xtn> 'address))
-(define qif-io:invst-xtn-set-address!
- (record-modifier <qif-invst-xtn> 'address))
-
-(define <qif-account>
- (make-record-type
- "qif-account"
- '(name type description limit budget)))
-
-(define qif-io:make-account
- (record-constructor <qif-account>))
-(define qif-io:account-name
- (record-accessor <qif-account> 'name))
-(define qif-io:account-set-name!
- (record-modifier <qif-account> 'name))
-(define qif-io:account-type
- (record-accessor <qif-account> 'type))
-(define qif-io:account-set-type!
- (record-modifier <qif-account> 'type))
-(define qif-io:account-description
- (record-accessor <qif-account> 'description))
-(define qif-io:account-set-description!
- (record-modifier <qif-account> 'description))
-(define qif-io:account-limit
- (record-accessor <qif-account> 'limit))
-(define qif-io:account-set-limit!
- (record-modifier <qif-account> 'limit))
-(define qif-io:account-budget
- (record-accessor <qif-account> 'budget))
-(define qif-io:account-set-budget!
- (record-modifier <qif-account> 'budget))
-
-(define <qif-category>
- (make-record-type
- "qif-category"
- '(name description taxable expense-cat income-cat tax-class budget-amt)))
-
-(define qif-io:make-category
- (record-constructor <qif-category>))
-(define qif-io:category-name
- (record-accessor <qif-category> 'name))
-(define qif-io:category-set-name!
- (record-modifier <qif-category> 'name))
-(define qif-io:category-description
- (record-accessor <qif-category> 'description))
-(define qif-io:category-set-description!
- (record-modifier <qif-category> 'description))
-(define qif-io:category-taxable
- (record-accessor <qif-category> 'taxable))
-(define qif-io:category-set-taxable!
- (record-modifier <qif-category> 'taxable))
-(define qif-io:category-expense-cat
- (record-accessor <qif-category> 'expense-cat))
-(define qif-io:category-set-expense-cat!
- (record-modifier <qif-category> 'expense-cat))
-(define qif-io:category-income-cat
- (record-accessor <qif-category> 'income-cat))
-(define qif-io:category-set-income-cat!
- (record-modifier <qif-category> 'income-cat))
-(define qif-io:category-tax-class
- (record-accessor <qif-category> 'tax-class))
-(define qif-io:category-set-tax-class!
- (record-modifier <qif-category> 'tax-class))
-(define qif-io:category-budget-amt
- (record-accessor <qif-category> 'budget-amt))
-(define qif-io:category-set-budget-amt!
- (record-modifier <qif-category> 'budget-amt))
-
-(define <qif-class>
- (make-record-type
- "qif-class"
- '(name description)))
-
-(define qif-io:make-class
- (record-constructor <qif-class>))
-(define qif-io:class-name
- (record-accessor <qif-class> 'name))
-(define qif-io:class-set-name!
- (record-modifier <qif-class> 'name))
-(define qif-io:class-description
- (record-accessor <qif-class> 'description))
-(define qif-io:class-set-description!
- (record-modifier <qif-class> 'description))
-
-(define <qif-security>
- (make-record-type
- "qif-security"
- '(name symbol type)))
-
-(define qif-io:make-security
- (record-constructor <qif-security>))
-(define qif-io:security-name
- (record-accessor <qif-security> 'name))
-(define qif-io:security-set-name!
- (record-modifier <qif-security> 'name))
-(define qif-io:security-symbol
- (record-accessor <qif-security> 'symbol))
-(define qif-io:security-set-symbol!
- (record-modifier <qif-security> 'symbol))
-(define qif-io:security-type
- (record-accessor <qif-security> 'type))
-(define qif-io:security-set-type!
- (record-modifier <qif-security> 'type))
-
-(define <qif-acct-table>
- (make-record-type
- "qif-acct-table"
- '(accounts categories securities brokerage-accts)))
-
-(define qif-io:make-acct-table
- (record-constructor <qif-acct-table>))
-
-(define (qif-io:make-empty-acct-table)
- (qif-io:make-acct-table
- (make-hash-table 13)
- (make-hash-table 13)
- (make-hash-table 13)
- (make-hash-table 13)))
-
-(define qif-io:acct-table-accounts
- (record-accessor <qif-acct-table> 'accounts))
-(define qif-io:acct-table-categories
- (record-accessor <qif-acct-table> 'categories))
-(define qif-io:acct-table-securities
- (record-accessor <qif-acct-table> 'securities))
-(define qif-io:acct-table-brokerage-accts
- (record-accessor <qif-acct-table> 'brokerage-accts))
-
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-parse.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-parse.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-parse.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,639 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; qif-parse.scm
-;;; routines to parse values and dates in QIF files.
-;;;
-;;; Bill Gribble <grib at billgribble.com> 20 Feb 2000
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define GNC-BANK-TYPE 0)
-(define GNC-CASH-TYPE 1)
-(define GNC-ASSET-TYPE 2)
-(define GNC-LIABILITY-TYPE 4)
-(define GNC-CCARD-TYPE 3)
-(define GNC-STOCK-TYPE 5)
-(define GNC-MUTUAL-TYPE 6)
-(define GNC-INCOME-TYPE 8)
-(define GNC-EXPENSE-TYPE 9)
-(define GNC-EQUITY-TYPE 10)
-
-
-
-(define qif-category-compiled-rexp
- (make-regexp "^ *(\\[)?([^]/|]*)(]?)(/([^|]*))?(\\|(\\[)?([^]/]*)(]?)(/(.*))?)? *$"))
-
-(define qif-date-compiled-rexp
- (make-regexp "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+).*$|^ *([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9]).*$"))
-
-(define decimal-radix-regexp
- (make-regexp
- "^ *\\$?-?\\$?[0-9]+$|^ *\\$?-?\\$?[0-9]?[0-9]?[0-9]?(,[0-9][0-9][0-9])*(\\.[0-9]*)? *$|^ *\\$?-?\\$?[0-9]+\\.[0-9]* *$"))
-
-(define comma-radix-regexp
- (make-regexp
- "^ *\\$?-?\\$?[0-9]+$|^ *\\$?-?\\$?[0-9]?[0-9]?[0-9]?(\\.[0-9][0-9][0-9])*(,[0-9]*) *$|^ *\\$?-?\\$?[0-9]+,[0-9]* *$"))
-
-(define integer-regexp (make-regexp "^\\$?-?\\$?[0-9]+ *$"))
-
-(define remove-trailing-space-rexp
- (make-regexp "^(.*[^ ]+) *$"))
-
-(define remove-leading-space-rexp
- (make-regexp "^ *([^ ].*)$"))
-
-(define (string-remove-trailing-space str)
- (let ((match (regexp-exec remove-trailing-space-rexp str)))
- (if match
- (string-copy (match:substring match 1))
- "")))
-
-(define (string-remove-trailing-space! str)
- (let ((match (regexp-exec remove-trailing-space-rexp str)))
- (if match
- (match:substring match 1)
- "")))
-
-(define (string-remove-leading-space str)
- (let ((match (regexp-exec remove-leading-space-rexp str)))
- (if match
- (string-copy (match:substring match 1))
- "")))
-
-(define (string-remove-leading-space! str)
- (let ((match (regexp-exec remove-leading-space-rexp str)))
- (if match
- (match:substring match 1)
- "")))
-
-(define (string-remove-char str char)
- (let ((rexpstr
- (case char
- ((#\.) "\\.")
- ((#\^) "\\^")
- ((#\$) "\\$")
- ((#\*) "\\*")
- ((#\+) "\\+")
- ((#\\) "\\\\")
- ((#\?) "\\?")
- (else
- (make-string 1 char)))))
- (regexp-substitute/global #f rexpstr str 'pre 'post)))
-
-(define (string-replace-char! str old new)
- (let ((rexpstr
- (if (not (eq? old #\.))
- (make-string 1 old)
- "\\."))
- (newstr (make-string 1 new)))
- (regexp-substitute/global #f rexpstr str 'pre newstr 'post)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:parse-category
-;; we return a list of 6 elements:
-;; 0 parsed category name (without [] if it was an account name)
-;; 1 bool stating if it was an account name (a transfer)
-;; 2 class of account or #f
-;; 3 string representing the "miscx category" if any
-;; 4 bool if miscx category is an account
-;; 5 class of miscx cat or #f
-;; gosh, I love regular expressions.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-category value)
- (if (not (string? value))
- (throw 'qif-io:arg-type 'qif-io:parse-category 'string value))
-
- (let ((match (regexp-exec qif-category-compiled-rexp value)))
- ;; what the substrings mean:
- ;; 1 the opening [ for a transfer
- ;; 2 the category
- ;; 3 the closing ]
- ;; 4 the class /
- ;; 5 the class
- ;; 6 the miscx expression (whole thing)
- ;; 7 the opening [
- ;; 8 the miscx category
- ;; 9 the closing ]
- ;; 10 the class /
- ;; 11 the class
- (if match
- (let ((rv
- (list (match:substring match 2)
- (if (and (match:substring match 1)
- (match:substring match 3))
- #t #f)
- (if (match:substring match 4)
- (match:substring match 5)
- #f)
- ;; miscx category name
- (if (match:substring match 6)
- (match:substring match 8)
- #f)
- ;; is it an account?
- (if (and (match:substring match 7)
- (match:substring match 9))
- #t #f)
- (if (match:substring match 10)
- (match:substring match 11)
- #f))))
- rv)
- (throw 'qif-io:parse-failed 'qif-io:parse-category value))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:parse-year
-;; this is where we handle y2k fixes etc. input is a string
-;; containing the year ("00", "2000", and "19100" all mean the same
-;; thing). output is an integer representing the year in the C.E.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-year year-string y2k-threshold)
- (if (not (string? year-string))
- (throw 'qif-io:arg-type 'qif-io:parse-year 'string year-string))
- (if (not (number? y2k-threshold))
- (throw 'qif-io:arg-type 'qif-io:parse-year 'number y2k-threshold))
-
- (let ((fixed-string #f)
- (post-read-value #f)
- (y2k-fixed-value #f))
-
- ;; quicken prints 2000 as "' 0" for at least some versions.
- ;; thanks dave p for reporting this.
- (if (eq? (string-ref year-string 0) #\')
- (begin
- (set! fixed-string
- (substring year-string 2 (string-length year-string))))
- (set! fixed-string year-string))
-
- ;; now the string should just have a number in it plus some
- ;; optional trailing space.
- (set! post-read-value
- (with-input-from-string fixed-string
- (lambda () (read))))
-
- (cond
- ;; 2-digit numbers less than the window size are interpreted to
- ;; be post-2000.
- ((and (integer? post-read-value)
- (< post-read-value y2k-threshold))
- (set! y2k-fixed-value (+ 2000 post-read-value)))
-
- ;; there's a common bug in printing post-2000 dates that
- ;; prints 2000 as 19100 etc.
- ((and (integer? post-read-value)
- (> post-read-value 19000))
- (set! y2k-fixed-value (+ 1900 (- post-read-value 19000))))
-
- ;; normal dates represented in unix years (i.e. year-1900, so
- ;; 2000 => 100.) We also want to allow full year specifications,
- ;; (i.e. 1999, 2001, etc) and there's a point at which you can't
- ;; determine which is which. mktime in scheme doesn't deal with
- ;; dates before December 14, 1901, at least for now, so let's
- ;; give ourselves until at least 3802 before this does the wrong
- ;; thing.
- ((and (integer? post-read-value)
- (< post-read-value 1902))
- (set! y2k-fixed-value (+ 1900 post-read-value)))
-
- ;; this is a normal, 4-digit year spec (1999, 2000, etc).
- ((integer? post-read-value)
- (set! y2k-fixed-value post-read-value))
-
- ;; No idea what the string represents. Maybe a new bug in Quicken!
- (#t
- (throw 'qif-io:parse-failed 'qif-io:parse-year year-string)))
- y2k-fixed-value))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; parse-bang-field : the bang fields switch the parse context for
-;; the qif file.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-bang-field read-value)
- (if (not (string? read-value))
- (throw 'qif-io:arg-type 'qif-io:parse-bang-field 'string read-value))
- (let ((bang-field (string-downcase!
- (string-remove-trailing-space read-value))))
-;; The QIF files output by the WWW site of Credit Lyonnais
-;; begin by: !type bank
-;; instead of: !Type:bank
- (if (>= (string-length bang-field) 5)
- (if (string=? (substring bang-field 0 5) "type ")
- (string-set! bang-field 4 #\:)))
-
- (string->symbol bang-field)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; parse-action-field : stock transaction actions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-action-field read-value)
- (define (canonicalize string)
- (string->symbol
- (string-downcase
- (string-remove-trailing-space!
- (string-remove-leading-space! string)))))
-
- (if (not (string? read-value))
- (throw 'qif-io:arg-type 'qif-io:parse-action-field 'string read-value))
-
- (let ((action-symbol (canonicalize read-value)))
- (case action-symbol
- ;; buy
- ((buy kauf)
- 'buy)
- ((buyx kaufx)
- 'buyx)
- ((cglong kapgew) ;; Kapitalgewinnsteuer
- 'cglong)
- ((cglongx kapgewx)
- 'cglongx)
- ((cgmid) ;; Kapitalgewinnsteuer
- 'cgmid)
- ((cgmidx)
- 'cgmidx)
- ((cgshort k.gewsp)
- 'cgshort)
- ((cgshortx k.gewspx)
- 'cgshortx)
- ((div) ;; dividende
- 'div)
- ((divx)
- 'divx)
- ;; ((exercise)
- ;; 'exercise)
- ;; ((exercisx)
- ;; 'exercisx)
- ;; ((expire)
- ;; 'expire)
- ;; ((grant)
- ;; 'grant)
- ((int intinc aktzu) ;; zinsen
- 'intinc)
- ((intx intincx)
- 'intincx)
- ((margint)
- 'margint)
- ((margintx)
- 'margintx)
- ((miscexp)
- 'miscexp)
- ((miscexpx)
- 'miscexpx)
- ((miscinc)
- 'miscinc)
- ((miscincx)
- 'miscincx)
- ((reinvdiv)
- 'reinvdiv)
- ((reinvint reinvzin)
- 'reinvint)
- ((reinvlg reinvkur)
- 'reinvlg)
- ((reinvmd)
- 'reinvmd)
- ((reinvsg reinvksp)
- 'reinvsg)
- ((reinvsh)
- 'reinvsh)
- ((reminder erinnerg)
- 'reminder)
- ((sell verkauf) ;; verkaufen
- 'sell)
- ((sellx verkaufx)
- 'sellx)
- ((shrsin aktzu)
- 'shrsin)
- ((shrsout aktab)
- 'shrsout)
- ((stksplit aktsplit)
- 'stksplit)
- ((xin)
- 'xin)
- ((xout)
- 'xout)
- ;; ((vest)
- ;; 'vest)
- (else
- (throw 'qif-io:parse-failed 'qif-io:parse-action-field read-value)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; parse-cleared-field : in a C (cleared) field in a QIF transaction,
-;; * means cleared, x or X means reconciled, and ! or ? mean some
-;; budget related stuff I don't understand.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-cleared-field read-value)
- (if (not (string? read-value))
- #\n
- (if (> (string-length read-value) 0)
- (let ((secondchar (string-ref read-value 0)))
- (cond ((eq? secondchar #\*)
- #\c)
- ((or (eq? secondchar #\x)
- (eq? secondchar #\X)
- (eq? secondchar #\r)
- (eq? secondchar #\R))
- #\y)
- ((or (eq? secondchar #\?)
- (eq? secondchar #\!))
- #\n)
- (#t
- (throw 'qif-io:parse-failed
- 'qif-io:parse-cleared-field read-value))))
- #f)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:check-date-format
-;; given a list of possible date formats, return a pruned list
-;; of possibilities.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:check-date-format date-string possible-formats)
- (if (not (string? date-string))
- (throw 'qif-io:arg-type 'qif-io:check-date-format 'string date-string))
- (if (not (list? possible-formats))
- (throw 'qif-io:arg-type 'qif-io:check-date-format
- 'list possible-formats))
-
- (let ((retval #f))
- (if (not (> (string-length date-string) 0))
- (set! retval possible-formats)
- (let ((date-parts '())
- (numeric-date-parts '())
- (match (regexp-exec qif-date-compiled-rexp date-string)))
-
- (if (not match)
- (throw 'qif-io:parse-failed 'qif-io:check-date-format
- date-string))
-
- (if (match:substring match 1)
- (set! date-parts (list (match:substring match 1)
- (match:substring match 2)
- (match:substring match 3)))
- (set! date-parts (list (match:substring match 4)
- (match:substring match 5)
- (match:substring match 6))))
-
- ;; get the strings into numbers (but keep the strings around)
- (set! numeric-date-parts
- (map (lambda (elt)
- (with-input-from-string elt
- (lambda () (read))))
- date-parts))
-
- (let ((possibilities possible-formats)
- (n1 (car numeric-date-parts))
- (n2 (cadr numeric-date-parts))
- (n3 (caddr numeric-date-parts)))
-
- ;; filter the possibilities to eliminate (hopefully)
- ;; all but one
- (if (or (not (number? n1)) (> n1 12))
- (set! possibilities (delq 'm-d-y possibilities)))
- (if (or (not (number? n1)) (> n1 31))
- (set! possibilities (delq 'd-m-y possibilities)))
- (if (or (not (number? n1)) (< n1 1))
- (set! possibilities (delq 'd-m-y possibilities)))
- (if (or (not (number? n1)) (< n1 1))
- (set! possibilities (delq 'm-d-y possibilities)))
-
- (if (or (not (number? n2)) (> n2 12))
- (begin
- (set! possibilities (delq 'd-m-y possibilities))
- (set! possibilities (delq 'y-m-d possibilities))))
-
- (if (or (not (number? n2)) (> n2 31))
- (begin
- (set! possibilities (delq 'm-d-y possibilities))
- (set! possibilities (delq 'y-d-m possibilities))))
-
- (if (or (not (number? n3)) (> n3 12))
- (set! possibilities (delq 'y-d-m possibilities)))
- (if (or (not (number? n3)) (> n3 31))
- (set! possibilities (delq 'y-m-d possibilities)))
-
- (if (or (not (number? n3)) (< n3 1))
- (set! possibilities (delq 'y-m-d possibilities)))
- (if (or (not (number? n3)) (< n3 1))
- (set! possibilities (delq 'y-d-m possibilities)))
- (set! retval possibilities))))
- retval))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:parse-date/format
-;; given a date string and a particular format spec, return a date
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-date/format date-string format)
- (if (not (string? date-string))
- (throw 'qif-io:arg-type 'qif-io:parse-date/format 'string date-string))
-
- (let ((date-parts '())
- (numeric-date-parts '())
- (retval date-string)
- (match (regexp-exec qif-date-compiled-rexp date-string)))
- (if (not match)
- (throw 'qif-io:parse-failed 'qif-io:parse-date/format date-string))
-
- (if (match:substring match 1)
- (set! date-parts (list (match:substring match 1)
- (match:substring match 2)
- (match:substring match 3)))
- (set! date-parts (list (match:substring match 4)
- (match:substring match 5)
- (match:substring match 6))))
-
- ;; get the strings into numbers (but keep the strings around)
- (set! numeric-date-parts
- (map (lambda (elt)
- (with-input-from-string elt
- (lambda () (read))))
- date-parts))
-
- ;; if the date parts list doesn't have 3 parts, we're in
- ;; trouble
- (if (not (eq? 3 (length date-parts)))
- ;; bomb out on bad parts
- (throw 'qif-io:parse-failed 'qif-io:parse-date/format date-string)
-
- ;; otherwise try to interpret
- (case format
- ((d-m-y)
- (let ((d (car numeric-date-parts))
- (m (cadr numeric-date-parts))
- (y (qif-io:parse-year (caddr date-parts) 50)))
- (if (and (integer? d) (integer? m) (integer? y)
- (<= m 12) (<= d 31))
- (set! retval (list d m y))
- (throw 'qif-io:parse-failed
- 'qif-io:parse-date/format date-string))))
- ((m-d-y)
- (let ((m (car numeric-date-parts))
- (d (cadr numeric-date-parts))
- (y (qif-io:parse-year (caddr date-parts) 50)))
- (if (and (integer? d) (integer? m) (integer? y)
- (<= m 12) (<= d 31))
- (set! retval (list d m y))
- (throw 'qif-io:parse-failed
- 'qif-io:parse-date/format date-string))))
- ((y-m-d)
- (let ((y (qif-io:parse-year (car date-parts) 50))
- (m (cadr numeric-date-parts))
- (d (caddr numeric-date-parts)))
- (if (and (integer? d) (integer? m) (integer? y)
- (<= m 12) (<= d 31))
- (set! retval (list d m y))
- (throw 'qif-io:parse-failed
- 'qif-io:parse-date/format date-string))))
- ((y-d-m)
- (let ((y (qif-io:parse-year (car date-parts) 50))
- (d (cadr numeric-date-parts))
- (m (caddr numeric-date-parts)))
- (if (and (integer? d) (integer? m) (integer? y)
- (<= m 12) (<= d 31))
- (set! retval (list d m y))
- (throw 'qif-io:parse-failed
- 'qif-io:parse-date/format date-string))))
- (else
- (throw 'qif-io:parse-failed 'qif-io:parse-date/format
- format))))
- retval))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:check-number-format
-;; given a list of possible number formats, return a pruned list
-;; of possibilities.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:check-number-format value-string possible-formats)
- (if (not (string? value-string))
- (throw 'qif-io:arg-type 'qif-io:check-number-format 'string value-string))
- (if (not (list? possible-formats))
- (throw 'qif-io:arg-type 'qif-io:check-number-format
- 'list possible-formats))
-
- (let ((retval '()))
- (for-each
- (lambda (format)
- (case format
- ((decimal)
- (if (regexp-exec decimal-radix-regexp value-string)
- (set! retval (cons 'decimal retval))))
- ((comma)
- (if (regexp-exec comma-radix-regexp value-string)
- (set! retval (cons 'comma retval))))
- ((integer)
- (if (regexp-exec integer-regexp value-string)
- (set! retval (cons 'integer retval))))
- (else
- (throw 'qif-io:arg-type 'qif-io:check-number-format
- 'number-format format))))
- possible-formats)
- (reverse! retval)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:check-multi-number-format
-;; apply check-number-format to a list of numbers
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:check-multi-number-format value-list possible-formats)
- (let ((retval possible-formats))
- (for-each
- (lambda (val)
- (if (string? val)
- (set! retval (qif-io:check-number-format val retval))))
- value-list)
- retval))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:parse-number/format
-;; assuming we know what the format is, parse the string.
-;; returns a gnc-numeric; the denominator is set so as to exactly
-;; represent the number
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-number/format value-string format)
- (if (not (string? value-string))
- (throw 'qif-io:arg-type 'qif-io:parse-number/format
- 'string value-string))
-
- (case format
- ((decimal)
- (let* ((filtered-string
- (string-remove-char
- (string-remove-char value-string #\,)
- #\$))
- (read-val
- (with-input-from-string filtered-string
- (lambda () (read)))))
- (if (number? read-val)
- (double-to-gnc-numeric
- (+ 0.0 read-val) GNC-DENOM-AUTO
- (logior (GNC-DENOM-SIGFIGS
- (string-length (string-remove-char filtered-string #\.)))
- GNC-RND-ROUND))
- (gnc-numeric-zero))))
- ((comma)
- (let* ((filtered-string
- (string-remove-char
- (string-replace-char!
- (string-remove-char value-string #\.)
- #\, #\.)
- #\$))
- (read-val
- (with-input-from-string filtered-string
- (lambda () (read)))))
- (if (number? read-val)
- (double-to-gnc-numeric
- (+ 0.0 read-val) GNC-DENOM-AUTO
- (logior (GNC-DENOM-SIGFIGS
- (string-length (string-remove-char filtered-string #\.)))
- GNC-RND-ROUND))
- (gnc-numeric-zero))))
- ((integer)
- (let ((read-val
- (with-input-from-string
- (string-remove-char value-string #\$)
- (lambda () (read)))))
- (if (number? read-val)
- (double-to-gnc-numeric
- (+ 0.0 read-val) 1 GNC-RND-ROUND)
- (gnc-numeric-zero))))
- (else
- (throw 'qif-io:arg-type 'qif-io:parse-number/format
- 'number-format format))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:parse-acct-type
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:parse-acct-type read-value)
- (if (not (string? read-value))
- #f
- (let ((mangled-string
- (string-remove-trailing-space
- (string-remove-leading-space read-value))))
- (cond
- ((string-ci=? mangled-string "bank")
- GNC-BANK-TYPE)
- ((string-ci=? mangled-string "port")
- GNC-BANK-TYPE)
- ((string-ci=? mangled-string "cash")
- GNC-CASH-TYPE)
- ((string-ci=? mangled-string "ccard")
- GNC-CCARD-TYPE)
- ((string-ci=? mangled-string "invst") ;; these are brokerage accounts.
- GNC-BANK-TYPE)
- ((string-ci=? mangled-string "oth a")
- GNC-ASSET-TYPE)
- ((string-ci=? mangled-string "oth l")
- GNC-LIABILITY-TYPE)
- ((string-ci=? mangled-string "mutual")
- GNC-BANK-TYPE)
- (else
- #f)))))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/qif-record-xform.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/qif-record-xform.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/qif-record-xform.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,454 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-record-xform
-;; routines to convert tag-value lists into various QIF data
-;; structures
-;;
-;; Copyright (c) 2001 Linux Developers Group, Inc.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:record->bank-xtn
-;; take a list of key-value pairs representing a transaction and
-;; turn them into an actual transaction record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:record->bank-xtn record-pairs)
- (let ((tag #f)
- (value #f)
- (date #f)
- (number #f)
- (payee #f)
- (memo #f)
- (address #f)
- (cleared #f)
- (t-amount #f)
- (u-amount #f)
- (category #f)
- (split-category #f)
- (split-amount #f)
- (split-memo #f)
- (complete-splits '())
- (split-records '()))
- (for-each
- (lambda (pair)
- (set! tag (car pair))
- (set! value (cdr pair))
- (case tag
- ((#\D) (set! date value)) ;; D : transaction date
- ((#\N) (set! number value)) ;; N : check number
- ((#\P) (set! payee value)) ;; P : payee
- ((#\M) (set! memo value)) ;; M : memo
- ((#\T) (set! t-amount value)) ;; T : total amount
- ((#\U) (set! u-amount value)) ;; U : total amount
- ((#\C) (set! cleared value)) ;; C : cleared flag
- ((#\L) (set! category value)) ;; L : category
- ((#\A) ;; A : address
- ;; multiple "A" lines are appended together with
- ;; newlines; some Quicken files have a lot of
- ;; A lines.
- (if (string? address)
- (set! address
- (string-append address "\n" value))
- (set! address value)))
-
- ((#\S) ;; S : split category
- ;; if we have already seen another split, this S line
- ;; finishes it and starts a new one
- (if split-category
- (begin
- (set! complete-splits
- (cons (list split-category split-amount split-memo)
- complete-splits))
- (set! split-category value)
- (set! split-amount #f)
- (set! split-memo #f))
- (set! split-category value)))
- ((#\E) (set! split-memo value)) ;; E : split memo
- ((#\$) (set! split-amount value))))
- record-pairs)
-
- ;; if there's an open split, do the right thing
- (if (string? split-category)
- (set! complete-splits
- (cons (list split-category split-amount split-memo)
- complete-splits)))
-
- ;; convert the splits to split records
- ;; (reversing the list again to get the right order)
- (for-each
- (lambda (split)
- (set! split-records
- (cons (qif-io:make-split (car split)
- (cadr split)
- (caddr split))
- split-records)))
- complete-splits)
-
- ;; check for bogosity and make a record if everything's ok
- (if (and date t-amount)
- (qif-io:make-bank-xtn #f date number payee memo
- t-amount u-amount cleared category
- address split-records)
- (throw 'qif-io:record-error 'qif-io:record->bank-xtn record-pairs))))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:bank-xtn->record
-;; turn a bank-xtn into tag-value pairs.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:bank-xtn->record bank-xtn)
- (let ((kvp '()))
- (let ((date (qif-io:bank-xtn-date bank-xtn)))
- (if date
- (set! kvp (cons (cons #\D date) kvp))))
- (let ((number (qif-io:bank-xtn-number bank-xtn)))
- (if number
- (set! kvp (cons (cons #\N number) kvp))))
- (let ((payee (qif-io:bank-xtn-payee bank-xtn)))
- (if payee
- (set! kvp (cons (cons #\P payee) kvp))))
- (let ((memo (qif-io:bank-xtn-memo bank-xtn)))
- (if memo
- (set! kvp (cons (cons #\M memo) kvp))))
- (let ((t-amount (qif-io:bank-xtn-t-amount bank-xtn)))
- (if t-amount
- (set! kvp (cons (cons #\T t-amount) kvp))))
- (let ((u-amount (qif-io:bank-xtn-u-amount bank-xtn)))
- (if u-amount
- (set! kvp (cons (cons #\U u-amount) kvp))))
- (let ((cleared (qif-io:bank-xtn-cleared bank-xtn)))
- (if cleared
- (set! kvp (cons (cons #\C cleared) kvp))))
- (let ((category (qif-io:bank-xtn-category bank-xtn)))
- (if category
- (set! kvp (cons (cons #\L category) kvp))))
- (let ((address (qif-io:bank-xtn-address bank-xtn)))
- (if address
- (with-input-from-string address
- (lambda ()
- (let loop ((line (read-line)))
- (if (not (eof-object? line))
- (begin
- (set! kvp (cons (cons #\A line) kvp))
- (loop (read-line)))))))))
- (let ((splits (qif-io:bank-xtn-splits bank-xtn)))
- (for-each
- (lambda (split)
- (let ((split-cat (qif-io:split-category split))
- (split-memo (qif-io:split-memo split))
- (split-amount (qif-io:split-amount split)))
- (if split-cat
- (set! kvp (cons (cons #\S split-cat) kvp))
- (if (or split-memo split-amount)
- (set! kvp (cons (cons #\S "") kvp))))
- (if split-memo
- (set! kvp (cons (cons #\E split-memo) kvp)))
- (if split-amount
- (set! kvp (cons (cons #\$ split-amount) kvp)))))
- splits))
- (reverse! kvp)))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:record->invst-xtn
-;; take a list of key-value pairs representing a transaction and
-;; turn them into an actual transaction record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:record->invst-xtn record-pairs)
- (let ((tag #f)
- (value #f)
- (date #f)
- (action #f)
- (payee #f)
- (memo #f)
- (address #f)
- (cleared #f)
- (t-amount #f)
- (u-amount #f)
- (security #f)
- (category #f)
- (commission #f)
- ($-amount #f)
- (share-price #f)
- (share-amount #f))
- (for-each
- (lambda (pair)
- (set! tag (car pair))
- (set! value (cdr pair))
- (case tag
- ((#\D) (set! date value)) ;; D : transaction date
- ((#\N) (set! action value)) ;; N : investment action
- ((#\P) (set! payee value)) ;; P : payee
- ((#\M) (set! memo value)) ;; M : memo
- ((#\T) (set! t-amount value)) ;; T : total amount
- ((#\U) (set! u-amount value)) ;; U : total amount
- ((#\$) (set! $-amount value)) ;; $ : total amount
- ((#\Y) (set! security value)) ;; Y : security
- ((#\I) (set! share-price value)) ;; I : share price
- ((#\Q) (set! share-amount value)) ;; Q : share quantity
- ((#\O) (set! commission value)) ;; O : commission
- ((#\C) (set! cleared value)) ;; C : cleared flag
- ((#\L) (set! category value)) ;; L : category
- ((#\A) ;; A : address
- ;; multiple "A" lines are appended together with
- ;; newlines; some Quicken files have a lot of
- ;; A lines.
- (if (string? address)
- (set! address
- (string-append address "\n" value))
- (set! address value)))))
- record-pairs)
- (qif-io:make-invst-xtn #f date action security payee memo t-amount
- u-amount $-amount share-price share-amount
- commission cleared category address)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:invst-xtn->record
-;; turn a invst-xtn into tag-value pairs.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:invst-xtn->record invst-xtn)
- (let ((kvp '()))
- (let ((date (qif-io:invst-xtn-date invst-xtn)))
- (if date
- (set! kvp (cons (cons #\D date) kvp))))
- (let ((action (qif-io:invst-xtn-action invst-xtn)))
- (if action
- (set! kvp (cons (cons #\N action) kvp))))
- (let ((payee (qif-io:invst-xtn-payee invst-xtn)))
- (if payee
- (set! kvp (cons (cons #\P payee) kvp))))
- (let ((security (qif-io:invst-xtn-security invst-xtn)))
- (if security
- (set! kvp (cons (cons #\Y security) kvp))))
- (let ((share-price (qif-io:invst-xtn-share-price invst-xtn)))
- (if share-price
- (set! kvp (cons (cons #\I share-price) kvp))))
- (let ((share-amount (qif-io:invst-xtn-share-amount invst-xtn)))
- (if share-amount
- (set! kvp (cons (cons #\Q share-amount) kvp))))
- (let ((t-amount (qif-io:invst-xtn-t-amount invst-xtn)))
- (if t-amount
- (set! kvp (cons (cons #\T t-amount) kvp))))
- (let ((u-amount (qif-io:invst-xtn-u-amount invst-xtn)))
- (if u-amount
- (set! kvp (cons (cons #\U u-amount) kvp))))
- (let ((commission (qif-io:invst-xtn-commission invst-xtn)))
- (if commission
- (set! kvp (cons (cons #\O commission) kvp))))
- (let ((cleared (qif-io:invst-xtn-cleared invst-xtn)))
- (if cleared
- (set! kvp (cons (cons #\C cleared) kvp))))
- (let ((address (qif-io:invst-xtn-address invst-xtn)))
- (if address
- (with-input-from-string address
- (lambda ()
- (let loop ((line (read-line)))
- (if (not (eof-object? line))
- (begin
- (set! kvp (cons (cons #\A line) kvp))
- (loop (read-line)))))))))
- (let ((memo (qif-io:invst-xtn-memo invst-xtn)))
- (if memo
- (set! kvp (cons (cons #\M memo) kvp))))
- (let ((category (qif-io:invst-xtn-category invst-xtn)))
- (if category
- (set! kvp (cons (cons #\L category) kvp))))
- (let (($-amount (qif-io:invst-xtn-$-amount invst-xtn)))
- (if $-amount
- (set! kvp (cons (cons #\$ $-amount) kvp))))
- (reverse! kvp '())))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:record->account
-;; take a list of key-value pairs representing a transaction and
-;; turn them into an actual transaction record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:record->account record-pairs)
- (let ((tag #f)
- (value #f)
- (name #f)
- (type #f)
- (description #f)
- (limit #f)
- (budget #f))
- (for-each
- (lambda (pair)
- (set! tag (car pair))
- (set! value (cdr pair))
- (case tag
- ((#\N) (set! name value)) ;; N : account name
- ((#\D) (set! description value)) ;; D : account descrip
- ((#\T) (set! type value)) ;; T : account type
- ((#\L) (set! limit value)) ;; L : credit limit
- ((#\B) (set! budget value)))) ;; B : budget amount (?)
- record-pairs)
- (qif-io:make-account name type description limit budget)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:account->record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:account->record acct)
- (let ((kvp '()))
- (let ((name (qif-io:account-name acct)))
- (if name
- (set! kvp (cons (cons #\N name) kvp))))
- (let ((type (qif-io:account-type acct)))
- (if type
- (set! kvp (cons (cons #\T type) kvp))))
- (let ((description (qif-io:account-description acct)))
- (if description
- (set! kvp (cons (cons #\D description) kvp))))
- (let ((limit (qif-io:account-limit acct)))
- (if limit
- (set! kvp (cons (cons #\L limit) kvp))))
- (let ((budget (qif-io:account-budget acct)))
- (if budget
- (set! kvp (cons (cons #\B budget) kvp))))
- (reverse! kvp '())))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:record->category
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:record->category record-pairs)
- (let ((tag #f)
- (value #f)
- (name #f)
- (taxable #f)
- (description #f)
- (expense-cat #f)
- (income-cat #f)
- (tax-class #f)
- (budget-amt #f))
- (for-each
- (lambda (pair)
- (set! tag (car pair))
- (set! value (cdr pair))
- (case tag
- ((#\N) (set! name value))
- ((#\D) (set! description value))
- ((#\T) (set! taxable value))
- ((#\E) (set! expense-cat value))
- ((#\I) (set! income-cat value))
- ((#\R) (set! tax-class value))
- ((#\B) (set! budget-amt value))))
- record-pairs)
- (qif-io:make-category name description taxable
- expense-cat income-cat tax-class budget-amt)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:category->record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:category->record cat)
- (let ((kvp '()))
- (let ((name (qif-io:category-name cat)))
- (if name
- (set! kvp (cons (cons #\N name) kvp))))
- (let ((description (qif-io:category-description cat)))
- (if description
- (set! kvp (cons (cons #\D description) kvp))))
- (let ((taxable (qif-io:category-taxable cat)))
- (if taxable
- (set! kvp (cons (cons #\T taxable) kvp))))
- (let ((tax-class (qif-io:category-tax-class cat)))
- (if tax-class
- (set! kvp (cons (cons #\R tax-class) kvp))))
- (let ((expense-cat (qif-io:category-expense-cat cat)))
- (if expense-cat
- (set! kvp (cons (cons #\E expense-cat) kvp))))
- (let ((income-cat (qif-io:category-income-cat cat)))
- (if income-cat
- (set! kvp (cons (cons #\I income-cat) kvp))))
- (let ((budget-amt (qif-io:category-budget-amt cat)))
- (if budget-amt
- (set! kvp (cons (cons #\B budget-amt) kvp))))
- (reverse! kvp '())))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:record->class
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:record->class record-pairs)
- (let ((tag #f)
- (value #f)
- (name #f)
- (description #f))
- (for-each
- (lambda (pair)
- (set! tag (car pair))
- (set! value (cdr pair))
- (case tag
- ((#\N) (set! name value))
- ((#\D) (set! description value))))
- record-pairs)
- (qif-io:make-class name description)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:class->record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:class->record class)
- (let ((kvp '()))
- (let ((name (qif-io:class-name class)))
- (if name
- (set! kvp (cons (cons #\N name) kvp))))
- (let ((description (qif-io:class-description class)))
- (if description
- (set! kvp (cons (cons #\D description) kvp))))
- (reverse! kvp '())))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:record->security
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:record->security record-pairs)
- (let ((tag #f)
- (value #f)
- (name #f)
- (symbol #f)
- (type #f))
- (for-each
- (lambda (pair)
- (set! tag (car pair))
- (set! value (cdr pair))
- (case tag
- ((#\N) (set! name value))
- ((#\S) (set! symbol value))
- ((#\T) (set! type value))))
- record-pairs)
- (qif-io:make-security name symbol type)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; qif-io:security->record
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (qif-io:security->record security)
- (let ((kvp '()))
- (let ((name (qif-io:security-name security)))
- (if name
- (set! kvp (cons (cons #\N name) kvp))))
- (let ((type (qif-io:security-type security)))
- (if type
- (set! kvp (cons (cons #\T type) kvp))))
- (let ((symbol (qif-io:security-symbol security)))
- (if symbol
- (set! kvp (cons (cons #\S symbol) kvp))))
- (reverse! kvp '())))
-
-
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/Makefile.am
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/Makefile.am 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/Makefile.am 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,28 +0,0 @@
-LDADD=${top_builddir}/src/gnc-module/libgnc-module.la ${GLIB_LIBS}
-
-AM_CPPFLAGS = -I${top_srcdir}/src/gnc-module ${GUILE_INCS} ${GLIB_CFLAGS}
-
-TESTS=test-load-module test-parser test-reader test-file-formats \
-test-import-phase-1
-
-GNC_TEST_DEPS = \
- --gnc-module-dir ${top_builddir}/src/gnc-module \
- --gnc-module-dir ${top_builddir}/src/engine \
- --gnc-module-dir ${top_builddir}/src/app-utils \
- --gnc-module-dir ${top_builddir}/src/backend/xml \
- --gnc-module-dir ${top_builddir}/src/import-export/qif-io-core \
- --guile-load-dir ${top_srcdir}/src/import-export/qif-io-core/test \
- --guile-load-dir ${top_srcdir}/lib \
- --guile-load-dir ${top_builddir}/src/gnome-utils \
- --guile-load-dir ${top_builddir}/src/gnome \
- --guile-load-dir ${top_builddir}/src/scm \
- --library-dir ${top_builddir}/src/gnome-utils \
- --library-dir ${top_srcdir}/src/gnome
-
-TESTS_ENVIRONMENT = \
- SRCDIR=${srcdir} \
- $(shell ${top_srcdir}/src/gnc-test-env --no-exports ${GNC_TEST_DEPS})
-
-print_test_env:
- echo ${GNC_TEST_DEPS}
- echo ${TESTS_ENVIRONMENT}
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/category-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/category-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/category-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,11 +0,0 @@
-(("plain category") #f ("plain category" #f #f #f #f #f))
-(("[transfer]") #f ("transfer" #t #f #f #f #f))
-((bad-data) #t (qif-io:arg-type qif-io:parse-category string bad-data))
-(("category/class") #f ("category" #f "class" #f #f #f))
-(("[transfer]/class") #f ("transfer" #t "class" #f #f #f))
-(("[transfer]/class|[miscxfer]") #f ("transfer" #t "class" "miscxfer" #t #f))
-(("[transfer]/class|miscxfer") #f ("transfer" #t "class" "miscxfer" #f #f))
-(("[transfer]/class|[miscxfer]/class2") #f
- ("transfer" #t "class" "miscxfer" #t "class2"))
-(("class1/class2:ISDN|[Telecom]") #f ("class1" #f "class2:ISDN" "Telecom" #t #f))
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,15 +0,0 @@
-(("01/20/2001" m-d-y) #f (20 1 2001))
-(("20.1.01" d-m-y) #f (20 1 2001))
-(("19101-1-20" y-m-d) #f (20 1 2001))
-(("1/20/1" y-d-m) #f (20 1 2001))
-(("1/20'01" m-d-y) #f (20 1 2001))
-(("1/20' 1" m-d-y) #f (20 1 2001))
-(("2/dd/2001" d-m-y) #t
- (qif-io:parse-failed qif-io:parse-date/format "2/dd/2001"))
-(("not a date" d-m-y) #t
- (qif-io:parse-failed qif-io:parse-date/format "not a date"))
-((nonstring d-m-y) #t (qif-io:arg-type qif-io:parse-date/format string nonstring))
-(("01/04/2001" bad-format) #t
- (qif-io:parse-failed qif-io:parse-date/format bad-format))
-(("3-3" d-m-y) #t
- (qif-io:parse-failed qif-io:parse-date/format "3-3"))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-format-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-format-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/date-format-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,19 +0,0 @@
-(("01/20/2001" (d-m-y m-d-y y-m-d y-d-m)) #f (m-d-y))
-(("20.1.01" (d-m-y m-d-y y-m-d y-d-m)) #f (d-m-y y-m-d y-d-m))
-(("19101-1-20" (d-m-y m-d-y y-m-d y-d-m)) #f (y-m-d))
-(("1/20/1" (d-m-y m-d-y y-m-d y-d-m)) #f (m-d-y y-d-m))
-(("1/20'01" (d-m-y m-d-y y-m-d y-d-m)) #f (m-d-y y-d-m))
-(("1/20' 1" (d-m-y m-d-y y-m-d y-d-m)) #f (m-d-y y-d-m))
-(("2/dd/2001" (d-m-y m-d-y y-m-d y-d-m)) #t
- (qif-io:parse-failed qif-io:check-date-format "2/dd/2001"))
-(("not a date" (d-m-y)) #t
- (qif-io:parse-failed qif-io:check-date-format "not a date"))
-((nonstring d-m-y) #t (qif-io:arg-type qif-io:check-date-format string nonstring))
-(("01/04/2001" bad-format) #t
- (qif-io:arg-type qif-io:check-date-format list bad-format))
-(("3-3" d-m-y) #t
- (qif-io:arg-type qif-io:check-date-format list d-m-y))
-(("3-3" (d-m-y)) #t
- (qif-io:parse-failed qif-io:check-date-format "3-3"))
-
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/file-formats-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/file-formats-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/file-formats-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,58 +0,0 @@
-(("../../../../doc/examples/quicktest.qif")
- #f (()
- ((#\D m-d-y) (#\I decimal) (#\Q decimal) (#\T decimal)
- (#\O decimal) (#\$ decimal))))
-
-(("../../../../doc/examples/Money95bank_fr.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal)) ()))
-
-(("../../../../doc/examples/Money95invst_fr.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal comma)) ()))
-
-(("../../../../doc/examples/Money95mfunds_fr.qif")
- #f (()
- ((#\D m-d-y) (#\I decimal) (#\Q decimal comma) (#\T decimal)
- (#\O decimal) (#\$ decimal))))
-
-(("../../../../doc/examples/Money95stocks_fr.qif")
- #f (()
- ((#\D m-d-y) (#\I decimal) (#\Q decimal) (#\T decimal)
- (#\O decimal) (#\$ decimal))))
-
-(("../../../../doc/examples/abc-all.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal))
- ()))
-
-(("../../../../doc/examples/abc.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal comma))
- ()))
-
-(("../../../../doc/examples/bogus.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal comma))
- ()))
-
-(("../../../../doc/examples/cbb-export.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal))
- ()))
-
-(("../../../../doc/examples/divx.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\U decimal) (#\S . "") (#\$ decimal))
- ((#\D m-d-y) (#\T decimal) (#\U decimal) (#\$ decimal))))
-
-(("../../../../doc/examples/every.qif")
- #f (()
- ((#\D m-d-y) (#\I decimal) (#\Q decimal) (#\T decimal)
- (#\O decimal) (#\$ decimal))))
-
-(("../../../../doc/examples/ms-money.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal comma))
- ()))
-
-(("../../../../doc/examples/swipe.qif")
- #f (()
- ((#\D m-d-y) (#\I decimal) (#\Q decimal) (#\T decimal)
- (#\$ decimal))))
-
-(("../../../../doc/examples/web.qif")
- #f (((#\D m-d-y) (#\T decimal) (#\S . "") (#\$ decimal comma))
- ()))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/import-phase-1-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/import-phase-1-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/import-phase-1-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,15 +0,0 @@
-(("../../../../doc/examples/quicktest.qif") #f 0)
-(("../../../../doc/examples/Money95bank_fr.qif") #f 0)
-(("../../../../doc/examples/Money95invst_fr.qif") #f 0)
-(("../../../../doc/examples/Money95mfunds_fr.qif") #f 0)
-(("../../../../doc/examples/Money95stocks_fr.qif") #f 0)
-(("../../../../doc/examples/abc-all.qif") #f 0)
-(("../../../../doc/examples/abc.qif") #f 0)
-(("../../../../doc/examples/bogus.qif") #f 0)
-(("../../../../doc/examples/cbb-export.qif") #f 0)
-(("../../../../doc/examples/divx.qif") #f 0)
-(("../../../../doc/examples/every.qif") #f 0)
-(("../../../../doc/examples/ms-money.qif") #f 0)
-(("../../../../doc/examples/quicktest.qif") #f 0)
-(("../../../../doc/examples/swipe.qif") #f 0)
-(("../../../../doc/examples/web.qif") #f 0)
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,3 +0,0 @@
-(("1,000.00" decimal) #f "100000/100")
-(("1,000.01" decimal) #f "100001/100")
-(("1,000" decimal) #f "1000/1")
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-format-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-format-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/number-format-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,11 +0,0 @@
-(("1,000.00" (decimal comma integer)) #f (decimal))
-(("1,000.000" (decimal comma integer)) #f (decimal))
-(("1.000,000" (decimal comma integer)) #f (comma))
-(("1000" (decimal comma integer)) #f (decimal comma integer))
-(("1000" (decimal comma)) #f (decimal comma))
-(("1,000" (decimal comma integer)) #f (decimal comma))
-(("1,000" (decimal comma integer)) #f (decimal comma))
-(("1,000.00" (comma)) #f ())
-(("1,000.01" (foo bar)) #t (qif-io:arg-type qif-io:check-number-format number-format foo))
-(("1,000" decimal) #t (qif-io:arg-type qif-io:check-number-format list decimal))
-((#f (decimal comma)) #t (qif-io:arg-type qif-io:check-number-format string #f))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/data/reader-data.txt
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/data/reader-data.txt 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/data/reader-data.txt 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,15 +0,0 @@
-(("../../../../doc/examples/quicktest.qif") #f 0)
-(("../../../../doc/examples/Money95bank_fr.qif") #f 0)
-(("../../../../doc/examples/Money95invst_fr.qif") #f 0)
-(("../../../../doc/examples/Money95mfunds_fr.qif") #f 0)
-(("../../../../doc/examples/Money95stocks_fr.qif") #f 0)
-(("../../../../doc/examples/abc-all.qif") #f 0)
-(("../../../../doc/examples/abc.qif") #f 0)
-(("../../../../doc/examples/bogus.qif") #f 0)
-(("../../../../doc/examples/cbb-export.qif") #f 0)
-(("../../../../doc/examples/divx.qif") #f 0)
-(("../../../../doc/examples/every.qif") #f 0)
-(("../../../../doc/examples/ms-money.qif") #f 0)
-(("../../../../doc/examples/quicktest.qif") #f 0)
-(("../../../../doc/examples/swipe.qif") #f 0)
-(("../../../../doc/examples/web.qif") #f 0)
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/dump-qifobj.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/dump-qifobj.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/dump-qifobj.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,20 +0,0 @@
-(debug-enable 'backtrace)
-
-(define (line-dump filename thunk)
- (with-input-from-file filename
- (lambda ()
- (let loop ((this-line (read)))
- (if (not (eof-object? this-line))
- (begin
- (apply thunk (car this-line))
- (loop (read))))))))
-
-(define (read-file-thunk infile)
- (let ((qiffile (qif-io:make-file #f #f #f #f #f #f #f)))
- (format #t "======= ~A ======\n" infile)
- (qif-io:read-file qiffile infile #f)
- (qif-io:write-file qiffile (format #f "~A.out" infile))))
-
-(gnc:module-load "qifiocore")
-
-(line-dump "data/reader-data.txt" read-file-thunk)
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/qiftest.gnc
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/qiftest.gnc 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/qiftest.gnc 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,218 +0,0 @@
-<?xml version="1.0"?>
-<gnc-v2>
-<gnc:count-data cd:type="account">2</gnc:count-data>
-<gnc:count-data cd:type="transaction">7</gnc:count-data>
-<gnc:account version="2.0.0">
- <act:name/>
- <act:id type="guid">676b480e5cfaa3457ee392e3c51ced88</act:id>
- <act:type>NO_TYPE</act:type>
- <act:commodity-scu>100000</act:commodity-scu>
-</gnc:account>
-<gnc:account version="2.0.0">
- <act:name/>
- <act:id type="guid">e67c88bb5901cbd39a577e196258bb1d</act:id>
- <act:type>NO_TYPE</act:type>
- <act:commodity-scu>100000</act:commodity-scu>
-</gnc:account>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">a45aab10729e86f89a09fdade4ccc2e0</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-18 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>329019000</ts:ns>
- </trn:date-entered>
- <trn:description>Check Number: 203</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">9d2a30fa881189fbc8384f81e13fa709</split:id>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">e2e6868646216b8e96d6c9273dda2dff</split:id>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">d46556507b3b7b19682763a184499486</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-19 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>315763000</ts:ns>
- </trn:date-entered>
- <trn:description>Direct Deposit</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">7035db7e9ba78c6dd4cc8967c5f5f954</split:id>
- <split:memo> ADMINISTAFF COMP</split:memo>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">427cce0e2b033b697ca6433cd4f5ad13</split:id>
- <split:memo> ADMINISTAFF COMP</split:memo>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">e3a6834c0a9695aa082562e48223e845</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-20 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>314187000</ts:ns>
- </trn:date-entered>
- <trn:description>Point of Sale Transaction FRY'S</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">71222dc2c372f559ce3a0ce4e2ae09ef</split:id>
- <split:memo>FOOD STOR 7770 E. MCDOWELL SCOTTSDALE</split:memo>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">7af77bf9af90902aef1d1ec745614c4f</split:id>
- <split:memo>FOOD STOR 7770 E. MCDOWELL SCOTTSDALE</split:memo>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">5470ac24f1f928b1722720b4be94073a</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-21 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>312579000</ts:ns>
- </trn:date-entered>
- <trn:description>Point of Sale Transaction ABCO</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">62a43470f3850db3af8be603292e0664</split:id>
- <split:memo>FOODS #425 4101 N. 28TH STREET PHOENIX</split:memo>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">0a6ed5cdf4aeaa0bb8540de7f118291b</split:id>
- <split:memo>FOODS #425 4101 N. 28TH STREET PHOENIX</split:memo>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">6500bf9438dcda6eef08336db1d6e309</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-22 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>310653000</ts:ns>
- </trn:date-entered>
- <trn:description>Check Number: 200</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">221dc1b9ae283c96a330f8281849eced</split:id>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">82279f63494c9d3b4469e9eab793315b</split:id>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">dd52a96000be560b831a3c6b72756997</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-24 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>309076000</ts:ns>
- </trn:date-entered>
- <trn:description>Point of Sale Transaction</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">30f71490ba4dc5004f957994efa46ce5</split:id>
- <split:memo> TGI FRIDAYS #1859 SCOTTSDALE AZUS</split:memo>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">24c1b63b4037f310044c440eb25d6afa</split:id>
- <split:memo> TGI FRIDAYS #1859 SCOTTSDALE AZUS</split:memo>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-<gnc:transaction version="2.0.0">
- <trn:id type="guid">c9106cc5f7fb3c5d89d019b67058b208</trn:id>
- <trn:date-posted>
- <ts:date>1999-03-25 00:00:00 -0600</ts:date>
- </trn:date-posted>
- <trn:date-entered>
- <ts:date>2001-07-27 11:28:22 -0500</ts:date>
- <ts:ns>307172000</ts:ns>
- </trn:date-entered>
- <trn:description>Share Withdrawal</trn:description>
- <trn:splits>
- <trn:split>
- <split:id type="guid">32367c2efb4d0585c7e57443be43556c</split:id>
- <split:reconciled-state>c</split:reconciled-state>
- <split:value>-9999000/100000</split:value>
- <split:quantity>-9999000/100000</split:quantity>
- <split:account type="guid">e67c88bb5901cbd39a577e196258bb1d</split:account>
- </trn:split>
- <trn:split>
- <split:id type="guid">884a392c130f96856c0ffb3887c9eb9f</split:id>
- <split:reconciled-state>n</split:reconciled-state>
- <split:value>9999000/100000</split:value>
- <split:quantity>9999000/100000</split:quantity>
- <split:account type="guid">676b480e5cfaa3457ee392e3c51ced88</split:account>
- </trn:split>
- </trn:splits>
-</gnc:transaction>
-</gnc-v2>
-
-<!-- Local variables: -->
-<!-- mode: xml -->
-<!-- End: -->
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,2 +0,0 @@
-#!/bin/sh
-guile -l test-file-formats.scm -c "(exit (run-test))"
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-file-formats.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,62 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; test-file-formats.scm
-;; test the QIF file data format checker.
-;; read each file, check field formats, compare with truth.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(debug-enable 'backtrace)
-
-(use-modules (gnucash gnc-module))
-(gnc:module-system-init)
-
-(gnc:module-load "gnucash/qif-io/core" 0)
-
-(define (run-test)
- (define (line-test filename title thunk compare)
- (let ((pass 0)
- (fail 0)
- (total 0))
- (with-input-from-file filename
- (lambda ()
- (let loop ((this-line (read)))
- (if (not (eof-object? this-line))
- (let* ((exception? #f)
- (result
- (catch #t
- (lambda ()
- (apply thunk (car this-line)))
- (lambda (key . rest)
- (set! exception? #t)
- (cons key rest))))
- (exception-expected? (cadr this-line))
- (correct-result (caddr this-line))
- (ok? (and (eq? exception? exception-expected?)
- (compare result correct-result))))
- (set! total (+ 1 total))
- (if ok?
- (set! pass (+ 1 pass))
- (begin
- (format #t "[fail] received ~S\n" result)
- (format #t " expected ~S\n"
- correct-result)
- (set! fail (+ 1 fail))))
- (loop (read)))))))
- (format #t "test ~A: pass=~S fail=~S\n" title pass fail)
- (= pass total)))
-
- (let ((all-pass #t))
- (define (fmt-check-test filename)
- (let ((qiffile (qif-io:make-empty-file)))
- (qif-io:read-file qiffile filename #f)
- (qif-io:check-possible-formats qiffile)
- (list (qif-io:bank-xtn->record (qif-io:file-bank-xtn-format qiffile))
- (qif-io:invst-xtn->record
- (qif-io:file-invst-xtn-format qiffile)))))
- (set! all-pass
- (and all-pass (line-test "data/file-formats-data.txt"
- "qif-io:check-possible-formats"
- fmt-check-test equal?)))
- all-pass))
-
-
-
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,2 +0,0 @@
-#! /bin/sh
-guile -l test-import-phase-1.scm -c "(run-test)"
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-import-phase-1.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,115 +0,0 @@
-;; test-import-phase-1
-;; import the file by direct transaction mapping (don't remove any
-;; duplicates)
-
-(debug-enable 'debug)
-(debug-enable 'backtrace)
-
-(define (_ arg) arg)
-(define (N_ arg) arg)
-
-(define (do-file filename)
- (use-modules (gnucash gnc-module))
- (gnc:module-system-init)
- (gnc:module-load "gnucash/qif-io/core" 0)
- ;; XXX: Need app/file to initialize (gnc:get-current-session/book)
-
- (let ((qiffile (qif-io:make-empty-file))
- (acct-table (qif-io:make-empty-acct-table))
- (session (gnc:get-current-session))
- (book (qof-session-get-book session))
- (com-table (gnc-commodity-table-new)))
-
- (gnc-commodity-table-add-default-data com-table book)
-
- ;; read the file and look at data formats. we need to do this
- ;; immediately when loading a file.
- (qif-io:read-file qiffile filename #f)
-
- ;; this will throw out an exception if there are no possible correct
- ;; interpretations. we'll correct the ambiguities
- (catch 'qif-io:ambiguous-data-format
- (lambda ()
- (qif-io:setup-data-formats qiffile))
- (lambda (key field-type field-name possible-formats continue-proc)
- (format #t "field format: n='~S' t='~S' v='~S' u='~S'\n"
- field-name field-type possible-formats
- (car possible-formats))
- (continue-proc (car possible-formats))))
-
- ;; now we need to figure out what information is missing from this
- ;; file.
- (if (qif-io:file-xtns-need-acct? qiffile)
- (qif-io:file-set-default-src-acct! qiffile filename))
-
- (let ((commodity (gnc-commodity-table-lookup com-table "ISO4217" "USD")))
-
- ;; import the bank transactions
- (for-each
- (lambda (xtn)
- (qif-io:bank-xtn-import xtn qiffile acct-table commodity))
- (qif-io:file-bank-xtns qiffile))
-
- ;; and the investment transactions
- (for-each
- (lambda (xtn)
- (qif-io:invst-xtn-import xtn qiffile acct-table commodity))
- (qif-io:file-invst-xtns qiffile))
-
- ;; build a gnucash account tree
- (let ((root (qif-io:acct-table-make-gnc-acct-tree
- acct-table qiffile commodity)))
- ;; write the file
- (let* ((name (format #f "file:~A.gnc" filename)))
- (format #t "using book name='~A'\n" name)
- (gnc-account-join-children (gnc-book-get-root book) root)
- (xaccAccountDestroy root)
- (gnc:session-begin session name #t #t)
- (gnc:session-save session)
- (gnc:session-end session)
- (gnc:file-quit)))))
- 0)
-
-(define (run-test)
- (define (line-test filename title thunk compare)
- (let ((pass 0)
- (fail 0)
- (total 0))
- (with-input-from-file filename
- (lambda ()
- (let loop ((this-line (read)))
- (if (not (eof-object? this-line))
- (let* ((exception? #f)
- (result
- (apply thunk (car this-line)))
-; (catch #t
-; (lambda ()
-; (apply thunk (car this-line)))
-; (lambda (key . rest)
-; (set! exception? #t)
-; (cons key rest))))
- (exception-expected? (cadr this-line))
- (correct-result (caddr this-line))
- (ok? (and (eq? exception? exception-expected?)
- (compare result correct-result))))
- (set! total (+ 1 total))
- (if ok?
- (set! pass (+ 1 pass))
- (begin
- (format #t "[fail] test ~S\n" (car this-line))
- (format #t " received ~S\n" result)
- (format #t " expected ~S\n"
- correct-result)
- (set! fail (+ 1 fail))))
- (loop (read)))))))
- (format #t "test ~A: pass=~S fail=~S\n" title pass fail)
- (= pass total)))
-
- (let ((all-pass #t))
- (set! all-pass
- (and all-pass (line-test "data/import-phase-1-data.txt"
- "import phase 1"
- do-file equal?)))
- (if all-pass
- (exit 0)
- (exit -1))))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,2 +0,0 @@
-#!/bin/sh
-guile -l ./test-load-module.scm -c "(run-test)"
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-load-module.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,12 +0,0 @@
-
-(use-modules (gnucash gnc-module))
-(gnc:module-system-init)
-
-(define (run-test)
- (if (gnc:module-load "gnucash/qif-io/core" 0)
- (begin
- (display "ok\n")
- (exit 0))
- (begin
- (display "failed\n")
- (exit -1))))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,2 +0,0 @@
-#!/bin/sh
-guile -l test-parser.scm -c "(exit (run-test))"
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-parser.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,81 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; test-parser.scm
-;;
-;; test the QIF parser. the data files are just scheme data; the
-;; first element is the arg to be parsed, the second indicates
-;; whether an exception is expected, and the third indicates either
-;; the return value (if no exception) or the type of exception and
-;; args. For example, for the date file,
-;; ("02/01/2001" #f (2 1 2001))
-;; (#f #t (qif-io:arg-type string #f))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(use-modules (gnucash gnc-module))
-(gnc:module-system-init)
-
-(gnc:module-load "gnucash/qif-io/core" 0)
-
-(debug-enable 'debug)
-(debug-enable 'backtrace)
-
-(define (run-test)
- (define (line-test filename title thunk compare)
- (let ((pass 0)
- (fail 0)
- (total 0))
- (with-input-from-file filename
- (lambda ()
- (let loop ((this-line (read)))
- (if (not (eof-object? this-line))
- (let* ((exception? #f)
- (result
- (catch #t
- (lambda ()
- (apply thunk (car this-line)))
- (lambda (key . rest)
- (set! exception? #t)
- (cons key rest))))
- (exception-expected? (cadr this-line))
- (correct-result (caddr this-line))
- (ok? (and (eq? exception? exception-expected?)
- (compare result correct-result))))
- (set! total (+ 1 total))
- (if ok?
- (set! pass (+ 1 pass))
- (begin
- (format #t "[fail] received ~S\n" result)
- (format #t " expected ~S\n"
- correct-result)
- (set! fail (+ 1 fail))))
- (loop (read)))))))
- (format #t "test ~A: pass=~S fail=~S\n" title pass fail)
- (= pass total)))
-
- (let ((all-pass #t))
- (define (parse-number/format num fmt)
- (let* ((gncn (qif-io:parse-number/format num fmt))
- (nstr (gnc-numeric-to-string gncn)))
- nstr))
-
- ;; test category reading
- (set! all-pass
- (and all-pass (line-test "data/category-data.txt" "parse-category"
- qif-io:parse-category equal?)))
- ;; date parsing
- (set! all-pass
- (and all-pass (line-test "data/date-data.txt" "parse-date/format"
- qif-io:parse-date/format equal?)))
- (set! all-pass
- (and all-pass (line-test "data/date-format-data.txt"
- "check-date-format"
- qif-io:check-date-format equal?)))
-
- ;; number parsing
- (set! all-pass
- (and all-pass (line-test "data/number-data.txt" "parse-number/format"
- parse-number/format equal?)))
- (set! all-pass
- (and all-pass (line-test "data/number-format-data.txt"
- "check-number-format"
- qif-io:check-number-format equal?)))
- all-pass))
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,2 +0,0 @@
-#!/bin/sh
-guile -l ./test-reader.scm -c "(exit (run-test))"
Deleted: gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader.scm
===================================================================
--- gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader.scm 2011-12-09 14:53:37 UTC (rev 21695)
+++ gnucash/branches/2.4/src/import-export/qif-io-core/test/test-reader.scm 2011-12-09 23:10:58 UTC (rev 21696)
@@ -1,76 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; test-reader.scm
-;;
-;; test the QIF reader. see test-parser.scm for info on the structure
-;; of the test data files.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(use-modules (gnucash gnc-module))
-(gnc:module-system-init)
-
-(gnc:module-load "gnucash/qif-io/core" 0)
-
-(define (read-record-test qiffile)
- (let ((inport (open-input-file qiffile))
- (outport (open-output-file "/tmp/test-reader.tmp"))
- (record '())
- (eof? #f))
- (let loop ()
- (catch 'qif-io:parser-state
- (lambda ()
- (let ((record (qif-io:read-record inport)))
- (set! eof? (caddr record))
- (if (not eof?)
- (qif-io:write-record (car record) outport))))
- (lambda (key new-state)
- (format outport "!~A\n" new-state)))
- (if (not eof?)
- (loop)))
- (close-output-port outport)
- (close-input-port inport)
- (system (format #f "diff -b -I \"\\^*\" ~A /tmp/test-reader.tmp"
- qiffile))))
-
-
-(define (run-test)
- (define (line-test filename title thunk compare)
- (let ((pass 0)
- (fail 0)
- (total 0))
- (with-input-from-file filename
- (lambda ()
- (let loop ((this-line (read)))
- (if (not (eof-object? this-line))
- (let* ((exception? #f)
- (result
- (catch #t
- (lambda ()
- (apply thunk (car this-line)))
- (lambda (key . rest)
- (set! exception? #t)
- (cons key rest))))
- (exception-expected? (cadr this-line))
- (correct-result (caddr this-line))
- (ok? (and (eq? exception? exception-expected?)
- (compare result correct-result))))
- (set! total (+ 1 total))
- (if ok?
- (set! pass (+ 1 pass))
- (begin
- (format #t "[fail] received ~S\n" result)
- (format #t " expected ~S\n"
- correct-result)
- (set! fail (+ 1 fail))))
- (loop (read)))))))
- (format #t "test ~A: pass=~S fail=~S\n" title pass fail)
- (= pass total)))
-
- (let ((all-pass #t))
- ;; test record reading / writing
- (set! all-pass
- (and all-pass (line-test "data/reader-data.txt" "read-record"
- read-record-test equal?)))
- all-pass))
-
-
-
More information about the gnucash-changes
mailing list