IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Bill G's qif importer patch. Robert G Merkel's transaction report patch.

Browse Source 
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2390 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas 2000-05-30 06:03:10 +00:00
parent fcedfb925a
commit a5a032b618
16 changed files with 1999 additions and 2013 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
ChangeLog
View File

@ -1,3 +1,13 @@
2000-05-29 Robert Graham Merkel <rgmerk@mira.net>
* src/scm/report/transaction-report-2.scm (make-account-subheading):
added the ability to display balances at start-of-report date
when sorting by accounts. Also replaced gnc:split-get-amount
(which doesn't exist) with gnc:split-get-value for amount sorting.
* doc/guile-hackers.txt: Added pointers to g-wrap now that it's
not part of the main gnucash distribution.
2000-05-24 Dave Peticolas <peticola@cs.ucdavis.edu>
* src/SplitLedger.c: some simplification, some additional

16
doc/guile-hackers.txt
View File

@ -53,13 +53,15 @@ and other resources.
g-wrap
------
g-wrap is the tool used to automate the wrapping of C functions
to make them callable from the guile code. Gnucash installs
its own local copy of g-wrap. Documentation in info format
is available in gnucash/lib/g-wrap/doc/g-wrap.info. Available
C functions are wrapped in gnucash/src/g-wrap/gnc.gwp. Pointers
are wrapped using some stuff in gnucash/lib/g-wrap/guile/pointer.scm
which is not documented but looks reasonably straightforward.
g-wrap is the tool used to automate the wrapping of C functions to
make them callable from the guile code. g-wrap is now maintained by
Rob Browning and is available from ftp://ftp.gnucash.org/pub/g-wrap,
or as a Debian package from http://www.cs.mu.oz.au/~rgmerk/software.
Documentation in info format is distributed as part of the package.
Available C functions are wrapped in gnucash/src/g-wrap/gnc.gwp.
Pointers are wrapped using some stuff in
gnucash/lib/g-wrap/guile/pointer.scm which is not documented but looks
reasonably straightforward.
Garbage collection:

4
src/gnome/account-tree.c
View File

@ -125,8 +125,8 @@ gnc_account_tree_init(GNCAccountTree *tree)
gnc_account_tree_set_view_info_real(tree);
gtk_ctree_construct(GTK_CTREE(tree),
tree->num_columns, 0,
tree->column_headings);
tree->num_columns, 0,
(gchar **) tree->column_headings);
gtk_clist_set_shadow_type(GTK_CLIST(tree), GTK_SHADOW_IN);
gtk_clist_column_titles_passive(GTK_CLIST(tree));

212
src/gnome/dialog-qif-import.c
View File

@ -27,6 +27,8 @@
#include <gnome.h>
#include <stdio.h>
#include <sys/time.h>
#include <unistd.h>
#include <guile/gh.h>
@ -46,16 +48,11 @@
#include "query-user.h"
#include "util.h"
#define _QIF_IMPORT_NUM_RADIX_FORMATS 3
#define _QIF_IMPORT_NUM_DATE_FORMATS 5
struct _qifimportwindow
{
/* on the Files tab */
GtkWidget * dialog;
GtkWidget * currency_entry;
GtkWidget * radix_picker;
GtkWidget * date_picker;
GtkWidget * filename_entry;
GtkWidget * acct_auto_button;
GtkWidget * acct_entry;
@ -90,9 +87,6 @@ QIFImportWindow *
gnc_ui_qif_import_dialog_make()
{
QIFImportWindow * retval;
GtkWidget * menu;
GtkWidget * active;
int i;
SCM load_map_prefs;
SCM mapping_info;
@ -110,10 +104,6 @@ gnc_ui_qif_import_dialog_make()
retval->currency_entry =
gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_currency_entry");
retval->radix_picker =
gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_radix_picker");
retval->date_picker =
gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_date_picker");
retval->filename_entry =
gtk_object_get_data(GTK_OBJECT(retval->dialog), "qif_filename_entry");
retval->acct_auto_button =
@ -153,30 +143,6 @@ gnc_ui_qif_import_dialog_make()
gtk_entry_set_text(GTK_ENTRY(retval->currency_entry),
gh_scm2newstr(default_currency, &scm_strlen));
/* repair the option menus to associate "option_index" with the
* index number for each menu item */
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(retval->radix_picker));
for(i = 0; i < _QIF_IMPORT_NUM_RADIX_FORMATS; i++) {
gtk_option_menu_set_history(GTK_OPTION_MENU(retval->radix_picker), i);
active = gtk_menu_get_active(GTK_MENU(menu));
gtk_object_set_data(GTK_OBJECT(active), "option_index",
GINT_TO_POINTER(i));
}
gtk_option_menu_set_history(GTK_OPTION_MENU(retval->radix_picker), 0);
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(retval->date_picker));
for(i = 0; i < _QIF_IMPORT_NUM_DATE_FORMATS; i++) {
gtk_option_menu_set_history(GTK_OPTION_MENU(retval->date_picker), i);
active = gtk_menu_get_active(GTK_MENU(menu));
gtk_object_set_data(GTK_OBJECT(active),
"option_index",
GINT_TO_POINTER(i));
}
gtk_option_menu_set_history(GTK_OPTION_MENU(retval->date_picker), 0);
gtk_widget_show_all(retval->dialog);
return retval;
@ -223,8 +189,6 @@ gnc_ui_qif_import_select_file_cb(GtkButton * button,
new_file_name = fileBox(_("Select QIF File"), "*.qif");
if(new_file_name && (access(new_file_name, R_OK) == 0)) {
/* set the filename entry for what was selected */
@ -243,17 +207,7 @@ gnc_ui_qif_import_select_file_cb(GtkButton * button,
if(wind->acct_entry) {
gtk_entry_set_text(GTK_ENTRY(wind->acct_entry),
"");
}
/* radix and date formats are auto-determined by default */
if(wind->date_picker) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker),
0);
}
if(wind->radix_picker) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker),
0);
}
}
}
}
@ -262,13 +216,13 @@ gnc_ui_qif_import_select_file_cb(GtkButton * button,
* gnc_ui_qif_import_load_file_cb
*
* Invoked when the "load file" button is clicked on the first page of
* the QIF Import notebook. Filename, currency, radix format, and
* the QIF Import notebook. Filename, currency, and
* date format are read from the UI and passed to the Scheme side.
\********************************************************************/
void
gnc_ui_qif_import_load_file_cb (GtkButton *button,
gpointer user_data) {
gnc_ui_qif_import_load_file_cb(GtkButton * button, gpointer user_data) {
GtkWidget * dialog = GTK_WIDGET(user_data);
QIFImportWindow * wind =
gtk_object_get_data(GTK_OBJECT(dialog), "qif_window_struct");
@ -277,37 +231,21 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button,
char * qif_account;
char * currency;
char * error_string = NULL;
int radix_format;
int date_format;
GtkWidget * menu;
GtkWidget * menuitem;
struct timeval start, end;
SCM make_qif_file, qif_file_load, qif_file_loaded, unload_qif_file;
SCM scm_filename, scm_currency, scm_radix, scm_date, scm_qif_account;
SCM qif_file_parse;
SCM scm_filename, scm_currency, scm_qif_account;
SCM scm_qiffile;
SCM imported_files = SCM_EOL;
SCM load_return;
SCM load_return, parse_return;
char * radix_symbols [] = { "unknown", "decimal", "comma" };
char * date_symbols [] = { "unknown", "m-d-y", "d-m-y",
"y-m-d", "y-d-m" };
/* get the UI elements */
path_to_load = gtk_entry_get_text(GTK_ENTRY(wind->filename_entry));
currency = gtk_entry_get_text(GTK_ENTRY(wind->currency_entry));
qif_account = gtk_entry_get_text(GTK_ENTRY(wind->acct_entry));
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(wind->radix_picker));
menuitem = gtk_menu_get_active(GTK_MENU(menu));
radix_format = GPOINTER_TO_INT(gtk_object_get_data(GTK_OBJECT(menuitem),
"option_index"));
menu = gtk_option_menu_get_menu(GTK_OPTION_MENU(wind->date_picker));
menuitem = gtk_menu_get_active(GTK_MENU(menu));
date_format = GPOINTER_TO_INT(gtk_object_get_data(GTK_OBJECT(menuitem),
"option_index"));
if(strlen(path_to_load) == 0) {
gnc_error_dialog_parented(GTK_WINDOW(wind->dialog),
_("You must specify a file to load."));
@ -320,6 +258,7 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button,
/* find the make and load functions. */
make_qif_file = gh_eval_str("make-qif-file");
qif_file_load = gh_eval_str("qif-file:read-file");
qif_file_parse = gh_eval_str("qif-file:parse-fields");
qif_file_loaded = gh_eval_str("qif-dialog:qif-file-loaded?");
unload_qif_file = gh_eval_str("qif-dialog:unload-qif-file");
@ -334,8 +273,6 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button,
/* convert args */
scm_filename = gh_str02scm(path_to_load);
scm_currency = gh_str02scm(currency);
scm_radix = gh_symbol2scm(radix_symbols[radix_format]);
scm_date = gh_symbol2scm(date_symbols[date_format]);
if(gtk_toggle_button_get_active
(GTK_TOGGLE_BUTTON(wind->acct_auto_button))) {
@ -364,46 +301,88 @@ gnc_ui_qif_import_load_file_cb (GtkButton *button,
/* turn on the busy cursor */
gnc_set_busy_cursor(NULL);
gettimeofday(&start, NULL);
/* create the <qif-file> object */
scm_qiffile = gh_apply(make_qif_file,
SCM_LIST4(scm_qif_account, scm_radix,
scm_date, scm_currency));
SCM_LIST2(scm_qif_account, scm_currency));
imported_files =
gh_cons(scm_qiffile, imported_files);
wind->selected_file = scm_qiffile;
/* I think I have to do this since it's a global but not in
* guile-space */
scm_protect_object(wind->selected_file);
load_return = gh_call2(qif_file_load, gh_car(imported_files),
scm_filename);
/* import the file into it */
if(load_return != SCM_BOOL_T) {
if(gh_list_p(load_return)) {
asprintf(&error_string,
QIF_LOAD_FAILED_FORMAT_MSG,
gh_scm2newstr(gh_cadr(load_return), NULL));
}
else {
error_string = QIF_LOAD_FAILED_DEFAULT_MSG;
}
/* a list returned is (#f error-message) for an error,
* (#t error-message) for a warning */
if(gh_list_p(load_return) &&
(gh_car(load_return) == SCM_BOOL_T)) {
asprintf(&error_string,
QIF_LOAD_WARNING_FORMAT_MSG,
gh_scm2newstr(gh_cadr(load_return), NULL));
gnc_warning_dialog_parented(GTK_WIDGET(wind->dialog), error_string);
}
if((load_return != SCM_BOOL_T) &&
(!gh_list_p(load_return) ||
(gh_car(load_return) != SCM_BOOL_T))) {
asprintf(&error_string,
QIF_LOAD_FAILED_FORMAT_MSG,
gh_scm2newstr(gh_cadr(load_return), NULL));
gnc_error_dialog_parented(GTK_WINDOW(wind->dialog), error_string);
imported_files =
gh_call2(unload_qif_file, scm_filename, imported_files);
}
else {
parse_return = gh_call1(qif_file_parse, gh_car(imported_files));
if(gh_list_p(parse_return) &&
(gh_car(parse_return) == SCM_BOOL_T)) {
asprintf(&error_string,
QIF_PARSE_WARNING_FORMAT_MSG,
gh_scm2newstr(gh_cadr(parse_return), NULL));
gnc_warning_dialog_parented(GTK_WIDGET(wind->dialog), error_string);
}
if((parse_return != SCM_BOOL_T) &&
(!gh_list_p(parse_return) ||
(gh_car(parse_return) != SCM_BOOL_T))) {
asprintf(&error_string,
QIF_PARSE_FAILED_FORMAT_MSG,
gh_scm2newstr(gh_cadr(parse_return), NULL));
gnc_error_dialog_parented(GTK_WINDOW(wind->dialog), error_string);
imported_files =
gh_call2(unload_qif_file, scm_filename, imported_files);
}
}
wind->imported_files = imported_files;
scm_protect_object(wind->imported_files);
gettimeofday(&end, NULL);
printf("QIF file load took %f ms total.\n",
1000.0*(end.tv_sec - start.tv_sec) +
.001*(end.tv_usec - start.tv_usec));
gettimeofday(&start, NULL);
/* now update the Accounts and Categories pages in the notebook */
update_file_page(wind);
update_accounts_page(wind);
update_categories_page(wind);
gettimeofday(&end, NULL);
printf("QIF Category/account tab update took %f ms.\n",
1000.0*(end.tv_sec - start.tv_sec) +
.001*(end.tv_usec - start.tv_usec));
gettimeofday(&end, NULL);
/* turn back the cursor */
gnc_unset_busy_cursor(NULL);
}
@ -637,13 +616,9 @@ update_file_page(QIFImportWindow * wind) {
static void
update_file_info(QIFImportWindow * wind, SCM qif_file) {
SCM qif_file_radix_format;
SCM qif_file_date_format;
SCM qif_file_currency;
SCM qif_file_path;
SCM qif_file_account;
SCM scm_radix_format;
SCM scm_date_format;
SCM scm_currency;
SCM scm_qif_account;
SCM scm_qif_path;
@ -651,16 +626,12 @@ update_file_info(QIFImportWindow * wind, SCM qif_file) {
int scm_strlen;
/* look up the <qif-file> methods */
qif_file_radix_format = gh_eval_str("qif-file:radix-format");
qif_file_date_format = gh_eval_str("qif-file:date-format");
qif_file_currency = gh_eval_str("qif-file:currency");
qif_file_path = gh_eval_str("qif-file:path");
qif_file_account = gh_eval_str("qif-file:account");
qif_file_account = gh_eval_str("qif-file:default-account");
/* make sure the methods are loaded */
if((!gh_procedure_p(qif_file_radix_format)) ||
(!gh_procedure_p(qif_file_date_format)) ||
(!gh_procedure_p(qif_file_currency)) ||
if((!gh_procedure_p(qif_file_currency)) ||
(!gh_procedure_p(qif_file_account)) ||
(!gh_procedure_p(qif_file_path))) {
gnc_error_dialog_parented(GTK_WINDOW(wind->dialog),
@ -674,11 +645,7 @@ update_file_info(QIFImportWindow * wind, SCM qif_file) {
scm_protect_object(qif_file);
/* get the radix/date formats, currency etc from the Scheme side */
scm_radix_format = gh_call1(qif_file_radix_format,
qif_file);
scm_date_format = gh_call1(qif_file_date_format,
qif_file);
/* get the currency etc from the Scheme side */
scm_currency = gh_call1(qif_file_currency,
qif_file);
scm_qif_path = gh_call1(qif_file_path,
@ -697,42 +664,7 @@ update_file_info(QIFImportWindow * wind, SCM qif_file) {
gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(wind->acct_auto_button),
FALSE);
gtk_entry_set_text(GTK_ENTRY(wind->acct_entry),
gh_scm2newstr(scm_qif_account, &scm_strlen));
/* set the option menu selections */
if(!strcmp(gh_symbol2newstr(scm_radix_format, &scm_strlen),
"unknown")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), 0);
}
else if(!strcmp(gh_symbol2newstr(scm_radix_format, &scm_strlen),
"decimal")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), 1);
}
else if(!strcmp(gh_symbol2newstr(scm_radix_format, &scm_strlen),
"comma")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->radix_picker), 2);
}
if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen),
"unknown")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 0);
}
else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen),
"m-d-y")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 1);
}
else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen),
"d-m-y")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 2);
}
else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen),
"y-m-d")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 3);
}
else if(!strcmp(gh_symbol2newstr(scm_date_format, &scm_strlen),
"y-d-m")) {
gtk_option_menu_set_history(GTK_OPTION_MENU(wind->date_picker), 4);
}
gh_scm2newstr(scm_qif_account, &scm_strlen));
}
}

67
src/gnome/glade-gnc-dialogs.c
View File

@ -35,8 +35,6 @@ create_QIF_File_Import_Dialog (void)
GtkWidget *label1;
GtkWidget *label679;
GtkWidget *currency_label;
GtkWidget *radix_format_label;
GtkWidget *date_format_label;
GtkWidget *vbox4;
GtkWidget *hbox33;
GtkWidget *qif_filename_entry;
@ -45,11 +43,6 @@ create_QIF_File_Import_Dialog (void)
GtkWidget *qif_account_entry;
GtkWidget *qif_account_auto_check;
GtkWidget *qif_currency_entry;
GtkWidget *qif_radix_picker;
GtkWidget *qif_radix_picker_menu;
GtkWidget *glade_menuitem;
GtkWidget *qif_date_picker;
GtkWidget *qif_date_picker_menu;
GtkWidget *hbox9;
GtkWidget *add_file_button;
GtkWidget *label69;
@ -180,24 +173,6 @@ create_QIF_File_Import_Dialog (void)
gtk_label_set_justify (GTK_LABEL (currency_label), GTK_JUSTIFY_RIGHT);
gtk_misc_set_alignment (GTK_MISC (currency_label), 1, 0.5);
radix_format_label = gtk_label_new (_("Radix format:"));
gtk_widget_ref (radix_format_label);
gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "radix_format_label", radix_format_label,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (radix_format_label);
gtk_box_pack_start (GTK_BOX (vbox3), radix_format_label, FALSE, FALSE, 0);
gtk_label_set_justify (GTK_LABEL (radix_format_label), GTK_JUSTIFY_RIGHT);
gtk_misc_set_alignment (GTK_MISC (radix_format_label), 1, 0.5);
date_format_label = gtk_label_new (_("Date format:"));
gtk_widget_ref (date_format_label);
gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "date_format_label", date_format_label,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (date_format_label);
gtk_box_pack_start (GTK_BOX (vbox3), date_format_label, FALSE, FALSE, 0);
gtk_label_set_justify (GTK_LABEL (date_format_label), GTK_JUSTIFY_RIGHT);
gtk_misc_set_alignment (GTK_MISC (date_format_label), 1, 0.5);
vbox4 = gtk_vbox_new (TRUE, 0);
gtk_widget_ref (vbox4);
gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "vbox4", vbox4,
@ -256,48 +231,6 @@ create_QIF_File_Import_Dialog (void)
gtk_widget_show (qif_currency_entry);
gtk_box_pack_start (GTK_BOX (vbox4), qif_currency_entry, FALSE, FALSE, 0);
qif_radix_picker = gtk_option_menu_new ();
gtk_widget_ref (qif_radix_picker);
gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "qif_radix_picker", qif_radix_picker,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (qif_radix_picker);
gtk_box_pack_start (GTK_BOX (vbox4), qif_radix_picker, FALSE, FALSE, 0);
qif_radix_picker_menu = gtk_menu_new ();
glade_menuitem = gtk_menu_item_new_with_label (_("Autodetect"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_radix_picker_menu), glade_menuitem);
glade_menuitem = gtk_menu_item_new_with_label (_("Decimal (1,000.00)"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_radix_picker_menu), glade_menuitem);
glade_menuitem = gtk_menu_item_new_with_label (_("Comma (1.000,00)"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_radix_picker_menu), glade_menuitem);
gtk_option_menu_set_menu (GTK_OPTION_MENU (qif_radix_picker), qif_radix_picker_menu);
qif_date_picker = gtk_option_menu_new ();
gtk_widget_ref (qif_date_picker);
gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "qif_date_picker", qif_date_picker,
(GtkDestroyNotify) gtk_widget_unref);
gtk_widget_show (qif_date_picker);
gtk_box_pack_start (GTK_BOX (vbox4), qif_date_picker, FALSE, FALSE, 0);
qif_date_picker_menu = gtk_menu_new ();
glade_menuitem = gtk_menu_item_new_with_label (_("Autodetect "));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem);
glade_menuitem = gtk_menu_item_new_with_label (_("MM/DD/YYYY"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem);
glade_menuitem = gtk_menu_item_new_with_label (_("DD/MM/YYYY"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem);
glade_menuitem = gtk_menu_item_new_with_label (_("YYYY/MM/DD"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem);
glade_menuitem = gtk_menu_item_new_with_label (_("YYYY/DD/MM"));
gtk_widget_show (glade_menuitem);
gtk_menu_append (GTK_MENU (qif_date_picker_menu), glade_menuitem);
gtk_option_menu_set_menu (GTK_OPTION_MENU (qif_date_picker), qif_date_picker_menu);
hbox9 = gtk_hbox_new (TRUE, 0);
gtk_widget_ref (hbox9);
gtk_object_set_data_full (GTK_OBJECT (QIF_File_Import_Dialog), "hbox9", hbox9,

956
src/gnome/gnc-dialogs.glade
View File

File diff suppressed because it is too large Load Diff

7
src/messages_i18n.h
View File

@ -123,9 +123,10 @@
"If this is not right, remove the .LCK file " \
"and try again.")
#define GNOME_PRINT_MSG _("You need to install the gnome-print library.")
#define QIF_LOAD_FAILED_FORMAT_MSG _("QIF file load failed. %s")
#define QIF_LOAD_FAILED_DEFAULT_MSG _("QIF file load failed. Check "\
"settings and reload.")
#define QIF_LOAD_FAILED_FORMAT_MSG _("QIF file load failed:\n%s")
#define QIF_LOAD_WARNING_FORMAT_MSG _("QIF file load warning:\n%s")
#define QIF_PARSE_FAILED_FORMAT_MSG _("QIF file parse failed:\n%s")
#define QIF_PARSE_WARNING_FORMAT_MSG _("QIF file parse warning:\n%s")
#define QUOTE_SRC_MSG _("The source for price quotes")
#define RECN_BALN_WARN _("The account is not balanced.\n" \

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

@ -22,6 +22,20 @@
(#t
(list-set! old-map 5 new-descript)))))
(define (default-dividend-acct security)
(string-append "Dividends:" security))
(define (default-interest-acct security)
(string-append "Interest:" security))
(define (default-cglong-acct security)
(string-append "Cap. gain (long):" security))
(define (default-cgshort-acct security)
(string-append "Cap. gain (short):" security))
(define (default-equity-account) "Retained Earnings")
(define (default-equity-category) "[Retained Earnings]")
;; the account-display is a 3-columned list of accounts in the QIF
;; import dialog (the "Account" page of the notebook). Column 1 is
@ -63,10 +77,10 @@
(qif-file:accounts file))
;; then make an implicit account entry for the file
(if (and (qif-file:account file)
(qif-file:account-type file))
(if (and (qif-file:default-account file)
(qif-file:default-account-type file))
; (not (eq? (qif-file:account-type file) GNC-STOCK-TYPE)))
(let ((entry (hash-ref acct-hash (qif-file:account file))))
(let ((entry (hash-ref acct-hash (qif-file:default-account file))))
(if entry
;; increment the xtn count in place
(list-set! entry 4
@ -75,83 +89,174 @@
;; make a new hash table entry for the account
;; make it a Bank account by default.
(hash-set!
acct-hash (qif-file:account file)
acct-hash (qif-file:default-account file)
(append (qif-import:guess-acct
(qif-file:account file)
(qif-file:default-account file)
(list GNC-BANK-TYPE
GNC-CCARD-TYPE)
gnc-acct-info)
(list
(qif-file:default-acct-xtns file)
#f)))))))
(list 0 #f)))))))
qif-files)
;; now make the second pass through the files, looking at the
;; transactions. Hopefully the accounts are all there already.
;; stock accounts can have both a category/account and another
;; account ref from the security name.
;; account ref from the security name.
(for-each
(lambda (file)
(for-each
(lambda (xtn)
(let ((bank-xtn? (qif-xtn:bank-xtn? xtn))
(stock-acct (qif-xtn:security-name xtn))
(let ((stock-acct (qif-xtn:security-name xtn))
(action (qif-xtn:number xtn))
(action-sym #f)
(from-acct (qif-xtn:from-acct xtn))
(qif-account #f)
(qif-account-types #f)
(entry #f))
(if (not bank-xtn?)
(if (string? action)
(set! action-sym (qif-parse:parse-action-field action)))
(if (and stock-acct action-sym)
;; stock transactions are weird. there can be several
;; accounts associated with stock xtns: the security,
;; the brokerage, a dividend account, a long-term CG
;; account, a short-term CG account, an interest
;; account. Make sure all of the right ones get stuck
;; in the map.
(begin
(set! entry (hash-ref acct-hash stock-acct))
;; first: figure out what the near-end account is.
;; it's generally the security account, but could be
;; an interest, dividend, or CG account.
(case action-sym
((buy buyx sell sellx reinvdiv reinvsh reinvsg
reinvlg shrsin)
(set! qif-account stock-acct)
(set! qif-account-types (list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE)))
((div cgshort cglong intinc)
(set! qif-account from-acct)
(set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE)))
((divx cgshortx cglongx intincx)
(set! qif-account
(qif-split:category
(car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE)))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; now reference the near-end account
(set! entry (hash-ref acct-hash qif-account))
(if entry
(list-set! entry 4
(+ 1 (list-ref entry 4)))
(hash-set! acct-hash stock-acct
(hash-set! acct-hash qif-account
(append (qif-import:guess-acct
stock-acct
(list GNC-STOCK-TYPE
GNC-MUTUAL-TYPE)
qif-account qif-account-types
gnc-acct-info)
(list 1 xtn)))))))
;; if there's a from-acct, reference it
(let ((from (qif-xtn:from-acct xtn))
(entry #f))
(if from
(begin
(set! entry (hash-ref acct-hash from))
(list 1 xtn))))
;; now figure out the other end of the transaction.
;; the far end will be the brokerage for buy, sell,
;; etc, or the "L"-referenced account for buyx,
;; sellx, etc, or an equity account for ShrsIn
(case action-sym
((buy sell)
(set! qif-account from-acct)
(set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE)))
((buyx sellx)
(set! qif-account
(qif-split:category
(car (qif-xtn:splits xtn))))
(set! qif-account-types (list GNC-BANK-TYPE
GNC-CCARD-TYPE)))
((cgshort cgshortx reinvsg reinvsh)
(set! qif-account
(default-cgshort-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE)))
((cglong cglongx reinvlg)
(set! qif-account
(default-cglong-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE)))
((intinc intincx reinvint)
(set! qif-account
(default-interest-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE)))
((div divx reinvdiv)
(set! qif-account
(default-dividend-acct stock-acct))
(set! qif-account-types (list GNC-INCOME-TYPE)))
((shrsin)
(set! qif-account
(default-equity-account))
(set! qif-account-types (list GNC-EQUITY-TYPE)))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; now reference the far-end account
(set! entry (hash-ref acct-hash qif-account))
(if entry
(list-set! entry 4
(+ 1 (list-ref entry 4)))
(hash-set! acct-hash from
(hash-set! acct-hash qif-account
(append (qif-import:guess-acct
from
qif-account qif-account-types
gnc-acct-info)
(list 1 xtn))))
;; if there's a commission, it will reference
;; a separate account on the far end.
)
;; non-stock transactions. these are a bit easier.
;; the near-end account (from) is always in the
;; transaction, and the far end(s) are in the splits.
(begin
(set! entry (hash-ref acct-hash from-acct))
(if entry
(list-set! entry 4
(+ 1 (list-ref entry 4)))
(hash-set! acct-hash from-acct
(append (qif-import:guess-acct
from-acct
(list
GNC-BANK-TYPE
GNC-CCARD-TYPE
GNC-STOCK-TYPE)
GNC-CCARD-TYPE)
gnc-acct-info)
(list 1 #f)))))))
;; iterate over the splits doing the same thing.
(for-each
(lambda (split)
(let ((xtn-is-acct (qif-split:category-is-account? split))
(xtn-acct #f)
(entry #f))
(if xtn-is-acct
(begin
(set! xtn-acct (qif-split:category split))
(set! entry (hash-ref acct-hash xtn-acct))
(if entry
(list-set! entry 4
(+ 1 (list-ref entry 4)))
(hash-set! acct-hash xtn-acct
(append (qif-import:guess-acct
xtn-acct
(list
GNC-BANK-TYPE
GNC-CCARD-TYPE
GNC-STOCK-TYPE)
gnc-acct-info)
(list 1 #f))))))))
(qif-xtn:splits xtn)))
(list 1 #f))))
;; iterate over the splits doing the same thing.
(for-each
(lambda (split)
(let ((xtn-is-acct (qif-split:category-is-account? split))
(xtn-acct #f)
(entry #f))
(if xtn-is-acct
(begin
(set! xtn-acct (qif-split:category split))
(set! entry (hash-ref acct-hash xtn-acct))
(if entry
(list-set! entry 4
(+ 1 (list-ref entry 4)))
(hash-set! acct-hash xtn-acct
(append (qif-import:guess-acct
xtn-acct
(list
GNC-BANK-TYPE
GNC-CCARD-TYPE)
gnc-acct-info)
(list 1 #f))))))))
(qif-xtn:splits xtn))))))
(qif-file:xtns file)))
qif-files)
@ -186,7 +291,6 @@
(define (qif-dialog:make-category-display qif-files gnc-acct-info)
(let ((cat-hash (make-hash-table 20))
(retval '()))
;; get the Cat entries from each file
(for-each
(lambda (file)

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

@ -7,14 +7,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:support "qif-import/qif-file.scm")
(gnc:depend "qif-import/qif-objects.scm")
(gnc:depend "qif-import/qif-parse.scm")
(gnc:depend "qif-import/qif-utils.scm")
(gnc:depend "qif-import/qif-objects.scm")
(gnc:depend "qif-import/qif-parse.scm")
(gnc:depend "qif-import/qif-utils.scm")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file:read-file self path
;; suck in all the transactions; if necessary, determine [guess]
;; radix format first.
;; suck in all the transactions; don't do any string interpretation,
;; just store the fields "raw".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-file:read-file self path)
@ -26,51 +26,57 @@
(default-split #f)
(first-xtn #f)
(ignore-accounts #f)
(return-val #t)
(line #f)
(tag #f)
(value #f)
(heinous-error #f)
(start-time #f)
(end-time #f)
(delimiters (string #\cr #\nl))
(valid-acct-types
'(type:bank type:cash
type:ccard type:invst
#{type:oth\ a}# #{type:oth\ l}#)))
(set! start-time (gettimeofday))
(with-input-from-file path
(lambda ()
(lambda ()
;; loop over lines
(let line-loop ()
(set! line (read-delimited (string #\nl #\cr)))
(set! line (read-delimited delimiters))
(if (and
(not (eof-object? line))
(>= (string-length line) 1))
(not (string=? line "")))
(begin
;; pick the 1-char tag off from the remainder of the line
(set! tag (string-ref line 0))
(set! value (substring line 1 (string-length line)))
(set! value (make-shared-substring line 1))
;; now do something with the line
(cond
;; the type switcher.
((eq? tag #\!)
(set! qstate-type (qif-file:parse-bang-field self value))
(cond ((member qstate-type valid-acct-types)
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split))
(qif-split:set-category! default-split "")
(qif-file:set-account-type!
self (qif-file:state-to-account-type
self qstate-type))
(set! first-xtn #t))
((eq? qstate-type 'type:class)
(set! current-xtn (make-qif-class)))
((eq? qstate-type 'type:cat)
(set! current-xtn (make-qif-cat)))
((eq? qstate-type 'account)
(set! current-xtn (make-qif-acct)))
((eq? qstate-type 'option:autoswitch)
(set! ignore-accounts #t))
((eq? qstate-type 'clear:autoswitch)
(set! ignore-accounts #f))))
(if
(eq? tag #\!)
(begin
(set! qstate-type (qif-parse:parse-bang-field value))
(case qstate-type
((type:bank type:cash type:ccard type:invst
#{type:oth\ a}# #{type:oth\ l}#)
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split))
(qif-split:set-category! default-split "")
(qif-file:set-default-account-type!
self (qif-parse:state-to-account-type qstate-type))
(set! first-xtn #t))
((type:class)
(set! current-xtn (make-qif-class)))
((type:cat)
(set! current-xtn (make-qif-cat)))
((account)
(set! current-xtn (make-qif-acct)))
((option:autoswitch)
(set! ignore-accounts #t))
((clear:autoswitch)
(set! ignore-accounts #f))))
;;; (#t
;;; (display "qif-file:read-file can't handle ")
;;; (write qstate-type)
@ -81,310 +87,211 @@
;; bank-account type transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((member qstate-type valid-acct-types)
(case tag
;; D : transaction date
((#\D)
(qif-xtn:set-date! current-xtn
(qif-file:parse-date self value)))
;; T : total amount
((#\T)
(qif-split:set-amount!
default-split (qif-file:parse-value/decimal self value))
(if (not (number? (qif-split:amount default-split)))
(begin
(display "value not a number : ")
(display value) (display " ")
(write (qif-split:amount default-split))
(newline))))
;; P : payee
((#\P)
(qif-xtn:set-payee! current-xtn
(qif-file:parse-string self value)))
;; A : address
;; multiple "A" lines are appended together with
;; newlines; some Quicken files have a lot of
;; A lines.
((#\A)
(qif-xtn:set-address!
current-xtn
(let ((current (qif-xtn:address current-xtn)))
(if (not (string? current))
(set! current ""))
(string-append
current "\n"
(qif-file:parse-string self value)))))
;; N : check number / transaction number /xtn direction
;; this could be a number or a string; no point in
;; keeping it numeric just yet.
((#\N)
(qif-xtn:set-number!
current-xtn (qif-file:parse-string self value)))
;; C : cleared flag
((#\C)
(qif-xtn:set-cleared!
current-xtn (qif-file:parse-cleared-field self value)))
;; M : memo
((#\M)
(qif-split:set-memo! default-split
(qif-file:parse-string self value)))
;; I : share price (stock transactions)
((#\I)
(qif-xtn:set-share-price!
current-xtn (qif-file:parse-value self value)))
;; Q : share price (stock transactions)
((#\Q)
(qif-xtn:set-num-shares!
current-xtn (qif-file:parse-value self value))
(qif-xtn:set-bank-xtn?! current-xtn #f))
;; Y : name of security (stock transactions)
((#\Y)
(qif-xtn:set-security-name!
current-xtn (qif-file:parse-string self value)))
;; O : adjustment (stock transactions)
((#\O)
(qif-xtn:set-adjustment!
current-xtn (qif-file:parse-value/decimal self value)))
;; L : category
((#\L)
(qif-split:set-category!
default-split (qif-file:parse-string self value)))
;; S : split category
((#\S)
(set! current-split (make-qif-split))
(qif-split:set-category!
current-split (qif-file:parse-string self value))
(qif-xtn:set-splits!
current-xtn
(cons current-split (qif-xtn:splits current-xtn))))
;; E : split memo (?)
((#\E)
(qif-split:set-memo!
current-split (qif-file:parse-string self value)))
;; $ : split amount (if there are splits)
((#\$)
;; if this is 'Type:Invst, I can't figure out
;; what the $ signifies. I'll do it later.
(if (not (eq? qstate-type 'type:invst))
(qif-split:set-amount!
current-split
(qif-file:parse-value/decimal self value))))
;; ^ : end-of-record
((#\^)
(if (qif-xtn:date current-xtn)
(begin
(if (not (qif-split:amount default-split))
(qif-split:set-amount! default-split 0.00))
(if (null? (qif-xtn:splits current-xtn))
(qif-xtn:set-splits! current-xtn
(list default-split)))
(if (and (not ignore-accounts)
current-account-name)
(qif-xtn:set-from-acct! current-xtn
current-account-name))
(qif-file:add-xtn! self current-xtn)))
; (begin
; (display "qif-file:read-file : discarding xtn")
; (newline)
; (qif-xtn:print current-xtn)))
(if (and first-xtn
(string? (qif-xtn:payee current-xtn))
(string=? (qif-xtn:payee current-xtn)
"Opening Balance")
(eq? (length (qif-xtn:splits current-xtn)) 1)
(qif-split:category-is-account?
(car (qif-xtn:splits current-xtn))))
(begin
(qif-file:set-account!
self (qif-split:category
(car (qif-xtn:splits current-xtn))))
(qif-split:set-category!
(car (qif-xtn:splits current-xtn))
"Opening Balance")))
;; some special love for stock transactions
(if (and (qif-xtn:security-name current-xtn)
(string? (qif-xtn:number current-xtn)))
(begin
(cond
((and
(or (string=? (qif-xtn:number current-xtn)
"ReinvDiv")
(string=? (qif-xtn:number current-xtn)
"ReinvLg")
(string=? (qif-xtn:number current-xtn)
"ReinvSh")
(string=? (qif-xtn:number current-xtn)
"Div"))
(string=?
"" (qif-split:category
(car
(qif-xtn:splits current-xtn)))))
(qif-split:set-category!
(car (qif-xtn:splits current-xtn))
"Dividend")
;; KLUDGE! for brokerage accounts
;; where Dividend pays into the
;; brokerage account.
(if (and (qif-xtn:bank-xtn? current-xtn)
(string?
(qif-xtn:security-name
current-xtn)))
(qif-xtn:set-payee!
current-xtn (qif-xtn:security-name
current-xtn))))
((or (string=? (qif-xtn:number current-xtn)
"SellX")
(string=? (qif-xtn:number current-xtn)
"Sell"))
(let ((shrs (qif-xtn:num-shares current-xtn)))
(cond ((string? shrs)
(qif-xtn:set-num-shares!
current-xtn
(string-append "-" shrs)))
((number? shrs)
(qif-xtn:set-num-shares!
current-xtn (- shrs)))))))))
(set! first-xtn #f)
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'type:class)
(case tag
;; N : name
((#\N)
(qif-class:set-name! current-xtn
(qif-file:parse-string self value)))
;; D : description
((#\D)
(qif-class:set-description!
current-xtn (qif-file:parse-string self value)))
;; end-of-record
((#\^)
(qif-file:add-class! self current-xtn)
(set! current-xtn (make-qif-class)))
(else
(display "qif-file:read-file : unknown Class slot ")
(display tag) (newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Account definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'account)
(case tag
((#\N)
(qif-acct:set-name! current-xtn
(qif-file:parse-string self value)))
((#\D)
(qif-acct:set-description!
current-xtn (qif-file:parse-string self value)))
((#\T)
(qif-acct:set-type!
current-xtn (qif-file:parse-acct-type self value)))
((#\L)
(qif-acct:set-limit!
current-xtn (qif-file:parse-value/decimal self value)))
;; B : budget amount. not really supported.
((#\B)
(qif-acct:set-budget!
current-xtn (qif-file:parse-value/decimal self value)))
((#\^)
(if (not ignore-accounts)
(set! current-account-name
(qif-acct:name current-xtn)))
(qif-file:add-account! self current-xtn)
;;; (qif-acct:print current-xtn)
(set! current-xtn (make-qif-acct)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Category (Cat) transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((eq? qstate-type 'type:cat)
(case tag
;; N : category name
((#\N)
(qif-cat:set-name! current-xtn
(qif-file:parse-string self value)))
;; D : category description
((#\D)
(qif-cat:set-description! current-xtn
(qif-file:parse-string
self value)))
;; E : is this a taxable category?
((#\T)
(qif-cat:set-taxable! current-xtn #t))
;; E : is this an expense category?
((#\E)
(qif-cat:set-expense-cat! current-xtn #t))
;; I : is this an income category?
((#\I)
(qif-cat:set-income-cat! current-xtn #t))
;; R : what is the tax rate (from some table?
;; seems to be an integer)
((#\R)
(qif-cat:set-tax-rate!
current-xtn (qif-file:parse-value/decimal self value)))
;; B : budget amount. not really supported.
((#\B)
(qif-cat:set-budget-amt!
current-xtn (qif-file:parse-value/decimal self value)))
;; end-of-record
((#\^)
(qif-file:add-cat! self current-xtn)
;;; (qif-cat:print current-xtn)
(set! current-xtn (make-qif-cat)))
(else
(display "qif-file:read-file : unknown Cat slot ")
(display tag) (newline))))
;; trying to sneak one by, eh?
(#t
(if (not qstate-type)
(begin
(display "line = ") (display line) (newline)
(display "qif-file:read-file : ")
(display "file does not appear to be a QIF file.")
(newline)
(set! heinous-error #t)))))
(case qstate-type
((type:bank type:cash type:ccard type:invst
#{type:oth\ a}# #{type:oth\ l}#)
(case tag
;; D : transaction date
((#\D)
(qif-xtn:set-date! current-xtn value))
;; T : total amount
((#\T)
(qif-split:set-amount! default-split value))
;; P : payee
((#\P)
(qif-xtn:set-payee! current-xtn value))
;; A : address
;; multiple "A" lines are appended together with
;; newlines; some Quicken files have a lot of
;; A lines.
((#\A)
(qif-xtn:set-address!
current-xtn
(let ((current (qif-xtn:address current-xtn)))
(if (not (string? current))
(set! current ""))
(string-append current "\n" value))))
;; N : check number / transaction number /xtn direction
;; this could be a number or a string; no point in
;; keeping it numeric just yet.
((#\N)
(qif-xtn:set-number! current-xtn value))
;; C : cleared flag
((#\C)
(qif-xtn:set-cleared! current-xtn value))
;; M : memo
((#\M)
(qif-split:set-memo! default-split value))
;; I : share price (stock transactions)
((#\I)
(qif-xtn:set-share-price! current-xtn value))
;; Q : share price (stock transactions)
((#\Q)
(qif-xtn:set-num-shares! current-xtn value))
;; Y : name of security (stock transactions)
((#\Y)
(qif-xtn:set-security-name! current-xtn value))
;; O : commission (stock transactions)
((#\O)
(qif-xtn:set-commission! current-xtn value))
;; L : category
((#\L)
(qif-split:set-category! default-split value))
;; S : split category
((#\S)
(set! current-split (make-qif-split))
(qif-split:set-category! current-split value)
(qif-xtn:set-splits!
current-xtn
(cons current-split (qif-xtn:splits current-xtn))))
;; E : split memo
((#\E)
(if current-split
(qif-split:set-memo! current-split value)))
;; $ : split amount (if there are splits)
((#\$)
(if current-split
(qif-split:set-amount! current-split value)))
;; ^ : end-of-record
((#\^)
(if (null? (qif-xtn:splits current-xtn))
(qif-xtn:set-splits! current-xtn
(list default-split)))
(if first-xtn
(begin
(qif-file:process-opening-balance-xtn
self current-xtn qstate-type)
(set! first-xtn #f)))
(if current-account-name
(qif-xtn:set-from-acct! current-xtn
current-account-name)
(qif-xtn:set-from-acct!
current-xtn (qif-file:default-account self)))
(if (qif-xtn:date current-xtn)
(qif-file:add-xtn! self current-xtn))
(set! current-xtn (make-qif-xtn))
(set! default-split (make-qif-split)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((type:class)
(case tag
;; N : name
((#\N)
(qif-class:set-name! current-xtn value))
;; D : description
((#\D)
(qif-class:set-description! current-xtn value))
;; end-of-record
((#\^)
(qif-file:add-class! self current-xtn)
(set! current-xtn (make-qif-class)))
(else
(display "qif-file:read-file : unknown Class slot ")
(display tag)
(display " .. continuing anyway.")
(newline))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Account definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((account)
(case tag
((#\N)
(qif-acct:set-name! current-xtn value))
((#\D)
(qif-acct:set-description! current-xtn value))
((#\T)
(qif-acct:set-type! current-xtn value))
((#\L)
(qif-acct:set-limit! current-xtn value))
((#\B)
(qif-acct:set-budget! current-xtn value))
((#\^)
(if (not ignore-accounts)
(set! current-account-name
(qif-acct:name current-xtn)))
(qif-file:add-account! self current-xtn)
(set! current-xtn (make-qif-acct)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Category (Cat) transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((type:cat)
(case tag
;; N : category name
((#\N)
(qif-cat:set-name! current-xtn value))
;; D : category description
((#\D)
(qif-cat:set-description! current-xtn value))
;; E : is this a taxable category?
((#\T)
(qif-cat:set-taxable! current-xtn #t))
;; E : is this an expense category?
((#\E)
(qif-cat:set-expense-cat! current-xtn #t))
;; I : is this an income category?
((#\I)
(qif-cat:set-income-cat! current-xtn #t))
;; R : what is the tax rate (from some table?
;; seems to be an integer)
((#\R)
(qif-cat:set-tax-rate! current-xtn value))
;; B : budget amount. not really supported.
((#\B)
(qif-cat:set-budget-amt! current-xtn value))
;; end-of-record
((#\^)
(qif-file:add-cat! self current-xtn)
(set! current-xtn (make-qif-cat)))
(else
(display "qif-file:read-file : unknown Cat slot ")
(display tag)
(display " .. continuing anyway") (newline))))
;; trying to sneak one by, eh?
(else
(if (not qstate-type)
(begin
(display "line = ") (display line) (newline)
(display "qif-file:read-file : ")
(display "file does not appear to be a QIF file.")
(newline)
(set!
return-val
(list #f "File does not appear to be a QIF file."))
(set! heinous-error #t))))))
;; this is if we read a normal (non-null, non-eof) line...
(if (not heinous-error)
@ -395,57 +302,290 @@
(not (eof-object? line)))
(line-loop))))))
(if (not heinous-error)
(begin
;; now that the file is read in, figure out if either
;; the date or radix format has made itself clear from the
;; values.
(if (and
(eq? (qif-file:radix-format self) 'unknown)
(not (eq? (qif-file:guessed-radix-format self) 'unknown))
(not (eq? (qif-file:guessed-radix-format self) 'inconsistent)))
(qif-file:set-radix-format!
self
(qif-file:guessed-radix-format self)))
(if (and
(eq? (qif-file:date-format self) 'unknown)
(not (eq? (qif-file:guessed-date-format self) 'unknown))
(not (eq? (qif-file:guessed-date-format self) 'inconsistent)))
(qif-file:set-date-format! self
(qif-file:guessed-date-format self)))
;; if the account hasn't been found from an Opening Balance line,
;; just set it to the filename and force the user to specify it.
(if (eq? 'unknown (qif-file:account self))
(qif-file:set-account!
self (qif-file:path-to-accountname self)))
;; reparse values and dates if we figured out the format.
(let ((reparse-ok #t))
(for-each
(lambda (xtn)
(if (eq? reparse-ok #t)
(set! reparse-ok
(qif-xtn:reparse xtn self))))
(qif-file:xtns self))
(for-each
(lambda (cat)
(if (eq? reparse-ok #t)
(set! reparse-ok
(qif-cat:reparse cat self))))
(qif-file:cats self))
(for-each
(lambda (acct)
(if (eq? reparse-ok #t)
(set! reparse-ok
(qif-acct:reparse acct self))))
(qif-file:accounts self))
reparse-ok))
(begin
(display "There was a heinous error. Failed to read file.")
(newline)
#f))))
;; now reverse the transaction list so xtns are in the same order that
;; they were in the file. This is important in a few cases.
(qif-file:set-xtns! self (reverse (qif-file:xtns self)))
(set! end-time (gettimeofday))
(display "QIF file read took ")
(display (+ (* 1000 (- (car end-time) (car start-time)))
(* .001 (- (cdr end-time) (cdr start-time)))))
(newline)
return-val))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file:process-opening-balance-xtn self xtn
;;
;; this gets called for the first transaction after a !Type: tag.
;;
;; if the first transaction after a !Type: tag has a payee of
;; "Opening Balance", we have to massage the transaction a little.
;; The meaning of an OB transaction is "transfer from Equity to the
;; account specified in the L line." idiomatically, ms-money and some
;; others use this transaction instead of an Account record to
;; specify "this" account (the from-account for all following
;; transactions), so we have to allow for that.
;;
;; even if the payee isn't "Opening Balance", we know that if there's
;; no default from-account by this time, we need to set one. In that
;; case, we set the default account based on the file name.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-file:process-opening-balance-xtn self xtn type)
(let ((payee (qif-xtn:payee xtn))
(category (qif-split:category
(car (qif-xtn:splits xtn))))
(cat-is-acct? (qif-split:category-is-account?
(car (qif-xtn:splits xtn))))
(security (qif-xtn:security-name xtn)))
(if (and payee (string? payee)
(not security)
(string=? (string-remove-trailing-space payee)
"Opening Balance")
cat-is-acct?)
;; this is an explicit "Opening Balance" transaction. we need
;; to change the category to point to the equity account that
;; the opening balance comes from.
(begin
(qif-split:set-category!
(car (qif-xtn:splits xtn))
(default-equity-category))
(if (eq? (qif-file:default-account self) 'unknown)
(qif-file:set-default-account! self category)))
;; it's not an OB transaction. Still set the default
;; account if there isn't one.
(if (eq? (qif-file:default-account self) 'unknown)
(begin
(qif-file:set-default-account!
self (qif-file:path-to-accountname self))
(case type
((type:invst)
(qif-file:set-default-account-type! self GNC-STOCK-TYPE))
(else
(qif-file:set-default-account-type! self GNC-BANK-TYPE))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file:parse-fields self
;; take a previously-read qif file and convert fields
;; from strings to the appropriate type.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-file:parse-fields self)
(let* ((error #f)
(all-ok #f)
(start-time #f)
(end-time #f)
(set-error
(lambda (e) (set! error e)))
(errlist-to-string
(lambda (lst)
(with-output-to-string
(lambda ()
(for-each
(lambda (elt)
(display elt))
lst))))))
(set! start-time (gettimeofday))
(and
;; fields of categories.
(check-and-parse-field
qif-cat:tax-rate qif-cat:set-tax-rate!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:cats self)
set-error)
(check-and-parse-field
qif-cat:budget-amt qif-cat:set-budget-amt!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:cats self)
set-error)
;; fields of accounts
(check-and-parse-field
qif-acct:limit qif-acct:set-limit!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:accounts self)
set-error)
(check-and-parse-field
qif-acct:budget qif-acct:set-budget!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:accounts self)
set-error)
(parse-field
qif-acct:type qif-acct:set-type!
qif-parse:parse-acct-type (qif-file:accounts self)
set-error)
;; fields of transactions
(check-and-parse-field
qif-xtn:date qif-xtn:set-date!
qif-parse:check-date-format '(m-d-y d-m-y y-m-d y-d-m)
qif-parse:parse-date/format
(qif-file:xtns self)
set-error)
(parse-field
qif-xtn:cleared qif-xtn:set-cleared!
qif-parse:parse-cleared-field (qif-file:xtns self) set-error)
(check-and-parse-field
qif-xtn:share-price qif-xtn:set-share-price!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:xtns self)
set-error)
(check-and-parse-field
qif-xtn:num-shares qif-xtn:set-num-shares!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:xtns self)
set-error)
(check-and-parse-field
qif-xtn:commission qif-xtn:set-commission!
qif-parse:check-number-format '(decimal comma)
qif-parse:parse-number/format (qif-file:xtns self)
set-error)
;; this one's a little tricky... it checks and sets all the
;; split amounts for the transaction together.
(check-and-parse-field
qif-xtn:split-amounts qif-xtn:set-split-amounts!
qif-parse:check-number-formats '(decimal comma)
qif-parse:parse-numbers/format (qif-file:xtns self)
set-error)
(begin
(set! all-ok #t)
#t))
(set! end-time (gettimeofday))
(display "QIF string parsing took ")
(display (+ (* 1000 (- (car end-time) (car start-time)))
(* .001 (- (cdr end-time) (cdr start-time)))))
(newline)
(cond ((list? error)
(list all-ok (errlist-to-string error)))
(error
(list all-ok error))
(#t #t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse-field
;; a simplified version of check-and-parse-field which just calls
;; the parser on every instance of the field in the set of objects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (parse-field getter setter parser objects errormsg)
(for-each
(lambda (obj)
(let ((unparsed (getter obj)))
(if (and unparsed (string? unparsed))
(setter obj (parser unparsed)))))
objects)
#t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check-and-parse-field
;;
;; this is a semi-generic routine to apply a format check and
;; parsing routine to fields that can have multiple possible
;; formats. In this case, any amount field cam be decimal or
;; comma radix and the date firled can be any of several possible
;; types.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (check-and-parse-field getter setter checker
formats parser objects errormsg)
;; first find the right format for the field
(let ((do-parsing #f)
(retval #t)
(format #f))
;; loop over objects. If the formats list ever gets down
;; to 1 element, 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! do-parsing #t)
(set! formats (checker val formats)))))
(if (and (not (null? formats))
(not (null? (cdr formats)))
(not (null? rest)))
(loop (car rest) (cdr rest)))))
;; if there's nothing left in formats, there's no format that will
;; fit all the values for a given field. We have to give up at
;; that point. If there are multiple items in formats, we just
;; take the default (first) item in the list. This is not super
;; great.
(cond
((null? formats)
(errormsg "Data for number or date does not match a known format.")
(set! retval #f)
(set! do-parsing #f))
((and (not (null? (cdr formats))) do-parsing)
;; there are multiple formats that fit. If they all produce the
;; same interpretation for every data point in the set, then
;; just ignore the format ambiguity. Otherwise, it's really an
;; error. ATM since there's no way to correct the error let's
;; just leave it be.
(all-formats-equivalent? getter parser formats objects errormsg)
(set! format (car formats)))
(#t
(set! format (car formats))))
;; do-parsing is false if there were no objects with non-#f values
;; in the field. We would have had to look at all of them once,
;; but at least not twice.
(if do-parsing
(for-each
(lambda (current)
(let ((val (getter current))
(parsed #f))
(if val
(begin
(set! parsed (parser val format))
(if parsed
(setter current parsed)
(begin
(set! retval #f)
(errormsg
"Data format inconsistent in QIF file.")))))))
objects))
retval))
(define (all-formats-equivalent? getter parser formats objects errormsg)
(let ((all-ok #t))
(let obj-loop ((objlist objects))
(let* ((unparsed (getter (car objlist)))
(parsed #f))
(if (string? unparsed)
(begin
(set! parsed (parser unparsed (car formats)))
(for-each
(lambda (fmt)
(let ((this-parsed (parser unparsed fmt)))
(if (not (equal? parsed this-parsed))
(begin
(set! all-ok #f)
(errormsg
(list "Parse ambiguity : between formats "
formats "\nValue " unparsed " could be "
parsed " or " this-parsed
"\nand no evidence exists to distinguish."
"\nUsing " parsed ". "
"\nSee help for more info."))))))
(cdr formats))))
(if (and all-ok (not (null? (cdr objlist))))
(obj-loop (cdr objlist)))))
all-ok))

15
src/scm/qif-import/qif-guess-map.scm
View File

@ -123,17 +123,19 @@
(lambda (bin)
(for-each
(lambda (hashpair)
(list-set! (cdr hashpair) 4 0))
(list-set! (cdr hashpair) 4 0)
(list-set! (cdr hashpair) 5 #f))
bin))
(vector->list acct-map))
(for-each
(lambda (bin)
(for-each
(lambda (hashpair)
(list-set! (cdr hashpair) 4 0))
(list-set! (cdr hashpair) 4 0)
(list-set! (cdr hashpair) 5 #f))
bin))
(vector->list cat-map))
(with-output-to-file pref-filename
(lambda ()
@ -268,16 +270,17 @@
(define (qif-import:find-new-acct qif-acct allowed-types gnc-map-info)
(cond ((and (string? qif-acct)
(string=? qif-acct "Opening Balance"))
(string=? qif-acct (default-equity-account)))
(let ((existing-equity
(qif-import:find-similar-acct "Retained Earnings"
(qif-import:find-similar-acct (default-equity-account)
(list GNC-EQUITY-TYPE)
gnc-map-info)))
(if existing-equity
(cdr existing-equity)
(list "Retained Earnings" GNC-EQUITY-TYPE))))
(list (default-equity-account) GNC-EQUITY-TYPE))))
((and (string? qif-acct)
(not (string=? qif-acct "")))
(list qif-acct (car allowed-types)))
(#t
(list "Unspecified" (car allowed-types)))))

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

@ -12,8 +12,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file class
;; radix-format : one of 'decimal 'comma or 'unspecified
;; date-format : one of 'd-m-y, 'm-d-y, 'y-m-d, 'y-d-m, 'unspecified
;; currency : a string representing the file's currency unit
;; xtns : list of <qif-xtn>
;; accounts : list of <qif-acct>
@ -24,122 +22,97 @@
(define <qif-file>
(make-simple-class
'qif-file
'(path ;; where file was loaded
account ;; guessed or specified
account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE
radix-format
guessed-radix-format
date-format
guessed-date-format
y2k-threshold
currency ;; this is a string.. no checking
'(path ;; where file was loaded
default-account ;; guessed or specified default account name
default-account-type ;; either GNC-BANK-TYPE or GNC-STOCK-TYPE
default-acct-xtns
y2k-threshold
currency ;; this is a string.. no checking
accts-mentioned
xtns
markable-xtns ;; we prune xtns to speed up marking.
accounts
cats
classes)))
(define (qif-file? self)
(eq? (simple-obj-type self) 'qif-file))
(define qif-file?
(record-predicate <qif-file>))
(define (qif-file:path self)
(simple-obj-getter self <qif-file> 'path))
(define qif-file:path
(simple-obj-getter <qif-file> 'path))
(define (qif-file:account self)
(simple-obj-getter self <qif-file> 'account))
(define qif-file:default-account
(simple-obj-getter <qif-file> 'default-account))
(define (qif-file:set-account! self value)
(simple-obj-setter self <qif-file> 'account value))
(define qif-file:set-default-account!
(simple-obj-setter <qif-file> 'default-account))
(define (qif-file:account-type self)
(simple-obj-getter self <qif-file> 'account-type))
(define qif-file:default-account-type
(simple-obj-getter <qif-file> 'default-account-type))
(define (qif-file:set-account-type! self value)
(simple-obj-setter self <qif-file> 'account-type value))
(define qif-file:set-default-account-type!
(simple-obj-setter <qif-file> 'default-account-type))
(define (qif-file:set-path! self value)
(simple-obj-setter self <qif-file> 'path value))
(define qif-file:set-path!
(simple-obj-setter <qif-file> 'path))
(define (qif-file:radix-format self)
(simple-obj-getter self <qif-file> 'radix-format))
(define qif-file:y2k-threshold
(simple-obj-getter <qif-file> 'y2k-threshold))
(define (qif-file:set-radix-format! self value)
(simple-obj-setter self <qif-file> 'radix-format value))
(define qif-file:set-y2k-threshold!
(simple-obj-setter <qif-file> 'y2k-threshold))
(define (qif-file:guessed-radix-format self)
(simple-obj-getter self <qif-file> 'guessed-radix-format))
(define qif-file:currency
(simple-obj-getter <qif-file> 'currency))
(define (qif-file:set-guessed-radix-format! self value)
(simple-obj-setter self <qif-file> 'guessed-radix-format value))
(define qif-file:set-currency!
(simple-obj-setter <qif-file> 'currency))
(define (qif-file:date-format self)
(simple-obj-getter self <qif-file> 'date-format))
(define qif-file:default-acct-xtns
(simple-obj-getter <qif-file> 'default-acct-xtns))
(define (qif-file:set-date-format! self value)
(simple-obj-setter self <qif-file> 'date-format value))
(define qif-file:set-default-acct-xtns!
(simple-obj-setter <qif-file> 'default-acct-xtns))
(define (qif-file:guessed-date-format self)
(simple-obj-getter self <qif-file> 'guessed-date-format))
(define qif-file:accts-mentioned
(simple-obj-getter <qif-file> 'accts-mentioned))
(define (qif-file:set-guessed-date-format! self value)
(simple-obj-setter self <qif-file> 'guessed-date-format value))
(define qif-file:set-accts-mentioned!
(simple-obj-setter <qif-file> 'accts-mentioned))
(define (qif-file:y2k-threshold self)
(simple-obj-getter self <qif-file> 'y2k-threshold))
(define qif-file:cats
(simple-obj-getter <qif-file> 'cats))
(define (qif-file:set-y2k-threshold! self value)
(simple-obj-setter self <qif-file> 'y2k-threshold value))
(define qif-file:set-cats!
(simple-obj-setter <qif-file> 'cats))
(define (qif-file:currency self)
(simple-obj-getter self <qif-file> 'currency))
(define qif-file:classes
(simple-obj-getter <qif-file> 'classes))
(define (qif-file:set-currency! self value)
(simple-obj-setter self <qif-file> 'currency value))
(define qif-file:set-classes!
(simple-obj-setter <qif-file> 'classes))
(define (qif-file:default-acct-xtns self)
(simple-obj-getter self <qif-file> 'default-acct-xtns))
(define qif-file:xtns
(simple-obj-getter <qif-file> 'xtns))
(define (qif-file:set-default-acct-xtns! self value)
(simple-obj-setter self <qif-file> 'default-acct-xtns value))
(define qif-file:set-xtns!
(simple-obj-setter <qif-file> 'xtns))
(define (qif-file:accts-mentioned self)
(simple-obj-getter self <qif-file> 'accts-mentioned))
(define qif-file:markable-xtns
(simple-obj-getter <qif-file> 'markable-xtns))
(define (qif-file:set-accts-mentioned! self value)
(simple-obj-setter self <qif-file> 'accts-mentioned value))
(define qif-file:set-markable-xtns!
(simple-obj-setter <qif-file> 'markable-xtns))
(define (qif-file:cats self)
(simple-obj-getter self <qif-file> 'cats))
(define qif-file:accounts
(simple-obj-getter <qif-file> 'accounts))
(define (qif-file:set-cats! self value)
(simple-obj-setter self <qif-file> 'cats value))
(define qif-file:set-accounts!
(simple-obj-setter <qif-file> 'accounts))
(define (qif-file:classes self)
(simple-obj-getter self <qif-file> 'classes))
(define (qif-file:set-classes! self value)
(simple-obj-setter self <qif-file> 'classes value))
(define (qif-file:xtns self)
(simple-obj-getter self <qif-file> 'xtns))
(define (qif-file:set-xtns! self value)
(simple-obj-setter self <qif-file> 'xtns value))
(define (qif-file:accounts self)
(simple-obj-getter self <qif-file> 'accounts))
(define (qif-file:set-accounts! self value)
(simple-obj-setter self <qif-file> 'accounts value))
(define (make-qif-file account radix-format date-format currency)
(define (make-qif-file account currency)
(let ((self (make-simple-obj <qif-file>)))
(qif-file:set-account! self account)
(qif-file:set-radix-format! self radix-format)
(qif-file:set-guessed-radix-format! self radix-format)
(qif-file:set-date-format! self date-format)
(qif-file:set-guessed-date-format! self date-format)
(qif-file:set-default-account! self account)
(qif-file:set-currency! self currency)
(qif-file:set-y2k-threshold! self 50)
(qif-file:set-default-acct-xtns! self 0)
@ -160,8 +133,11 @@
'qif-split
'(category class memo amount category-is-account? matching-cleared mark)))
(define (qif-split:category self)
(simple-obj-getter self <qif-split> 'category))
(define qif-split:category
(simple-obj-getter <qif-split> 'category))
(define qif-split:set-category-private!
(simple-obj-setter <qif-split> 'category))
(define (qif-split:set-category! self value)
(let* ((cat-info
@ -169,53 +145,51 @@
(cat-name (list-ref cat-info 0))
(is-account? (list-ref cat-info 1))
(class-name (list-ref cat-info 2)))
(simple-obj-setter self <qif-split> 'category cat-name)
(simple-obj-setter self <qif-split> 'class class-name)
(simple-obj-setter self <qif-split> 'category-is-account? is-account?)))
; (if (not is-account?)
; (simple-obj-setter self <qif-split> 'mark #t))))
(qif-split:set-category-private! self cat-name)
(qif-split:set-class! self class-name)
(qif-split:set-category-is-account?! self is-account?)))
(define (qif-split:class self)
(simple-obj-getter self <qif-split> 'class))
(define qif-split:class
(simple-obj-getter <qif-split> 'class))
(define (qif-split:set-class! self value)
(simple-obj-setter self <qif-split> 'class value))
(define qif-split:set-class!
(simple-obj-setter <qif-split> 'class))
(define (qif-split:memo self)
(simple-obj-getter self <qif-split> 'memo))
(define qif-split:memo
(simple-obj-getter <qif-split> 'memo))
(define (qif-split:set-memo! self value)
(simple-obj-setter self <qif-split> 'memo value))
(define qif-split:set-memo!
(simple-obj-setter <qif-split> 'memo))
(define (qif-split:amount self)
(simple-obj-getter self <qif-split> 'amount))
(define qif-split:amount
(simple-obj-getter <qif-split> 'amount))
(define (qif-split:set-amount! self value)
(simple-obj-setter self <qif-split> 'amount value))
(define qif-split:set-amount!
(simple-obj-setter <qif-split> 'amount))
(define (qif-split:mark self)
(simple-obj-getter self <qif-split> 'mark))
(define qif-split:mark
(simple-obj-getter <qif-split> 'mark))
(define (qif-split:set-mark! self value)
(simple-obj-setter self <qif-split> 'mark value))
(define qif-split:set-mark!
(simple-obj-setter <qif-split> 'mark))
(define (qif-split:matching-cleared self)
(simple-obj-getter self <qif-split> 'matching-cleared))
(define qif-split:matching-cleared
(simple-obj-getter <qif-split> 'matching-cleared))
(define (qif-split:set-matching-cleared! self value)
(simple-obj-setter self <qif-split> 'matching-cleared value))
(define qif-split:set-matching-cleared!
(simple-obj-setter <qif-split> 'matching-cleared))
(define (qif-split:category-is-account? self)
(simple-obj-getter self <qif-split> 'category-is-account?))
(define qif-split:category-is-account?
(simple-obj-getter <qif-split> 'category-is-account?))
(define (qif-split:set-category-is-account?! self value)
(simple-obj-setter self <qif-split> 'category-is-account? value))
(define qif-split:set-category-is-account?!
(simple-obj-setter <qif-split> 'category-is-account?))
(define (make-qif-split)
(let ((self (make-simple-obj <qif-split>)))
(qif-split:set-category! self "")
self))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -228,7 +202,7 @@
;; [I] share price : parsed
;; [Q] number of shares
;; [Y] name of security
;; [O] adjustment (parsed)
;; [O] commission (parsed)
;; [L] category : string
;; [S]/[E]/[$] splits : a list of <qif-split>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -237,158 +211,104 @@
(make-simple-class
'qif-xtn
'(date payee address number cleared
from-acct share-price num-shares security-name adjustment
splits bank-xtn? mark)))
from-acct share-price num-shares security-name commission
splits mark)))
(define (qif-xtn? self)
(eq? (simple-obj-type self) 'qif-xtn))
(define qif-xtn?
(record-predicate <qif-xtn>))
(define (qif-xtn:date self)
(simple-obj-getter self <qif-xtn> 'date))
(define qif-xtn:date
(simple-obj-getter <qif-xtn> 'date))
(define (qif-xtn:set-date! self value)
(simple-obj-setter self <qif-xtn> 'date value))
(define qif-xtn:set-date!
(simple-obj-setter <qif-xtn> 'date))
(define (qif-xtn:payee self)
(simple-obj-getter self <qif-xtn> 'payee))
(define qif-xtn:payee
(simple-obj-getter <qif-xtn> 'payee))
(define (qif-xtn:set-payee! self value)
(simple-obj-setter self <qif-xtn> 'payee value))
(define qif-xtn:set-payee!
(simple-obj-setter <qif-xtn> 'payee))
(define (qif-xtn:address self)
(simple-obj-getter self <qif-xtn> 'address))
(define qif-xtn:address
(simple-obj-getter <qif-xtn> 'address))
(define (qif-xtn:set-address! self value)
(simple-obj-setter self <qif-xtn> 'address value))
(define qif-xtn:set-address!
(simple-obj-setter <qif-xtn> 'address))
(define (qif-xtn:number self)
(simple-obj-getter self <qif-xtn> 'number))
(define qif-xtn:number
(simple-obj-getter <qif-xtn> 'number))
(define (qif-xtn:set-number! self value)
(simple-obj-setter self <qif-xtn> 'number value))
(define qif-xtn:set-number!
(simple-obj-setter <qif-xtn> 'number))
(define (qif-xtn:cleared self)
(simple-obj-getter self <qif-xtn> 'cleared))
(define qif-xtn:cleared
(simple-obj-getter <qif-xtn> 'cleared))
(define (qif-xtn:set-cleared! self value)
(simple-obj-setter self <qif-xtn> 'cleared value))
(define qif-xtn:set-cleared!
(simple-obj-setter <qif-xtn> 'cleared))
(define (qif-xtn:from-acct self)
(simple-obj-getter self <qif-xtn> 'from-acct))
(define qif-xtn:from-acct
(simple-obj-getter <qif-xtn> 'from-acct))
(define (qif-xtn:set-from-acct! self value)
(simple-obj-setter self <qif-xtn> 'from-acct value))
(define qif-xtn:set-from-acct!
(simple-obj-setter <qif-xtn> 'from-acct))
(define (qif-xtn:share-price self)
(simple-obj-getter self <qif-xtn> 'share-price))
(define qif-xtn:share-price
(simple-obj-getter <qif-xtn> 'share-price))
(define (qif-xtn:set-share-price! self value)
(simple-obj-setter self <qif-xtn> 'share-price value))
(define qif-xtn:set-share-price!
(simple-obj-setter <qif-xtn> 'share-price))
(define (qif-xtn:num-shares self)
(simple-obj-getter self <qif-xtn> 'num-shares))
(define qif-xtn:num-shares
(simple-obj-getter <qif-xtn> 'num-shares))
(define (qif-xtn:set-num-shares! self value)
(simple-obj-setter self <qif-xtn> 'num-shares value))
(define qif-xtn:set-num-shares!
(simple-obj-setter <qif-xtn> 'num-shares))
(define (qif-xtn:security-name self)
(simple-obj-getter self <qif-xtn> 'security-name))
(define qif-xtn:security-name
(simple-obj-getter <qif-xtn> 'security-name))
(define (qif-xtn:set-security-name! self value)
(simple-obj-setter self <qif-xtn> 'security-name value))
(define qif-xtn:set-security-name!
(simple-obj-setter <qif-xtn> 'security-name))
(define (qif-xtn:adjustment self)
(simple-obj-getter self <qif-xtn> 'adjustment))
(define qif-xtn:commission
(simple-obj-getter <qif-xtn> 'commission))
(define (qif-xtn:set-adjustment! self value)
(simple-obj-setter self <qif-xtn> 'adjustment value))
(define qif-xtn:set-commission!
(simple-obj-setter <qif-xtn> 'commission))
(define (qif-xtn:splits self)
(simple-obj-getter self <qif-xtn> 'splits))
(define qif-xtn:splits
(simple-obj-getter <qif-xtn> 'splits))
(define (qif-xtn:set-splits! self value)
(simple-obj-setter self <qif-xtn> 'splits value))
(define qif-xtn:set-splits!
(simple-obj-setter <qif-xtn> 'splits))
(define (qif-xtn:mark self)
(simple-obj-getter self <qif-xtn> 'mark))
(define qif-xtn:mark
(simple-obj-getter <qif-xtn> 'mark))
(define (qif-xtn:set-mark! self value)
(simple-obj-setter self <qif-xtn> 'mark value))
(define (qif-xtn:bank-xtn? self)
(simple-obj-getter self <qif-xtn> 'bank-xtn?))
(define (qif-xtn:set-bank-xtn?! self value)
(simple-obj-setter self <qif-xtn> 'bank-xtn? value))
(define qif-xtn:set-mark!
(simple-obj-setter <qif-xtn> 'mark))
(define (make-qif-xtn)
(let ((self (make-simple-obj <qif-xtn>)))
(qif-xtn:set-bank-xtn?! self #t)
(qif-xtn:set-mark! self #f)
(qif-xtn:set-splits! self '())
self))
(define (qif-xtn:reparse self qif-file)
(let ((reparse-ok #t))
;; share price
(if (string? (qif-xtn:share-price self))
(qif-xtn:set-share-price!
self
(qif-file:parse-value qif-file (qif-xtn:share-price self))))
;; number of shares
(if (string? (qif-xtn:num-shares self))
(qif-xtn:set-num-shares!
self
(qif-file:parse-value qif-file (qif-xtn:num-shares self))))
;; adjustment
(if (string? (qif-xtn:adjustment self))
(qif-xtn:set-adjustment!
self
(qif-file:parse-value qif-file (qif-xtn:adjustment self))))
(if (or (string? (qif-xtn:share-price self))
(string? (qif-xtn:num-shares self))
(string? (qif-xtn:adjustment self)))
(begin
(display "qif-import: failed to reparse stock info")
(newline)
(qif-xtn:print self)
(set! reparse-ok
(list #f "Could not autodetect radix format."))))
;; reparse the amount of each split
(for-each
(lambda (split)
(if (string? (qif-split:amount split))
(qif-split:set-amount!
split
(qif-file:parse-value qif-file (qif-split:amount split))))
(if (string? (qif-split:amount split))
(begin
(display "qif-import: failed to reparse value")
(write (qif-split:amount split)) (newline)
(set! reparse-ok
(list #f "Could not autodetect radix format.")))))
(qif-xtn:splits self))
;; reparse the date
(if (string? (qif-xtn:date self))
(qif-xtn:set-date! self
(qif-file:parse-date qif-file
(qif-xtn:date self))))
(if (string? (qif-xtn:date self))
(begin
(display "qif-import: failed to reparse date ")
(write (qif-xtn:date self)) (newline)
(set! reparse-ok
(list #f "Could not autodetect date format."))))
reparse-ok))
(define (qif-xtn:print self)
(simple-obj-print self <qif-xtn>))
(simple-obj-print self))
(define (qif-xtn:split-amounts self)
(map
(lambda (split)
(qif-split:amount split))
(qif-xtn:splits self)))
(define (qif-xtn:set-split-amounts! self amounts)
(map
(lambda (split amount)
(qif-split:set-amount! split amount))
(qif-xtn:splits self) amounts))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <qif-acct>
@ -402,54 +322,44 @@
'qif-acct
'(name type description limit budget)))
(define (qif-acct:name self)
(simple-obj-getter self <qif-acct> 'name))
(define qif-acct:name
(simple-obj-getter <qif-acct> 'name))
(define (qif-acct:set-name! self value)
(simple-obj-setter self <qif-acct> 'name value))
(define qif-acct:set-name!
(simple-obj-setter <qif-acct> 'name))
(define (qif-acct:type self)
(simple-obj-getter self <qif-acct> 'type))
(define qif-acct:type
(simple-obj-getter <qif-acct> 'type))
(define (qif-acct:set-type! self value)
(simple-obj-setter self <qif-acct> 'type value))
(define qif-acct:set-type!
(simple-obj-setter <qif-acct> 'type))
(define (qif-acct:description self)
(simple-obj-getter self <qif-acct> 'description))
(define qif-acct:description
(simple-obj-getter <qif-acct> 'description))
(define (qif-acct:set-description! self value)
(simple-obj-setter self <qif-acct> 'description value))
(define qif-acct:set-description!
(simple-obj-setter <qif-acct> 'description))
(define (qif-acct:limit self)
(simple-obj-getter self <qif-acct> 'limit))
(define qif-acct:limit
(simple-obj-getter <qif-acct> 'limit))
(define (qif-acct:set-limit! self value)
(simple-obj-setter self <qif-acct> 'limit value))
(define qif-acct:set-limit!
(simple-obj-setter <qif-acct> 'limit))
(define (qif-acct:budget self)
(simple-obj-getter self <qif-acct> 'budget))
(define qif-acct:budget
(simple-obj-getter <qif-acct> 'budget))
(define (qif-acct:set-budget! self value)
(simple-obj-setter self <qif-acct> 'budget value))
(define qif-acct:set-budget!
(simple-obj-setter <qif-acct> 'budget))
(define (make-qif-acct)
(make-simple-obj <qif-acct>))
(define (qif-acct? self)
(eq? (simple-obj-type self) 'qif-acct))
(define qif-acct?
(record-predicate <qif-acct>))
(define (qif-acct:print self)
(simple-obj-print self <qif-acct>))
(define (qif-acct:reparse self file)
(if (string? (qif-acct:limit self))
(qif-acct:set-limit!
self (qif-file:parse-value file (qif-acct:limit self))))
(if (or (string? (qif-acct:limit self))
(string? (qif-acct:type self)))
(list #f "Could not autodetect radix for fields in Account record")
#t))
(simple-obj-print self))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <qif-class>
@ -462,26 +372,26 @@
'qif-class
'(name description)))
(define (qif-class:name self)
(simple-obj-getter self <qif-class> 'name))
(define qif-class:name
(simple-obj-getter <qif-class> 'name))
(define (qif-class:set-name! self value)
(simple-obj-setter self <qif-class> 'name value))
(define qif-class:set-name!
(simple-obj-setter <qif-class> 'name))
(define (qif-class:description self)
(simple-obj-getter self <qif-class> 'description))
(define qif-class:description
(simple-obj-getter <qif-class> 'description))
(define (qif-class:set-description! self value)
(simple-obj-setter self <qif-class> 'description value))
(define qif-class:set-description!
(simple-obj-setter <qif-class> 'description))
(define (qif-class:print self)
(simple-obj-print self <qif-class>))
(simple-obj-print self))
(define (make-qif-class)
(make-simple-obj <qif-class>))
(define (qif-class? self)
(eq? (simple-obj-type self) 'qif-class))
(define qif-class?
(record-predicate <qif-class>))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <qif-cat> : a "Cat" or category transaction
@ -500,71 +410,56 @@
'qif-cat
'(name description taxable expense-cat income-cat tax-rate budget-amt)))
(define (qif-cat:name self)
(simple-obj-getter self <qif-cat> 'name))
(define qif-cat:name
(simple-obj-getter <qif-cat> 'name))
(define (qif-cat:set-name! self value)
(simple-obj-setter self <qif-cat> 'name value))
(define qif-cat:set-name!
(simple-obj-setter <qif-cat> 'name))
(define (qif-cat:description self)
(simple-obj-getter self <qif-cat> 'description))
(define qif-cat:description
(simple-obj-getter <qif-cat> 'description))
(define (qif-cat:set-description! self value)
(simple-obj-setter self <qif-cat> 'description value))
(define qif-cat:set-description!
(simple-obj-setter <qif-cat> 'description))
(define (qif-cat:taxable self)
(simple-obj-getter self <qif-cat> 'taxable))
(define qif-cat:taxable
(simple-obj-getter <qif-cat> 'taxable))
(define (qif-cat:set-taxable! self value)
(simple-obj-setter self <qif-cat> 'taxable value))
(define qif-cat:set-taxable!
(simple-obj-setter <qif-cat> 'taxable))
(define (qif-cat:expense-cat self)
(simple-obj-getter self <qif-cat> 'expense-cat))
(define qif-cat:expense-cat
(simple-obj-getter <qif-cat> 'expense-cat))
(define (qif-cat:set-expense-cat! self value)
(simple-obj-setter self <qif-cat> 'expense-cat value))
(define qif-cat:set-expense-cat!
(simple-obj-setter <qif-cat> 'expense-cat))
(define (qif-cat:income-cat self)
(simple-obj-getter self <qif-cat> 'income-cat))
(define qif-cat:income-cat
(simple-obj-getter <qif-cat> 'income-cat))
(define (qif-cat:set-income-cat! self value)
(simple-obj-setter self <qif-cat> 'income-cat value))
(define qif-cat:set-income-cat!
(simple-obj-setter <qif-cat> 'income-cat))
(define (qif-cat:tax-rate self)
(simple-obj-getter self <qif-cat> 'tax-rate))
(define qif-cat:tax-rate
(simple-obj-getter <qif-cat> 'tax-rate))
(define (qif-cat:set-tax-rate! self value)
(simple-obj-setter self <qif-cat> 'tax-rate value))
(define qif-cat:set-tax-rate!
(simple-obj-setter <qif-cat> 'tax-rate))
(define (qif-cat:budget-amt self)
(simple-obj-getter self <qif-cat> 'budget-amt))
(define qif-cat:budget-amt
(simple-obj-getter <qif-cat> 'budget-amt))
(define (qif-cat:set-budget-amt! self value)
(simple-obj-setter self <qif-cat> 'budget-amt value))
(define qif-cat:set-budget-amt!
(simple-obj-setter <qif-cat> 'budget-amt))
(define (make-qif-cat)
(make-simple-obj <qif-cat>))
(define (qif-cat? obj)
(eq? (simple-obj-type obj) 'qif-cat))
(define qif-cat?
(record-predicate <qif-cat>))
(define (qif-cat:print self)
(simple-obj-print self <qif-cat>))
(define (qif-cat:reparse self file)
(if (string? (qif-cat:tax-rate self))
(qif-cat:set-tax-rate!
self (qif-file:parse-value file (qif-cat:tax-rate self))))
(if (string? (qif-cat:budget-amt self))
(qif-cat:set-budget-amt!
self (qif-file:parse-value file (qif-cat:budget-amt self))))
(if (or (string? (qif-cat:tax-rate self))
(string? (qif-cat:budget-amt self)))
(list #f "Could not autodetect radix for fields in Category record")
#t))
(simple-obj-print self))
(define (qif-file:add-xtn! self xtn)
(let ((from (qif-xtn:from-acct xtn)))
@ -574,11 +469,11 @@
self (cons from (qif-file:accts-mentioned self))))
(let ((defs (qif-file:default-acct-xtns self)))
(qif-file:set-default-acct-xtns! self (+ 1 defs))
(if (and (eq? 0 defs)
(not (member (qif-file:account self)
(if (and (eq? 0 defs)
(not (member (qif-file:default-account self)
(qif-file:accts-mentioned self))))
(qif-file:set-accts-mentioned!
self (cons (qif-file:account self)
self (cons (qif-file:default-account self)
(qif-file:accts-mentioned self)))))))
(for-each
(lambda (split)

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

@ -8,6 +8,22 @@
(gnc:support "qif-import/qif-parse.scm")
(define qif-category-compiled-rexp
(make-regexp "^ *(\\[)?([^]/]*)(]?)(/?)(.*) *$"))
(define qif-date-compiled-rexp
(make-regexp "^ *([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]+ *$"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-split:parse-category
;; this one just gets nastier and nastier.
@ -18,9 +34,6 @@
;; gosh, I love regular expressions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define qif-category-compiled-rexp
(make-regexp "(\\[)?([^]/]*)(]?)(/?)(.*)"))
(define (qif-split:parse-category self value)
(let ((match (regexp-exec qif-category-compiled-rexp value)))
(if match
@ -36,15 +49,16 @@
(display "qif-split:parse-category : can't parse ")
(display value) (newline)
(list "" #f #f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file:fix-year
;; qif-parse:fix-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-file:fix-year self year-string)
(define (qif-parse:fix-year year-string y2k-threshold)
(let ((fixed-string #f)
(post-read-value #f)
(y2k-fixed-value #f))
@ -70,7 +84,7 @@
;; 2-digit numbers less than the window size are interpreted to
;; be post-2000.
((and (integer? post-read-value)
(< post-read-value (qif-file:y2k-threshold self)))
(< post-read-value y2k-threshold))
(set! y2k-fixed-value (+ 2000 post-read-value)))
;; there's a common bug in printing post-2000 dates that
@ -109,7 +123,7 @@
;; conventions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-file:parse-acct-type self read-value)
(define (qif-parse:parse-acct-type read-value)
(let ((mangled-string
(string-downcase! (string-remove-trailing-space
(string-remove-leading-space read-value)))))
@ -120,8 +134,8 @@
GNC-CASH-TYPE)
((string=? mangled-string "ccard")
GNC-CCARD-TYPE)
((string=? mangled-string "invst")
GNC-STOCK-TYPE)
((string=? mangled-string "invst") ;; these are brokerage accounts.
GNC-BANK-TYPE)
((string=? mangled-string "oth a")
GNC-ASSET-TYPE)
((string=? mangled-string "oth l")
@ -129,20 +143,20 @@
((string=? mangled-string "mutual")
GNC-MUTUAL-TYPE)
(#t
(display "qif-file:parse-acct-type : unhandled account type ")
(display "qif-parse:parse-acct-type : unhandled account type ")
(display read-value)
(display "... substituting Bank.")
GNC-BANK-TYPE))))
(define (qif-file:state-to-account-type self qstate)
(define (qif-parse:state-to-account-type qstate)
(cond ((eq? qstate 'type:bank)
GNC-BANK-TYPE)
((eq? qstate 'type:cash)
GNC-CASH-TYPE)
((eq? qstate 'type:ccard)
GNC-CCARD-TYPE)
((eq? qstate 'type:invst)
GNC-STOCK-TYPE)
((eq? qstate 'type:invst) ;; these are brokerage accounts in quicken
GNC-BANK-TYPE)
((eq? qstate '#{type:oth\ a}#)
GNC-ASSET-TYPE)
((eq? qstate '#{type:oth\ l}#)
@ -153,19 +167,62 @@
;; the qif file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-file:parse-bang-field self read-value)
(define (qif-parse:parse-bang-field read-value)
(string->symbol (string-downcase!
(string-remove-trailing-space read-value))))
(define (qif-parse:parse-action-field read-value)
(let ((action-symbol (string-to-canonical-symbol read-value)))
(case action-symbol
;; buy
((buy kauf)
'buy)
((buyx kaufx)
'buyx)
((sell) ;; verkaufen
'sell)
((sellx)
'sellx)
((div) ;; dividende
'div)
((divx)
'divx)
((intinc aktzu) ;; zinsen
'intinc)
((intincx)
'intincx)
((cglong) ;; Kapitalgewinnsteuer
'cglong)
((cglongx)
'cglongx)
((cgshort)
'cgshort)
((cgshortx)
'cgshortx)
((shrsin)
'shrsin)
((reinvdiv)
'reinvdiv)
((reinvint)
'reinvint)
((reinvsg)
'reinvsg)
((reinvsh)
'reinvsh)
((reinvlg reinvkur)
'reinvlg)
(else
action-symbol))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-file:parse-cleared-field self read-value)
(define (qif-parse:parse-cleared-field read-value)
(if (and (string? read-value)
(> (string-length read-value) 0))
(let ((secondchar (string-ref read-value 0)))
@ -183,35 +240,87 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-file:parse-date
;;
;; If the date format is specified, use that; otherwise, try to guess
;; the format. When the format is being guessed, I don't actually do
;; any translation to a numeric format; that's saved for a second
;; pass (calling qif-bank-xtn:reparse on every transaction)
;; qif-parse:check-date-format
;; given a list of possible date formats, return a pruned list
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-file:parse-date self date-string)
(if (or (not (string? date-string))
(not (> (string-length date-string) 0)))
(begin
(display "qif-import: very bogus QIF date in transaction.") (newline)
(display "qif-import: Substituting 1/1/2999 for date.") (newline)
(set! date-string "1/1/2999")))
(define (qif-parse:check-date-format date-string possible-formats)
(let ((retval #f))
(if (or (not (string? date-string))
(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 match
(set! date-parts (list (match:substring match 1)
(match:substring match 2)
(match:substring match 3))))
;; 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)))
(set! date-string (string-remove-trailing-space date-string))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:parse-date-format
;; given a list of possible date formats, return a pruned list
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-date/format date-string format)
(let ((date-parts '())
(numeric-date-parts '())
(retval date-string)
(match
(string-match "^ *([0-9]+) *[-/.'] *([0-9]+) *[-/.'] *([0-9]+) *$"
date-string)))
(match (regexp-exec qif-date-compiled-rexp date-string)))
(if match
(set! date-parts (list (match:substring match 1)
(match:substring match 2)
(match:substring match 3))))
;; get the strings into numbers (but keep the strings around)
(set! numeric-date-parts
(map (lambda (elt)
@ -219,162 +328,67 @@
(lambda () (read))))
date-parts))
(cond
;; if the date parts list doesn't have 3 parts, we're in
;; trouble
((not (eq? 3 (length date-parts)))
(begin
(display "qif-file:parse-date : can't interpret date ")
(display date-string) (display " ") (write date-parts)(newline)))
;; if the format is unknown, don't try to fully interpret the
;; number, just look for a good guess or an inconsistency with
;; the current guess.
((and (eq? (qif-file:date-format self) 'unknown)
(not (eq? (qif-file:guessed-date-format self)
'inconsistent)))
(cond
;; we currently think the date format is m/d/y
((eq? (qif-file:guessed-date-format self) 'm-d-y)
(let ((m (car numeric-date-parts))
(d (cadr numeric-date-parts)))
(if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31))
(qif-file:set-guessed-date-format! self 'inconsistent))))
;; current guess is d/m/y
((eq? (qif-file:guessed-date-format self) 'd-m-y)
(let ((d (car numeric-date-parts))
(m (cadr numeric-date-parts)))
(if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31))
(qif-file:set-guessed-date-format! self 'inconsistent))))
;; current guess is y/m/d
((eq? (qif-file:guessed-date-format self) 'y-m-d)
(let ((m (cadr numeric-date-parts))
(d (caddr numeric-date-parts)))
(if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31))
(qif-file:set-guessed-date-format! self 'inconsistent))))
;; current guess is y/d/m (is this really possible?)
((eq? (qif-file:guessed-date-format self) 'y-d-m)
(let ((d (cadr numeric-date-parts))
(m (caddr numeric-date-parts)))
(if (or (not (number? m)) (not (number? d)) (> m 12) (> d 31))
(qif-file:set-guessed-date-format! self 'inconsistent))))
;; no guess currently. See if we can find a smoking gun in
;; the date format. For dates like 11-9-11 just don't try to
;; guess.
((eq? (qif-file:guessed-date-format self) 'unknown)
(let ((possibilities '(m-d-y d-m-y y-m-d y-d-m))
(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)))
;; if the date parts list doesn't have 3 parts, we're in
;; trouble
(if (not (eq? 3 (length date-parts)))
(begin
(display "qif-parse:parse-date-format : can't interpret date ")
(display date-string) (display " ") (write date-parts)(newline))
(case format
((d-m-y)
(let ((d (car numeric-date-parts))
(m (cadr numeric-date-parts))
(y (qif-parse:fix-year (caddr date-parts) 50)))
(if (and (integer? d) (integer? m) (integer? y)
(<= m 12) (<= d 31))
(set! retval (list d m y))
(begin
(display "qif-parse:parse-date-format : ")
(display "format is d/m/y, but date is ")
(display date-string) (newline)))))
;; if there's exactly one possibility left, we've got a good
;; guess. if there are no possibilities left, the date
;; is somehow inconsistent. More than one, do nothing.
(cond ((eq? (length possibilities) 1)
(qif-file:set-guessed-date-format! self (car possibilities)))
((eq? (length possibilities) 0)
(display "qif-file:parse-date : can't interpret date ")
(display date-string)
(newline)
(qif-file:set-guessed-date-format! self 'inconsistent)))))))
;; we think we know the date format. Make sure the data is
;; consistent with that.
((eq? (qif-file:date-format self) 'd-m-y)
(let ((d (car numeric-date-parts))
(m (cadr numeric-date-parts))
(y (qif-file:fix-year self (caddr date-parts))))
(if (and (integer? d) (integer? m) (integer? y)
(<= m 12) (<= d 31))
(set! retval (list d m y))
(begin
(display "qif-file:parse-date : format is d/m/y, but date is ")
(display date-string) (newline)))))
((eq? (qif-file:date-format self) 'm-d-y)
(let ((m (car numeric-date-parts))
(d (cadr numeric-date-parts))
(y (qif-file:fix-year self (caddr date-parts))))
(if (and (integer? d) (integer? m) (integer? y)
(<= m 12) (<= d 31))
(set! retval (list d m y))
(begin
(display "qif-file:parse-date : format is m/d/y, but date is ")
(display date-string) (newline)))))
((eq? (qif-file:date-format self) 'y-m-d)
(let ((y (qif-file:fix-year self (car date-parts)))
(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))
(begin
(display "qif-file:parse-date : format is y/m/d, but date is ")
(display date-string) (newline))))
((eq? (qif-file:date-format self) 'y-d-m)
(let ((y (qif-file:fix-year self (car date-parts)))
(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))
(begin
(display "qif-file:parse-date : format is y/m/d, but date is ")
(display date-string) (newline)))))
((m-d-y)
(let ((m (car numeric-date-parts))
(d (cadr numeric-date-parts))
(y (qif-parse:fix-year (caddr date-parts) 50)))
(if (and (integer? d) (integer? m) (integer? y)
(<= m 12) (<= d 31))
(set! retval (list d m y))
(begin
(display "qif-parse:parse-date-format : ")
(display " format is m/d/y, but date is ")
(display date-string) (newline)))))
((y-m-d)
(let ((y (qif-parse:fix-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))
(begin
(display "qif-parse:parse-date-format :")
(display " format is y/m/d, but date is ")
(display date-string) (newline)))))
((y-d-m)
(let ((y (qif-parse:fix-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))
(begin
(display "qif-parse:parse-date-format : ")
(display " format is y/m/d, but date is ")
(display date-string) (newline)))))))
retval))
(define (qif-file:parse-string self str)
(if (or (not (string? str))
(not (> (string-length str) 0)))
(set! str " "))
(string-remove-leading-space (string-remove-trailing-space str)))
(define decimal-radix-regexp
(make-regexp
"^\\$?-?\\$?[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]*)?$"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; number format predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (value-is-decimal-radix? value)
(if (regexp-exec decimal-radix-regexp value)
@ -384,92 +398,87 @@
(if (regexp-exec comma-radix-regexp value)
#t #f))
(define (qif-file:parse-value/decimal self value-string)
(set! value-string (string-remove-trailing-space value-string))
(if (value-is-decimal-radix? value-string)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-remove-char value-string #\,)
#\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f))
#f))
(define (value-is-integer? value)
(if (regexp-exec integer-regexp value)
#t #f))
(define (qif-file:parse-value/comma self value-string)
(set! value-string (string-remove-trailing-space value-string))
(if (value-is-comma-radix? value-string)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-replace-char!
(string-remove-char value-string #\.)
#\, #\.)
#\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f))
#f))
(define (qif-file:parse-value self value-string)
(if (or (not (string? value-string))
(not (> (string-length value-string) 0)))
(set! value-string "0")
(set! value-string (string-remove-leading-space
(string-remove-trailing-space value-string))))
(let ((possibly-comma-radix? (value-is-comma-radix? value-string))
(possibly-decimal-radix? (value-is-decimal-radix? value-string)))
(if (and (eq? (qif-file:radix-format self) 'unknown)
(not (eq? (qif-file:guessed-radix-format self) 'inconsistent)))
(cond
;; already think it's decimal
((eq? (qif-file:guessed-radix-format self) 'decimal)
(if (and possibly-comma-radix?
(not possibly-decimal-radix?))
(begin
(qif-file:set-guessed-radix-format! self 'inconsistent)
(display "this QIF file has inconsistent radix notation!")
(newline))))
;; already think it's comma
((eq? (qif-file:guessed-radix-format self) 'comma)
(if (and possibly-decimal-radix?
(not possibly-comma-radix?))
(begin
(qif-file:set-guessed-radix-format! self 'inconsistent)
(display "this QIF file has inconsistent radix notation!")
(newline))))
;; don't know : look for numbers that are giveaways.
((eq? (qif-file:guessed-radix-format self) 'unknown)
(cond ((and possibly-decimal-radix?
(not possibly-comma-radix?))
(qif-file:set-guessed-radix-format! self 'decimal))
((and possibly-comma-radix?
(not possibly-decimal-radix?))
(qif-file:set-guessed-radix-format! self 'comma))))))
(cond
((eq? (qif-file:radix-format self) 'decimal)
(if possibly-decimal-radix?
(qif-file:parse-value/decimal self value-string)
(begin
(display "Format is decimal-radix, but number is")
(write value-string)
(newline)
0.0)))
((eq? (qif-file:radix-format self) 'comma)
(if possibly-comma-radix?
(qif-file:parse-value/comma self value-string)
(begin
(display "Format is comma-radix, but number is")
(write value-string)
(newline)
0.0)))
(#t
value-string))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:check-number-format
;; given a list of possible number formats, return a pruned list
;; of possibilities.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:check-number-format value-string possible-formats)
(let ((retval possible-formats))
(if (not (value-is-decimal-radix? value-string))
(set! retval (delq 'decimal retval)))
(if (not (value-is-comma-radix? value-string))
(set! retval (delq 'comma retval)))
(if (not (value-is-integer? value-string))
(set! retval (delq 'integer retval)))
retval))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-parse:parse-number/format
;; assuming we know what the format is, parse the string.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (qif-parse:parse-number/format value-string format)
(case format
((decimal)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-remove-char value-string #\,)
#\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f)))
((comma)
(let ((read-val
(with-input-from-string
(string-remove-char
(string-replace-char!
(string-remove-char value-string #\.)
#\, #\.)
#\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f)))
((integer)
(let ((read-val
(with-input-from-string
(string-remove-char value-string #\$)
(lambda () (read)))))
(if (number? read-val)
(+ 0.0 read-val)
#f)))))
(define (qif-parse:check-number-formats amt-strings formats)
(let ((retval formats))
(for-each
(lambda (amt)
(set! retval (qif-parse:check-number-format amt retval)))
amt-strings)
retval))
(define (qif-parse:parse-numbers/format amt-strings format)
(let* ((all-ok #t)
(tmp #f)
(parsed
(map
(lambda (amt)
(if amt
(begin
(set! tmp (qif-parse:parse-number/format amt format))
(if (not tmp)
(set! all-ok #f))
tmp)
0.0))
amt-strings)))
(if all-ok parsed #f)))

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

@ -52,7 +52,7 @@
(gnc:account-begin-edit new-acct 1)
;; if this is a copy of an existing gnc account,
;; copy the account properties
2 ;; copy the account properties
(if (not make-new-acct)
(begin
(gnc:account-set-name
@ -99,9 +99,9 @@
(gnc:account-set-description
new-acct (qif-cat:description qif-info)))
((and (qif-xtn? qif-info)
(not (qif-xtn:bank-xtn? qif-info)))
(qif-xtn:security-name qif-info))
(gnc:account-set-security
(qif-xtn:security-name qif-info)))
new-acct (qif-xtn:security-name qif-info)))
((string? qif-info)
(gnc:account-set-description
new-acct qif-info)))))
@ -191,20 +191,28 @@
bin))
(vector->list qif-cat-map))
;; before trying to mark transactions, prune down the list of
;; ones to match.
(for-each
(lambda (qif-file)
(let ((markable-xtns '()))
(for-each
(lambda (xtn)
(let splitloop ((splits (qif-xtn:splits xtn)))
(if (qif-split:category-is-account? (car splits))
(set! markable-xtns (cons xtn markable-xtns))
(if (not (null? (cdr splits)))
(splitloop (cdr splits))))))
(qif-file:xtns qif-file))
(qif-file:set-markable-xtns! qif-file markable-xtns)))
qif-files-list)
;; iterate over files. Going in the sort order by number of
;; transactions should give us a small speed advantage.
(for-each
(lambda (qif-file)
(display "Importing QIF xtns from ")
(display (qif-file:path qif-file)) (newline)
(display "Accounts mentioned: ")
(write (qif-file:accts-mentioned qif-file)) (newline)
;; within the file, iterate over transactions. key things to
;; remember: if the L line in the transaction is a category,
;; it's a single-entry xtn and no need to look for the other
;; end. if it's an account, search for a QIF file with that
;; account name and find the xtn to mark.
;; iterate over markable transactions. The non-transfer
;; ones are already weeded out.
(for-each
(lambda (xtn)
(if (not (qif-xtn:mark xtn))
@ -243,6 +251,7 @@
(gnc:merge-accounts account-group)
(gnc:refresh-main-window)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:qif-xtn-to-gnc-xtn
;; translate a single transaction to a set of gnucash splits and
@ -258,148 +267,197 @@
(qif-acct-map (cadr mapping-data))
(near-acct-info #f)
(near-acct-name #f)
(near-acct #f))
(near-acct #f)
(currency (qif-file:currency qif-file))
(qif-payee (qif-xtn:payee qif-xtn))
(qif-number (qif-xtn:number qif-xtn))
(qif-security (qif-xtn:security-name qif-xtn))
(qif-memo (qif-split:memo (car (qif-xtn:splits qif-xtn))))
(qif-from-acct (qif-xtn:from-acct qif-xtn))
(qif-cleared (qif-xtn:cleared qif-xtn)))
(if (not qif-security)
(begin
;; NON-STOCK TRANSACTIONS: the near account is the current
;; bank-account or the default associated with the file.
;; the far account is the one associated with the split
;; category.
(if qif-from-acct
(set! near-acct-info
(hash-ref qif-acct-map
qif-from-acct))
(set! near-acct-info
(hash-ref qif-acct-map
(qif-file:default-account qif-file))))
(set! near-acct-name
(list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name))
;; iterate over QIF splits. Each split defines one "far
;; end" for the transaction.
(for-each
(lambda (qif-split)
(let ((gnc-far-split (gnc:split-create))
(far-acct-info #f)
(far-acct-name #f)
(far-acct-type #f)
(far-acct #f)
(split-amt (qif-split:amount qif-split))
(memo (qif-split:memo qif-split)))
;; fill the splits in (near first). This handles files in
;; multiple currencies by pulling the currency value from the
;; file import.
(set! near-split-total (+ near-split-total split-amt))
(gnc:split-set-base-value gnc-far-split (- split-amt) currency)
(if memo (gnc:split-set-memo gnc-far-split memo))
(if (qif-split:category-is-account? qif-split)
(set! far-acct-info
(hash-ref qif-acct-map
(qif-split:category qif-split)))
(set! far-acct-info
(hash-ref qif-cat-map
(qif-split:category qif-split))))
(set! far-acct-name
(list-ref far-acct-info 1))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))
;; set the reconcile status. I thought I could set using
;; the quicken type, but it looks like #\r reconcile
;; states aren't preserved across gnucash save/restores.
(let ((cleared (qif-split:matching-cleared qif-split)))
(if (or (eq? 'cleared cleared)
(eq? 'reconciled cleared))
(gnc:split-set-reconcile gnc-far-split #\c)))
;; finally, plug the split into the account
(gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct gnc-far-split)))
splits)
;; the value of the near split is the total of the far splits.
(gnc:split-set-base-value gnc-near-split near-split-total currency)
(gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:account-insert-split near-acct gnc-near-split))
;; STOCK TRANSACTIONS: the near/far accounts depend on the
;; "action" encoded in the Number field. It's generally the
;; security account (for buys, sells, and reinvests) but can
;; also be an interest, dividend, or SG/LG account.
(let ((action-sym (qif-parse:parse-action-field qif-number))
(share-price (qif-xtn:share-price qif-xtn))
(num-shares (qif-xtn:num-shares qif-xtn))
(split-amt (qif-split:amount (car (qif-xtn:splits qif-xtn))))
(qif-near-acct #f)
(qif-far-acct #f)
(far-acct-info #f)
(far-acct-name #f)
(far-acct #f)
(gnc-far-split (gnc:split-create)))
;; I don't think this should ever happen, but I want
;; to keep this check just in case.
(if (> (length splits) 1)
(begin
(display "qif-import:qif-xtn-to-gnc-xtn : ")
(display "splits in stock transaction!") (newline)))
;; the near split: where is the money going TO?
(case action-sym
((buy buyx sell sellx reinvdiv reinvsg reinvsh reinvlg shrsin)
(set! qif-near-acct qif-security))
((div cgshort cglong intinc)
(set! qif-near-acct (qif-xtn:from-acct qif-xtn)))
((divx cgshortx cglongx intincx)
(set! qif-near-acct
(qif-split:category (car (qif-xtn:splits qif-xtn)))))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; the far split: where is the money coming from?
(case action-sym
((buy sell)
(set! qif-far-acct (qif-xtn:from-acct qif-xtn)))
((buyx sellx)
(set! qif-far-acct
(qif-split:category (car (qif-xtn:splits qif-xtn)))))
((cgshort cgshortx reinvsg reinvsh)
(set! qif-far-acct
(default-cgshort-acct qif-security)))
((cglong cglongx reinvlg)
(set! qif-far-acct
(default-cglong-acct qif-security)))
((intinc intincx reinvint)
(set! qif-far-acct
(default-interest-acct qif-security)))
((div divx reinvdiv)
(set! qif-far-acct
(default-dividend-acct qif-security)))
((shrsin)
(set! qif-far-acct
(default-equity-account)))
(else
(display "HEY! HEY! action-sym = ")
(display action-sym) (newline)))
;; the amounts and signs: are shares going in or out?
;; are amounts currency or shares?
(case action-sym
((buy buyx reinvdiv reinvsg reinvsh reinvlg shrsin)
(gnc:split-set-share-price gnc-near-split share-price)
(gnc:split-set-share-price gnc-far-split share-price)
(gnc:split-set-share-amount gnc-near-split num-shares)
(gnc:split-set-share-amount gnc-far-split (- num-shares)))
((sell sellx)
(gnc:split-set-share-price gnc-near-split share-price)
(gnc:split-set-share-price gnc-far-split share-price)
(gnc:split-set-share-amount gnc-near-split (- num-shares))
(gnc:split-set-share-amount gnc-far-split num-shares))
((cgshort cgshortx cglong cglongx intinc intincx div divx)
(gnc:split-set-base-value gnc-near-split split-amt currency)
(gnc:split-set-base-value gnc-far-split (- split-amt) currency)))
(set! near-acct-info
(hash-ref qif-acct-map qif-near-acct))
(set! near-acct-name
(list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name))
(set! far-acct-info
(hash-ref qif-acct-map qif-far-acct))
(set! far-acct-name
(list-ref far-acct-info 1))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))
(let ((cleared (qif-split:matching-cleared
(car (qif-xtn:splits qif-xtn)))))
(if (or (eq? 'cleared cleared)
(eq? 'reconciled cleared))
(gnc:split-set-reconcile gnc-far-split #\c)))
(gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:account-insert-split near-acct gnc-near-split)
(gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct gnc-far-split)))
;; set properties of the whole transaction
(apply gnc:transaction-set-date gnc-xtn (qif-xtn:date qif-xtn))
(if (qif-xtn:payee qif-xtn)
(gnc:transaction-set-description gnc-xtn (qif-xtn:payee qif-xtn)))
(if (qif-xtn:number qif-xtn)
(gnc:transaction-set-xnum gnc-xtn (qif-xtn:number qif-xtn)))
;; find the GNC account for the near end of the transaction
(if (qif-xtn:bank-xtn? qif-xtn)
(begin
(if (qif-xtn:from-acct qif-xtn)
(set! near-acct-info
(hash-ref qif-acct-map
(qif-xtn:from-acct qif-xtn)))
(set! near-acct-info
(hash-ref qif-acct-map
(qif-file:account qif-file))))
(set! near-acct-name
(list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name)))
(begin
(set! near-acct-info
(hash-ref qif-acct-map
(qif-xtn:security-name qif-xtn)))
(set! near-acct-name
(list-ref near-acct-info 1))
(set! near-acct (hash-ref gnc-acct-hash near-acct-name))))
(if qif-payee
(gnc:transaction-set-description gnc-xtn qif-payee))
(if qif-number
(gnc:transaction-set-xnum gnc-xtn qif-number))
(if qif-memo
(gnc:split-set-memo gnc-near-split qif-memo))
(if (qif-split:memo (car (qif-xtn:splits qif-xtn)))
(gnc:split-set-memo gnc-near-split
(qif-split:memo (car (qif-xtn:splits qif-xtn)))))
(let ((cleared (qif-xtn:cleared qif-xtn)))
(if (or
(eq? 'cleared cleared)
(eq? 'reconciled cleared))
(gnc:split-set-reconcile gnc-near-split #\c)))
;; iterate over QIF splits
(for-each
(lambda (qif-split)
(let ((gnc-far-split (gnc:split-create))
(far-acct-info #f)
(far-acct-name #f)
(far-acct-type #f)
(far-acct #f)
(split-amt (qif-split:amount qif-split))
(currency (qif-file:currency qif-file))
(memo (qif-split:memo qif-split)))
;; fill the splits in (near first). This handles files in
;; multiple currencies by pulling the currency value from the
;; file import.
(set! near-split-total
(+ near-split-total split-amt))
(gnc:split-set-base-value gnc-far-split
(- split-amt) currency)
(if memo
(begin
(gnc:split-set-memo gnc-far-split memo)))
;; my guess is that you can't have Quicken splits
;; on stock transactions. This will break if you can.
(if (qif-xtn:share-price qif-xtn)
(begin
(if (> (length splits) 1)
(begin
(display "qif-import:qif-xtn-to-gnc-xtn : ")
(display "splits in stock transaction!") (newline)))
(let ((price (qif-xtn:share-price qif-xtn)))
(gnc:split-set-share-price gnc-near-split price)
(gnc:split-set-share-price gnc-far-split price)))
(begin
(gnc:split-set-share-price gnc-near-split 1.0)
(gnc:split-set-share-price gnc-far-split 1.0)))
(if (qif-xtn:num-shares qif-xtn)
(let ((numshares (qif-xtn:num-shares qif-xtn)))
(if (> (length splits) 1)
(begin
(display "qif-import:qif-xtn-to-gnc-xtn : ")
(display "splits in stock transaction!") (newline)))
(gnc:split-set-share-amount gnc-near-split numshares)
(gnc:split-set-share-amount gnc-far-split (- numshares))))
;; find the GNC account on the far end of the split
(cond
;; this is a stock xtn with no specified category, which
;; generally means this account is a brokerage account
;; description.
((and (not (qif-xtn:bank-xtn? qif-xtn))
(string=? (qif-split:category qif-split) ""))
(set! far-acct-info
(hash-ref qif-acct-map
(qif-file:account qif-file)))
(set! far-acct-name
(list-ref far-acct-info 1))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name)))
;; this is a normal stock or bank transfer to another
;; account
((qif-split:category-is-account? qif-split)
(set! far-acct-info
(hash-ref qif-acct-map
(qif-split:category qif-split)))
(set! far-acct-name
(list-ref far-acct-info 1))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name)))
;; otherwise the category is a category and won't have a
;; matching split in the QIF world.
(#t
(set! far-acct-info
(hash-ref qif-cat-map
(qif-split:category qif-split)))
(set! far-acct-name
(list-ref far-acct-info 1))
(set! far-acct (hash-ref gnc-acct-hash far-acct-name))))
;; set the reconcile status. I thought I could set using
;; the quicken type, but it looks like #\r reconcile
;; states aren't preserved across gnucash save/restores.
(let ((cleared (qif-split:matching-cleared qif-split)))
(if (or (eq? 'cleared cleared)
(eq? 'reconciled cleared))
(gnc:split-set-reconcile gnc-far-split #\c)))
;; finally, plug the splits into the accounts
(gnc:transaction-append-split gnc-xtn gnc-far-split)
(gnc:account-insert-split far-acct gnc-far-split)))
splits)
(gnc:split-set-base-value gnc-near-split
near-split-total
(qif-file:currency qif-file))
(gnc:transaction-append-split gnc-xtn gnc-near-split)
(gnc:account-insert-split near-acct gnc-near-split)
(if (or (eq? qif-cleared 'cleared)
(eq? qif-cleared 'reconciled))
(gnc:split-set-reconcile gnc-near-split #\c))
;; return the modified transaction (though it's ignored).
gnc-xtn))
@ -428,15 +486,16 @@
(date (qif-xtn:date xtn))
(amount (- (qif-split:amount split)))
(memo (qif-split:memo split))
(bank-xtn? (qif-xtn:bank-xtn? xtn))
(bank-xtn? (not (qif-xtn:security-name xtn)))
(cleared? #f)
(done #f))
;; FIXME security stuff
(if bank-xtn?
(let ((near (qif-xtn:from-acct xtn)))
(if near
(set! near-acct-name near)
(set! near-acct-name (qif-file:account qif-file))))
(set! near-acct-name (qif-file:default-account qif-file))))
(set! near-acct-name (qif-xtn:security-name xtn)))
;; (display "mark-matching-split : near-acct = ")
@ -462,7 +521,7 @@
;; (string=? far-acct-name
;; (qif-file:account (car files)))))
(let xtn-loop ((xtns (qif-file:xtns (car files))))
(let xtn-loop ((xtns (qif-file:markable-xtns (car files))))
(if (not (qif-xtn:mark (car xtns)))
(let split-loop ((splits (qif-xtn:splits (car xtns))))
(if (qif-split:split-matches?

8
src/scm/qif-import/qif-utils.scm
View File

@ -23,9 +23,6 @@
(make-regexp "^ *([^ ].*)$"))
(define (string-remove-trailing-space str)
(if (eq? (string-ref str (- (string-length str) 1)) #\cr)
(string-set! str (- (string-length str) 1) #\space))
(let ((match (regexp-exec remove-trailing-space-rexp str)))
(if match
(string-copy (match:substring match 1))
@ -76,3 +73,8 @@
(set! parts (cons (substring str 0 last-char) parts))))
parts))
(define (string-to-canonical-symbol str)
(string->symbol
(string-downcase
(string-remove-leading-space
(string-remove-trailing-space str)))))

81
src/scm/qif-import/simple-obj.scm
View File

@ -25,77 +25,20 @@
;; the 'simple-class' class.
(define (make-simple-class class-symbol slot-names)
(let ((slots (make-vector 3))
(slot-hash (make-hash-table 11))
(slot-counter 0))
(vector-set! slots 0 class-symbol)
(vector-set! slots 1 slot-hash)
(vector-set! slots 2 slot-names)
(for-each
(lambda (elt)
(hash-set! slot-hash elt slot-counter)
(set! slot-counter (+ 1 slot-counter)))
slot-names)
(cons 'simple-class slots)))
(make-record-type (symbol->string class-symbol) slot-names))
(define (simple-class? self)
(and (pair? self) (eq? (car self) 'simple-class)))
(define (simple-obj-getter class slot)
(record-accessor class slot))
(define (simple-obj-getter obj class slot)
(let ((slot-num (hash-ref (vector-ref (cdr class) 1) slot)))
(vector-ref (cdr obj) slot-num)))
(define (simple-obj-setter class slot)
(record-modifier class slot))
;; (if (and (pair? obj)
;; (simple-class? class))
;; (if (eq? (vector-ref (cdr class) 0) (car obj))
;; (let ((slot-num-pair (assq slot (vector-ref (cdr class) 1))))
;; (if slot-num-pair
;; (if (vector? (cdr obj))
;; (vector-ref (cdr obj) (cdr slot-num-pair))
;; (error "simple-obj-getter: data field not a vector??"))
;; (error "simple-obj-getter: no slot " slot " in class "
;; class)))
;; (error "simple-obj-getter: object " obj " is not of class "
;; class))
;; (error "simple-obj-getter: bad object/class " obj class)))
(define (simple-obj-setter obj class slot value)
(let ((slot-num (hash-ref (vector-ref (cdr class) 1) slot)))
(vector-set! (cdr obj) slot-num value)))
;; (if (and (pair? obj)
;; (simple-class? class))
;; (if (eq? (vector-ref (cdr class) 0) (car obj))
;; (let ((slot-num-pair (assq slot (vector-ref (cdr class) 1))))
;; (if slot-num-pair
;; (if (vector? (cdr obj))
;; (vector-set! (cdr obj) (cdr slot-num-pair) value)
;; (error "simple-obj-setter: data field not a vector??"))
;; (error "simple-obj-setter: no slot " slot " in class "
;; class)))
;; (error "simple-obj-setter: object " obj " is not of class "
;; class))
;; (error "simple-obj-setter: bad object/class " obj class)))
(define (simple-obj-print obj class)
(display ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;") (newline)
(for-each
(lambda (slot)
(display " ")
(display slot)
(display " : ")
(write (simple-obj-getter obj class slot))
(newline))
(vector-ref (cdr class) 2)))
(define (simple-obj-type obj)
(if (pair? obj)
(car obj)
#f))
(define (simple-obj-print obj)
(write obj))
(define (make-simple-obj class)
(if (simple-class? class)
(cons (vector-ref (cdr class) 0)
(make-vector (length (vector-ref (cdr class) 2)) #f))))
(let ((ctor (record-constructor class))
(field-defaults
(map (lambda (v) #f) (record-type-fields class))))
(apply ctor field-defaults)))

31
src/scm/report/transaction-report-2.scm
View File

@ -12,8 +12,24 @@
(let ()
(define string-db (gnc:make-string-database))
(define (make-account-subheading acc-name from-date)
(let* ((separator (string-ref (gnc:account-separator-char) 0))
(balance-at-start (gnc:account-get-balance-at-date
(gnc:get-account-from-full-name
(gnc:get-current-group)
acc-name
separator)
from-date
#f)))
(string-append acc-name
" ("
(string-db 'lookup 'open-bal-string)
" "
(gnc:amount->formatted-string balance-at-start #f)
")"
)))
(define (make-split-report-spec options)
(define (make-split-report-spec options)
(remove-if-not
(lambda (x) x)
(list
@ -221,7 +237,7 @@
#f)
#f))))
(define (split-report-get-sort-spec-entry key ascending?)
(define (split-report-get-sort-spec-entry key ascending? begindate)
(case key
((account)
(make-report-sort-spec
@ -230,7 +246,7 @@
(if ascending? string-ci<? string-ci>?)
string-ci=?
string-ci=?
(lambda (x) x)))
(lambda (x) (make-account-subheading x begindate))))
((date)
(make-report-sort-spec
@ -336,7 +352,7 @@
((amount)
(make-report-sort-spec
gnc:split-get-amount
gnc:split-get-value
(if ascending? < >)
=
#f
@ -585,10 +601,12 @@
(car (gnc:option-value enddate))))
(s1 (split-report-get-sort-spec-entry
(gnc:option-value tr-report-primary-key-op)
(eq? (gnc:option-value tr-report-primary-order-op) 'ascend)))
(eq? (gnc:option-value tr-report-primary-order-op) 'ascend)
(gnc:option-value begindate)))
(s2 (split-report-get-sort-spec-entry
(gnc:option-value tr-report-secondary-key-op)
(eq? (gnc:option-value tr-report-secondary-order-op) 'ascend)))
(eq? (gnc:option-value tr-report-secondary-order-op) 'ascend)
(gnc:option-value begindate)))
(s2b (if s2 (list s2) '()))
(sort-specs (if s1 (cons s1 s2b) s2b))
(split-list
@ -641,6 +659,7 @@
(string-db 'store 'debit-string "Debit")
(string-db 'store 'credit-string "Credit")
(string-db 'store 'total-string "Total")
(string-db 'store 'open-bal-string "Opening Balance")
(gnc:define-report
'version 1