From af11a549e3d32598094d9178f74f2bb325ca0168 Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Tue, 8 Aug 2023 08:18:23 -0500 Subject: [PATCH 1/7] Implement support for !Type:Prices QIF records. --- gnucash/import-export/qif-imp/file-format.txt | 17 ++ gnucash/import-export/qif-imp/qif-file.scm | 87 ++++++++- gnucash/import-export/qif-imp/qif-objects.scm | 62 +++++- gnucash/import-export/qif-imp/qif-to-gnc.scm | 182 ++++++++++++++++++ .../qif-imp/test/test-qif-imp.scm | 22 +++ 5 files changed, 367 insertions(+), 3 deletions(-) diff --git a/gnucash/import-export/qif-imp/file-format.txt b/gnucash/import-export/qif-imp/file-format.txt index b725f09aba..a65b4254ae 100644 --- a/gnucash/import-export/qif-imp/file-format.txt +++ b/gnucash/import-export/qif-imp/file-format.txt @@ -39,6 +39,7 @@ Type of account identifiers !Type:Cat Category list !Type:Class Class list !Type:Memorized Memorized transaction list +!Type:Prices Security prices Note that !Account is used both to be a header for account information, and to be a header for a list of transactions. @@ -236,6 +237,22 @@ L Link W Private +Security Prices +--------------- +The records in a list of security prices do not use any letter +identifiers, and take the following form: +"",,"" +where is the security's ticker symbol, is the security +price, and is the date the security had that price. +The price can be either a decimal number of a whole number followed by +a practional price. For example, for shares of Intuit updated 6/30/98, +with a price of $50.50 per share, the price record would be: +"INTU",50 1/2,"6/30/98" +or +"INTU",50.50,"6/30/98" +Each price is followed by a ^ (end of entry indicator). + + ===================================================================== General Notes ===================================================================== diff --git a/gnucash/import-export/qif-imp/qif-file.scm b/gnucash/import-export/qif-imp/qif-file.scm index 500073aae7..f27e460b97 100644 --- a/gnucash/import-export/qif-imp/qif-file.scm +++ b/gnucash/import-export/qif-imp/qif-file.scm @@ -49,6 +49,7 @@ (export qif-file:parse-fields-results) (export qif-file:read-file) (export qif-file:reparse-dates) +(export qif-file:parse-price-line) (define qif-bad-numeric-rexp (make-regexp "^\\.\\.\\.")) @@ -229,8 +230,7 @@ ;; Security price list ((type:prices) - ;; Not supported. We really should warn the user. - #f) + (set! current-xtn (make-qif-price))) ((option:autoswitch) (set! ignore-accounts #t)) @@ -516,6 +516,20 @@ (else (mywarn (G_ "Ignoring security line") ": " line)))) + ;;;;;;;;;;;;;;;; + ;; Price list ;; + ;;;;;;;;;;;;;;;; + ((type:prices) + (case tag + ((#\^) + ;; end-of-record + (set! current-xtn (make-qif-price))) + (else + ;; Parse the price which is a mini csv of 3 entries + (set! current-xtn (qif-file:parse-price-line line)) + (if (equal? current-xtn #f) + (mywarn (G_ "Could not parse price line") ": " line) + (qif-file:add-price! self current-xtn))))) ;; trying to sneak one by, eh? (else @@ -724,6 +738,9 @@ ;; (set-sub (G_ "Parsing categories")) ;; The category tasks will be 5% of the overall parsing effort. + ;; Note, the presumption is that reading the file is 70% of the + ;; overall effort, so this function only has ~30% to dole out, + ;; hence 5% at a time here (start-sub 0.05) ;; Tax classes; assume this is 50% of the category parsing effort. @@ -792,6 +809,39 @@ (finish-sub) + ;; + ;; Prices + ;; + (set-sub (G_ "Parsing prices")) + ;; We process the list of prices + (start-sub 0.05) + + ;; Dates + (start-sub 0.5) + (check-and-parse-field + qif-price:date qif-price:set-date! equal? + qif-parse:check-date-format '(m-d-y d-m-y y-m-d y-d-m) + qif-parse:parse-date/format + (qif-file:prices self) + qif-parse:print-date + 'error-on-ambiguity add-error 'date + update-progress) + (finish-sub) + + ;; Amounts + (start-sub 1) + (check-and-parse-field + qif-price:share-price qif-price:set-share-price! gnc-numeric-equal + qif-parse:check-number-format '(decimal comma) + qif-parse:parse-number/format (qif-file:prices self) + qif-parse:print-number + 'guess-on-ambiguity add-error 'share-price + update-progress) + (finish-sub) + + (finish-sub) + + ;; ;; fields of transactions ;; @@ -1083,3 +1133,36 @@ (test-results (cdr results)))))) (if results (test-results results) #f)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-file:parse-price-line +;; +;; Takes an expected price line and returns a qif-price object +;; +;; We are parsing "SYMBOL",value,"DATE" +;; where symbol is the alpha name of the security symbol, +;; value can be a float like 42.50 or a fractional expression like 42 1/2 +;; and date can be the typical Quicken date formats +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-file:parse-price-line line) + (let ((current-xtn (make-qif-price))) + (if (not (false-if-exception + (let* ((symbol (string-trim-both (string-trim-both (car (string-split line #\,)) char-set:punctuation))) + (price (cadr (string-split line #\,))) + (fracprice (string-split price #\space)) + (date (string-trim-both (string-trim-both (caddr (string-split line #\,)) char-set:punctuation)))) + + (qif-price:set-symbol! current-xtn symbol) + (qif-price:set-date! current-xtn date) + + ;; If we have a fractional portion, convert it to float + (if (> (length fracprice) 1) + (let ((total (+ (string->number (car fracprice)) + (string->number (cadr fracprice))))) + (set! price (format #f "~f" total)))) + + (qif-price:set-share-price! current-xtn price)))) + (set! current-xtn #f)) + current-xtn)) diff --git a/gnucash/import-export/qif-imp/qif-objects.scm b/gnucash/import-export/qif-imp/qif-objects.scm index bad7baad10..7a306815ae 100644 --- a/gnucash/import-export/qif-imp/qif-objects.scm +++ b/gnucash/import-export/qif-imp/qif-objects.scm @@ -44,6 +44,7 @@ (export make-qif-map-entry) (export make-qif-split) (export make-qif-stock-symbol) +(export make-qif-price) (export make-qif-xtn) (export make-ticker-map) (export qif-acct:budget) @@ -75,6 +76,8 @@ (export qif-file:add-cat!) (export qif-file:add-class!) (export qif-file:add-xtn!) +(export qif-file:add-price!) +(export qif-file:prices) (export qif-file:cats) (export qif-file:path) (export qif-file:path-to-accountname) @@ -112,6 +115,12 @@ (export qif-stock-symbol:set-name!) (export qif-stock-symbol:set-symbol!) (export qif-stock-symbol:set-type!) +(export qif-price:symbol) +(export qif-price:set-symbol!) +(export qif-price:date) +(export qif-price:set-date!) +(export qif-price:share-price) +(export qif-price:set-share-price!) (export qif-ticker-map:add-ticker!) (export qif-ticker-map:lookup-symbol) (export qif-ticker-map:lookup-type) @@ -156,6 +165,7 @@ ;; accounts : list of ;; cats : list of ;; classes : list of +;; prices : list of ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define @@ -166,7 +176,8 @@ xtns accounts cats - classes))) + classes + prices))) (define qif-file? (record-predicate )) @@ -207,6 +218,12 @@ (define qif-file:set-accounts! (record-modifier 'accounts)) +(define qif-file:prices + (record-accessor 'prices)) + +(define qif-file:set-prices! + (record-modifier 'prices)) + (define (make-qif-file) (let ((self (construct ))) (qif-file:set-y2k-threshold! self 50) @@ -214,6 +231,7 @@ (qif-file:set-accounts! self '()) (qif-file:set-cats! self '()) (qif-file:set-classes! self '()) + (qif-file:set-prices! self '()) self)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -627,6 +645,10 @@ (qif-file:set-accounts! self (cons account (qif-file:accounts self)))) +(define (qif-file:add-price! self price) + (qif-file:set-prices! self + (cons price (qif-file:prices self)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; munge the QIF filename to create a simple default account name @@ -787,6 +809,44 @@ (qif-stock-symbol:set-type! retval "") retval)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Symbol,shares,date +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define + (make-record-type + 'qif-price + '(symbol share-price date))) + +(define qif-price:symbol + (record-accessor 'symbol)) + +(define qif-price:set-symbol! + (record-modifier 'symbol)) + +(define qif-price:share-price + (record-accessor 'share-price)) + +(define qif-price:set-share-price! + (record-modifier 'share-price)) + +(define qif-price:date + (record-accessor 'date)) + +(define qif-price:set-date! + (record-modifier 'date)) + +(define (qif-price:print self) + (write self)) + +(define (make-qif-price) + (let ((retval (construct ))) + (qif-price:set-symbol! retval "") + (qif-price:set-share-price! retval "") + (qif-price:set-date! retval "") + retval)) + (define (make-record-type 'qif-ticker-map diff --git a/gnucash/import-export/qif-imp/qif-to-gnc.scm b/gnucash/import-export/qif-imp/qif-to-gnc.scm index ec10404371..193c67ea61 100644 --- a/gnucash/import-export/qif-imp/qif-to-gnc.scm +++ b/gnucash/import-export/qif-imp/qif-to-gnc.scm @@ -347,6 +347,12 @@ qif-files-list) + ;; Add any prices to the list of work to do + (for-each + (lambda (qif-file) + (set! work-to-do (+ (length (qif-file:prices qif-file)) work-to-do))) + qif-files-list) + ;; Build a local account tree to hold converted transactions. (if progress-dialog (gnc-progress-dialog-set-sub progress-dialog @@ -449,6 +455,87 @@ (qif-file:xtns qif-file))) sorted-qif-files-list) + ;; Add prices + (let ((pricedb (gnc-pricedb-get-db (gnc-get-current-book))) + (symbol-hash (make-symbol-hash stock-map)) + (sorted-prices '()) + (pruned-prices '()) + (pruned-price-count 0) + (commodity #f) + (current-symbol " invalid symbol ")) + + ;; Let's combine all the prices and sort them; it + ;; is slightly more efficient to do them by symbol and + ;; tidies up error reporting on missing symbols + (for-each + (lambda (qif-file) + (set! sorted-prices (append sorted-prices (qif-file:prices qif-file)))) + qif-files-list) + + (set! sorted-prices (sort sorted-prices + (lambda (a b) + (string-ci pruned-price-count 0) + (qif-import:log progress-dialog + "qif-import:qif-to-gnc" + (G_ (format #f "Warning: skipped ~a prices on days that already had prices." pruned-price-count)))) + + (gnc-progress-dialog-set-sub progress-dialog + (string-append (G_ "Adding prices"))))) + + ;; Reset and run again, this time to actually add prices + (set! current-symbol " -- unknown --") + (for-each + (lambda (price) + (if (not (string-ci=? current-symbol (qif-price:symbol price))) + (begin + (set! current-symbol (qif-price:symbol price)) + (set! commodity (hash-ref symbol-hash current-symbol)))) + + (if (not (equal? commodity #f)) + (let* ((gnc-price (gnc-price-create (gnc-get-current-book))) + ;; We skip any bad price results, instead of crashing the whole process + (okay (false-if-exception + (qif-price-to-gnc-price price gnc-price + default-currency commodity progress-dialog)))) + (if okay (gnc-pricedb-add-price pricedb gnc-price)) + (gnc-price-unref gnc-price))) + (update-progress)) + pruned-prices) + + (gnc-pricedb-commit-edit pricedb)) + ;; Finished. (if progress-dialog (gnc-progress-dialog-set-value progress-dialog 1)) @@ -1259,3 +1346,98 @@ (xaccAccountBeginEdit root) (xaccAccountDestroy root)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utility procedures for handling prices +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; make-symbol-hash +;; +;; Quicken provides historical price data using the stock symbol. +;; We generate a map of symbol to commodity in order to update prices. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (make-symbol-hash stock-map) + (let ((table (make-hash-table 20))) + (hash-for-each + (lambda (stock commodity) + (let ((symbol (gnc-commodity-get-mnemonic commodity))) + (hash-set! table symbol commodity))) + stock-map) + table)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; duplicate-price? +;; +;; Is there already a price for this commodity? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (duplicate-price? pricedb commodity currency qif-price) + (let* ((qif-date (qif-price:date qif-price)) + (time64 (qif-date-to-time64 qif-date)) + (tm (gnc-localtime time64)) + (near-price (gnc-pricedb-lookup-nearest-before-t64 pricedb commodity currency time64)) + (near-tm (gnc-localtime (gnc-price-get-time64 near-price))) + (dupe #f)) + (if (and (equal? (tm:year tm) (tm:year near-tm)) + (equal? (tm:mon tm) (tm:mon near-tm)) + (equal? (tm:mday tm) (tm:mday near-tm))) + (set! dupe #t)) + dupe)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-date-to-time64 +;; +;; Convert our internal qif-date format into a time64 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (qif-date-to-time64 qif-date) + (let ((tm (gnc-localtime (current-time)))) + ;; Choose a 'neutral' time of day, instead of time of import + (set-tm:hour tm 10) + (set-tm:min tm 59) + (set-tm:sec tm 0) + (set-tm:mday tm (car qif-date)) + (set-tm:mon tm (- (cadr qif-date) 1)) + (set-tm:year tm (- (caddr qif-date) 1900)) + (gnc-mktime tm))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-price-to-gnc-price +;; translate a single price to a GNCPrice structure +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (qif-price-to-gnc-price qif-price gnc-price + default-currency commodity progress-dialog) + (let* ((qif-symbol (qif-price:symbol qif-price)) + (qif-share-price (qif-price:share-price qif-price)) + (qif-date (qif-price:date qif-price)) + (gnc-value (gnc-numeric-zero))) + + ;; Check the transaction date. + (if (not qif-date) + ((qif-import:log progress-dialog + "qif-price-to-gnc-price" + (G_ "Invalid transaction date.")) + (throw 'bad-date + "qif-price-to-gnc-price" + "Missing transaction date." + #f + #f))) + + ;; Set properties of the whole transaction. + (gnc-price-begin-edit gnc-price) + (gnc-price-set-commodity gnc-price commodity) + (gnc-price-set-currency gnc-price default-currency) + (gnc-price-set-source-string gnc-price "user:price") + + ;; other options for type are "last" or "nav" which are + ;; the last known price for a stock or the net asset value + ;; for a mutual fund. We don't really know, so we'll + ;; go with unknown + (gnc-price-set-typestr gnc-price "unknown") + + (gnc-price-set-value gnc-price (gnc-numeric-create + (numerator qif-share-price) (denominator qif-share-price))) + (gnc-price-set-time64 gnc-price (qif-date-to-time64 qif-date)) + (gnc-price-commit-edit gnc-price) + + ;; return the transaction + gnc-price)) diff --git a/gnucash/import-export/qif-imp/test/test-qif-imp.scm b/gnucash/import-export/qif-imp/test/test-qif-imp.scm index 37825022b7..08071be90a 100644 --- a/gnucash/import-export/qif-imp/test/test-qif-imp.scm +++ b/gnucash/import-export/qif-imp/test/test-qif-imp.scm @@ -8,6 +8,7 @@ (test-runner-factory gnc:test-runner) (test-begin "test-qif-imp") (test-string) + (test-price-parse) (test-qif-objects) (test-end "test-qif-imp")) @@ -57,3 +58,24 @@ (test-assert "make-ticker-map is called from C" (make-ticker-map))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; qif-file.scm +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (test-price-parse) + (let ((parsed (qif-file:parse-price-line "\"ABC\",1.0,\"1/1/04\"")) + (model (make-qif-price))) + (qif-price:set-symbol! model "ABC") + (qif-price:set-share-price! model "1.0") + (qif-price:set-date! model "1/1/04") + (test-equal parsed model)) + + (let ((parsed (qif-file:parse-price-line "\"ABC\",1 3/4,\"1/1' 4\"")) + (model (make-qif-price))) + (qif-price:set-symbol! model "ABC") + (qif-price:set-share-price! model "1.75") + (qif-price:set-date! model "1/1' 4") + (test-equal parsed model)) + + (let ((parsed (qif-file:parse-price-line "\"ABC\",\"1/1' 4\""))) + (test-equal parsed #f))) From 9cacaa72e8ece3ec59cde6b45cbd275fcb1d8c85 Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Mon, 14 Aug 2023 09:09:56 -0500 Subject: [PATCH 2/7] Build the pruned list with cons, not append. It is 10x faster against a large dataset. Insight from Christopher Lam. --- gnucash/import-export/qif-imp/qif-to-gnc.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnucash/import-export/qif-imp/qif-to-gnc.scm b/gnucash/import-export/qif-imp/qif-to-gnc.scm index 193c67ea61..dda5214d2a 100644 --- a/gnucash/import-export/qif-imp/qif-to-gnc.scm +++ b/gnucash/import-export/qif-imp/qif-to-gnc.scm @@ -499,10 +499,11 @@ (G_ (format #f "Warning: cannot find commodity for symbol ~a." current-symbol)))))) (if (not (equal? commodity #f)) (if (not (duplicate-price? pricedb commodity default-currency price)) - (set! pruned-prices (append pruned-prices (list price))) + (set! pruned-prices (cons price pruned-prices)) (set! pruned-price-count (+ 1 pruned-price-count)))) (update-progress)) sorted-prices) + (set! pruned-prices (reverse pruned-prices)) (if progress-dialog (begin From 06b6d60f5bcd085b9abb13ae19e6bbd08d8b7980 Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Mon, 14 Aug 2023 09:36:14 -0500 Subject: [PATCH 3/7] Screen out price records with blank values. Found a live Quicken record with an empty price. --- gnucash/import-export/qif-imp/qif-file.scm | 6 +++++- gnucash/import-export/qif-imp/test/test-qif-imp.scm | 3 +++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/gnucash/import-export/qif-imp/qif-file.scm b/gnucash/import-export/qif-imp/qif-file.scm index f27e460b97..06fce170b8 100644 --- a/gnucash/import-export/qif-imp/qif-file.scm +++ b/gnucash/import-export/qif-imp/qif-file.scm @@ -1163,6 +1163,10 @@ (string->number (cadr fracprice))))) (set! price (format #f "~f" total)))) - (qif-price:set-share-price! current-xtn price)))) + (qif-price:set-share-price! current-xtn price) + + ;; A blank entry will not necessarily throw an exception, but is invalid + (if (or (string-null? symbol) (or (string-null? price) (string-null? date))) + (set! current-xtn #f))))) (set! current-xtn #f)) current-xtn)) diff --git a/gnucash/import-export/qif-imp/test/test-qif-imp.scm b/gnucash/import-export/qif-imp/test/test-qif-imp.scm index 08071be90a..dda423448a 100644 --- a/gnucash/import-export/qif-imp/test/test-qif-imp.scm +++ b/gnucash/import-export/qif-imp/test/test-qif-imp.scm @@ -77,5 +77,8 @@ (qif-price:set-date! model "1/1' 4") (test-equal parsed model)) + (let ((parsed (qif-file:parse-price-line "\"ABC\",,\"1/1' 4\""))) + (test-equal parsed #f)) + (let ((parsed (qif-file:parse-price-line "\"ABC\",\"1/1' 4\""))) (test-equal parsed #f))) From dd429aaa0c49f997d5358d2ef7202024181f54f5 Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Wed, 16 Aug 2023 15:29:35 -0500 Subject: [PATCH 4/7] Present warnings from the file load step. The price import will now throw warnings if there are invalid prices. The previous logic would 'auto-next' in this case, only holding if the parse-file phase threw warnings. This change insures that these warnings are seen. --- gnucash/import-export/qif-imp/assistant-qif-import.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/gnucash/import-export/qif-imp/assistant-qif-import.c b/gnucash/import-export/qif-imp/assistant-qif-import.c index 236bcea363..8c3733e862 100644 --- a/gnucash/import-export/qif-imp/assistant-qif-import.c +++ b/gnucash/import-export/qif-imp/assistant-qif-import.c @@ -172,6 +172,7 @@ struct _qifimportwindow gboolean show_doc_pages; gboolean ask_date_format; gboolean busy; + gboolean read_file_warnings; gboolean load_stop; gboolean acct_tree_found; gboolean new_book; @@ -1547,6 +1548,7 @@ gnc_ui_qif_import_intro_prepare (GtkAssistant *assistant, gpointer user_data) /* Set load stop to FALSE */ wind->load_stop = FALSE; + wind->read_file_warnings = FALSE; files_list = scm_call_2 (unload, wind->selected_file, wind->imported_files); @@ -1854,6 +1856,8 @@ gnc_ui_qif_import_load_progress_start_cb (GtkButton * button, wind->busy = FALSE; wind->load_stop = TRUE; } + else + wind->read_file_warnings = TRUE; } /* @@ -1992,7 +1996,8 @@ gnc_ui_qif_import_load_progress_start_cb (GtkButton * button, gtk_widget_set_sensitive (wind->load_pause, FALSE); wind->busy = FALSE; - if (wind->load_stop == FALSE) + + if (wind->load_stop == FALSE && wind->read_file_warnings == FALSE) { /* Auto step to next page */ gtk_assistant_set_current_page (assistant, num + 1); From 6bf062c738b31c8ad7fccb6d36aab4b1cd6651ab Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Wed, 16 Aug 2023 15:33:04 -0500 Subject: [PATCH 5/7] Add a qif file with !Type:Prices transactions. Including a few deliberate errors. --- doc/examples/price.qif | 84 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 doc/examples/price.qif diff --git a/doc/examples/price.qif b/doc/examples/price.qif new file mode 100644 index 0000000000..65191233f6 --- /dev/null +++ b/doc/examples/price.qif @@ -0,0 +1,84 @@ +!Account +NAssets:Investments:Mutual Funds:Account ABC +TMutual +DDeferred Compensation +^ +NAssets:Investments:Mutual Funds:Account GHI +TPort +^ +!Account +NAssets:Investments:Mutual Funds:Account ABC +DDeferred Compensation +TInvst +^ +!Type:Security +NSecurity ABC +SABC +TMutual Fund +^ +!Type:Security +NDEF Fund +SDEF +TMutual Fund +^ +!Type:Security +NSecurity GHI +SGHI +TMutual Fund +^ +!Type:Invst +D12/31/00 +NShrsIn +YSecurity ABC +I30.34 +Q1,343.648538 +U40,766.30 +T40,766.30 +^ +D2/02/04 +NSellX +YSecurity ABC +I30.34 +Q1,343.648538 +U40,766.30 +T40,766.30 +L[Assets:Investments:Mutual Funds:Account GHI] +$40,766.30 +^ +D2/02/04 +NBuyX +YSecurity GHI +I18.60999 +Q2,190.56 +U40,766.30 +T40,766.30 +MEst. price as of 2/2/04 +L[Assets:Investments:Mutual Funds:Account ABC] +$40,766.30 +!Type:Prices +"DEF",1.05,"01/06/18" +^ +!Type:Prices +"ABC",1,"01/01/18" +^ +!Type:Prices +"ABC",1.02,"01/03/18" +^ +!Type:Prices +"ABC",1 15/16,"01/03/19" +^ +!Type:Prices +"DEF",1.03,"01/04/18" +^ +!Type:Prices +"ABC",1.01,"01/20/00" +^ +!Type:Prices +"DEF",1 3/4,"01/05/18" +^ +!Type:Prices +"GHI",1 1/2,"01/05/21" +^ +!Type:Prices +"ABC",," 1/18'38" +^ From 34946c746190ec09c974d02ab014b629c9595564 Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Tue, 29 Aug 2023 16:38:38 -0500 Subject: [PATCH 6/7] Remove exceptions and use patterns in parse-price-line. Also use a more standard numberic parser instead of an ad-hoc string parser. Code written by Christopher Lam. --- gnucash/import-export/qif-imp/qif-file.scm | 43 +++++++++------------ gnucash/import-export/qif-imp/qif-parse.scm | 8 +++- 2 files changed, 25 insertions(+), 26 deletions(-) diff --git a/gnucash/import-export/qif-imp/qif-file.scm b/gnucash/import-export/qif-imp/qif-file.scm index 06fce170b8..f80e042e75 100644 --- a/gnucash/import-export/qif-imp/qif-file.scm +++ b/gnucash/import-export/qif-imp/qif-file.scm @@ -39,6 +39,7 @@ (use-modules (srfi srfi-1)) (use-modules (srfi srfi-13)) (use-modules (ice-9 rdelim)) +(use-modules (ice-9 match)) (use-modules (gnucash qif-import qif-objects)) (use-modules (gnucash qif-import qif-utils)) (use-modules (gnucash qif-import qif-parse)) @@ -832,7 +833,7 @@ (start-sub 1) (check-and-parse-field qif-price:share-price qif-price:set-share-price! gnc-numeric-equal - qif-parse:check-number-format '(decimal comma) + qif-parse:check-number-format '(decimal comma rational) qif-parse:parse-number/format (qif-file:prices self) qif-parse:print-number 'guess-on-ambiguity add-error 'share-price @@ -883,7 +884,7 @@ (start-sub 0.1) (check-and-parse-field qif-xtn:share-price qif-xtn:set-share-price! gnc-numeric-equal - qif-parse:check-number-format '(decimal comma) + qif-parse:check-number-format '(decimal comma rational) qif-parse:parse-number/format (qif-file:xtns self) qif-parse:print-number 'guess-on-ambiguity add-error 'share-price @@ -1147,26 +1148,18 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (qif-file:parse-price-line line) - (let ((current-xtn (make-qif-price))) - (if (not (false-if-exception - (let* ((symbol (string-trim-both (string-trim-both (car (string-split line #\,)) char-set:punctuation))) - (price (cadr (string-split line #\,))) - (fracprice (string-split price #\space)) - (date (string-trim-both (string-trim-both (caddr (string-split line #\,)) char-set:punctuation)))) - - (qif-price:set-symbol! current-xtn symbol) - (qif-price:set-date! current-xtn date) - - ;; If we have a fractional portion, convert it to float - (if (> (length fracprice) 1) - (let ((total (+ (string->number (car fracprice)) - (string->number (cadr fracprice))))) - (set! price (format #f "~f" total)))) - - (qif-price:set-share-price! current-xtn price) - - ;; A blank entry will not necessarily throw an exception, but is invalid - (if (or (string-null? symbol) (or (string-null? price) (string-null? date))) - (set! current-xtn #f))))) - (set! current-xtn #f)) - current-xtn)) + (define (remove-punctuation s) (string-trim-both s char-set:punctuation)) + (and (string? line) + (match (string-split line #\,) + (((= remove-punctuation symbol) (= gnc-numeric-from-string value) (= remove-punctuation date)) + (cond + ((string-null? symbol) #f) + ((not value) #f) + ((string-null? date) #f) + (else + (let ((xtn (make-qif-price))) + (qif-price:set-symbol! xtn symbol) + (qif-price:set-date! xtn date) + (qif-price:set-share-price! xtn (number->string value)) + xtn)))) + (_ #f)))) diff --git a/gnucash/import-export/qif-imp/qif-parse.scm b/gnucash/import-export/qif-imp/qif-parse.scm index 5f4fbe1a96..cf28f75a7e 100644 --- a/gnucash/import-export/qif-imp/qif-parse.scm +++ b/gnucash/import-export/qif-imp/qif-parse.scm @@ -404,6 +404,11 @@ (and regexp-enabled? (make-regexp "^ *[$]?[+-]?[$]?[0-9]+[+-]?$|^ *[$]?[+-]?[$]?[0-9]?[0-9]?[0-9]?([\\.'][0-9][0-9][0-9])*(,[0-9]*)?[+-]? *$|^ *[$]?[+-]?[$]?[0-9]+,[0-9]*[+-]? *$"))) +;; eg 1/2 or 32/15 or 4 +(define rational-regexp + (and regexp-enabled? + (make-regexp "^-?[0-9]+(/[0-9]+|)$"))) + ;; eg 456 or 123 (define integer-regexp (and regexp-enabled? @@ -419,6 +424,7 @@ (define numtypes-alist (list (cons 'decimal decimal-radix-regexp) (cons 'comma comma-radix-regexp) + (cons 'rational rational-regexp) (cons 'integer integer-regexp))) (filter (lambda (fmt) (regexp-exec (assq-ref numtypes-alist fmt) value-string)) possible-formats)) @@ -439,7 +445,7 @@ ((comma) (gnc:string-replace-char (gnc:string-delete-chars filtered-string ".") #\, #\.)) - ((integer) filtered-string))) + ((integer rational) filtered-string))) (num (or (string->number (string-append "#e" read-string)) 0))) (if has-minus? (- num) num))) From 737e732e1c444c2dff9288303a382347f7085576 Mon Sep 17 00:00:00 2001 From: Jeremy White Date: Wed, 30 Aug 2023 12:42:27 -0500 Subject: [PATCH 7/7] Fixup qif-imp price unit tests. The expected results changed with commit 80f7e60f49. At the same time, improve readability of test results by assigning a tag and ordering expected vs actual correctly. --- gnucash/import-export/qif-imp/test/test-qif-imp.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/gnucash/import-export/qif-imp/test/test-qif-imp.scm b/gnucash/import-export/qif-imp/test/test-qif-imp.scm index dda423448a..7b5a0e33a7 100644 --- a/gnucash/import-export/qif-imp/test/test-qif-imp.scm +++ b/gnucash/import-export/qif-imp/test/test-qif-imp.scm @@ -66,19 +66,19 @@ (let ((parsed (qif-file:parse-price-line "\"ABC\",1.0,\"1/1/04\"")) (model (make-qif-price))) (qif-price:set-symbol! model "ABC") - (qif-price:set-share-price! model "1.0") + (qif-price:set-share-price! model "1") (qif-price:set-date! model "1/1/04") - (test-equal parsed model)) + (test-equal "parse-price-line-decimal" model parsed)) (let ((parsed (qif-file:parse-price-line "\"ABC\",1 3/4,\"1/1' 4\"")) (model (make-qif-price))) (qif-price:set-symbol! model "ABC") - (qif-price:set-share-price! model "1.75") + (qif-price:set-share-price! model "7/4") (qif-price:set-date! model "1/1' 4") - (test-equal parsed model)) + (test-equal "parse-price-line-fraction" parsed model)) (let ((parsed (qif-file:parse-price-line "\"ABC\",,\"1/1' 4\""))) - (test-equal parsed #f)) + (test-equal "parse-price-line-empty" #f parsed)) (let ((parsed (qif-file:parse-price-line "\"ABC\",\"1/1' 4\""))) - (test-equal parsed #f))) + (test-equal "parse-price-line-missingcomma" #f parsed)))