mirror of
https://github.com/Gnucash/gnucash.git
synced 2024-11-26 19:00:18 -06:00
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. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@21646 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
John Ralls
parent
db9d8ee570
commit
732f9651fc
@ -1285,8 +1285,6 @@ AC_CONFIG_FILES(
|
||||
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
|
||||
|
||||
@ -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\"
|
||||
@ -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.
|
||||
|
||||
@ -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;
|
||||
}
|
||||
@ -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))
|
||||
@ -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))
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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)
|
||||
@ -1,350 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; qif-objects.scm
|
||||
;;; record type definitions for QIF objects.
|
||||
;;;
|
||||
;;; Bill Gribble <grib@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))
|
||||
|
||||
|
||||
@ -1,639 +0,0 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; qif-parse.scm
|
||||
;;; routines to parse values and dates in QIF files.
|
||||
;;;
|
||||
;;; Bill Gribble <grib@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)))))
|
||||
@ -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 '())))
|
||||
|
||||
|
||||
|
||||
@ -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}
|
||||
@ -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))
|
||||
|
||||
@ -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"))
|
||||
@ -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"))
|
||||
|
||||
|
||||
@ -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))
|
||||
()))
|
||||
@ -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)
|
||||
@ -1,3 +0,0 @@
|
||||
(("1,000.00" decimal) #f "100000/100")
|
||||
(("1,000.01" decimal) #f "100001/100")
|
||||
(("1,000" decimal) #f "1000/1")
|
||||
@ -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))
|
||||
@ -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)
|
||||
@ -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)
|
||||
@ -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: -->
|
||||
@ -1,2 +0,0 @@
|
||||
#!/bin/sh
|
||||
guile -l test-file-formats.scm -c "(exit (run-test))"
|
||||
@ -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))
|
||||
|
||||
|
||||
|
||||
@ -1,2 +0,0 @@
|
||||
#! /bin/sh
|
||||
guile -l test-import-phase-1.scm -c "(run-test)"
|
||||
@ -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))))
|
||||
@ -1,2 +0,0 @@
|
||||
#!/bin/sh
|
||||
guile -l ./test-load-module.scm -c "(run-test)"
|
||||
@ -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))))
|
||||
@ -1,2 +0,0 @@
|
||||
#!/bin/sh
|
||||
guile -l test-parser.scm -c "(exit (run-test))"
|
||||
@ -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))
|
||||
@ -1,2 +0,0 @@
|
||||
#!/bin/sh
|
||||
guile -l ./test-reader.scm -c "(exit (run-test))"
|
||||
@ -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))
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user