From e2c8a2037b9b3f424a7a70db6776d6833bcfc89d Mon Sep 17 00:00:00 2001 From: Charles Day Date: Mon, 14 Apr 2008 17:09:04 +0000 Subject: [PATCH] Bug #527886: Add support for QIF numeric formats of 12'345.67 as produced by Quicken 4. Also support 12'345,67 for completeness. Added documentation for this format, along with investment 'N' lines. Added two new string manipulation utility procedures for simplification. Mild whitespace and readability cleanup. BP git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@17086 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/import-export/qif-import/file-format.txt | 60 ++++++++++++++--- src/import-export/qif-import/qif-parse.scm | 69 +++++++++----------- src/import-export/qif-import/qif-utils.scm | 27 ++++++++ 3 files changed, 109 insertions(+), 47 deletions(-) diff --git a/src/import-export/qif-import/file-format.txt b/src/import-export/qif-import/file-format.txt index 2fb8f4d551..fab9c37c3d 100644 --- a/src/import-export/qif-import/file-format.txt +++ b/src/import-export/qif-import/file-format.txt @@ -224,7 +224,7 @@ W Private General Notes: Dates: ------ +------ Dates in US QIF files are usually in the format MM/DD/YY, although four-digit years are not uncommon. Dates sometimes occur without the @@ -238,19 +238,65 @@ European QIF files may have dates in the DD/MM/YY format. Monetary Amounts: ----------------- -These may occur in either US or Euro format: +These typically occur in either US or European format: -10,000.00 Ten Thousand Dollars -10.000,00 Ten Thousand Francs +10,000.00 Ten Thousand Dollars (US format) +10.000,00 Ten Thousand Francs (European format) -Within a given QIF file, the usage of US or Euro numeric format +An apostrophe is also used in some cases: + +10'000.00 Ten Thousand Dollars (Quicken 4) +10'000,00 Ten Thousand Francs (unconfirmed) + +Within a given QIF file, the usage of a particular numeric format appears to be consistent within a particular field but may be different from one field to another. For example, the Share Amount -field can be in Euro format but the Split Amount in US. No +field can be in European format but the Split Amount in US. No radix-point is required and no limit on decimal places is evident, so it's possible to see the number "1,000" meaning "1 franc per share" "1,000" meaning "one thousand shares" in the same transaction (!). +Investment Actions: +------------------- +The N line of investment transactions specifies the "action" of the +transaction. Although not a complete list, possible values include +the following: + +QIF N Line Notes +============ ===== +Buy Buy shares. +BuyX Buy shares. Used with an L line. +Cash Miscellaneous cash transaction. Used with an L line. +ContribX Same as XIn. Used for tax-advantaged accounts. +CvrShrt Buy shares to cover a short sale. +Div Dividend received. +DivX Dividend received. For use with an L line. +Exercise Exercise an option. +Expire Mark an option as expired. (Uses D, N, Y & M lines) +Grant Receive a grant of stock options. +IntInc Interest received. +IntIncX Interest received. For use with an L line. +MargInt Margin interest paid. +MargIntX Margin interest paid. For use with an L line. +MiscExp Miscellaneous expense. +MiscExpX Miscellaneous expense. For use with an L line. +MiscInc Miscellaneous income. +MiscIncX Miscellaneous income. For use with an L line. +ReinvDiv Reinvested dividend. +ReinvInt Reinvested interest. +Reminder Reminder. (Uses D, N, C & M lines) +RtrnCap Return of capital. +RtrnCapX Return of capital. For use with an L line. +Sell Sell shares. +SellX Sell shares. For use with an L line. +ShtSell Short sale. +ShrsIn Deposit shares. +ShrsOut Withdraw shares. +StkSplit Stock split. +XIn Transfer cash from another account. +XOut Transfer cash to another account. +Vest Mark options as vested. (Uses N, Y, Q, C & M lines) + Category/Transfer/Class line: ----------------------------- @@ -274,5 +320,3 @@ separated by a '|', like so: NMiscExpX T1000.00 Lexpense category/expense class|[Transfer account]/transfer class - - diff --git a/src/import-export/qif-import/qif-parse.scm b/src/import-export/qif-import/qif-parse.scm index 4e9dddc7b1..ab561482c9 100644 --- a/src/import-export/qif-import/qif-parse.scm +++ b/src/import-export/qif-import/qif-parse.scm @@ -19,11 +19,11 @@ (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]* *$")) + "^ *\\$?[+-]?\\$?[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]* *$")) + "^ *\\$?[+-]?\\$?[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]+ *$")) @@ -89,26 +89,26 @@ (set! fixed-string (substring year-string 2 (string-length year-string)))) (set! fixed-string year-string)) - + ;; now the string should just have a number in it plus some ;; optional trailing space. (set! post-read-value (with-input-from-string fixed-string (lambda () (read)))) - + (cond ;; 2-digit numbers less than the window size are interpreted to ;; be post-2000. ((and (integer? post-read-value) (< post-read-value y2k-threshold)) (set! y2k-fixed-value (+ 2000 post-read-value))) - + ;; there's a common bug in printing post-2000 dates that ;; prints 2000 as 19100 etc. ((and (integer? post-read-value) (> post-read-value 19000)) (set! y2k-fixed-value (+ 1900 (- post-read-value 19000)))) - + ;; normal dates represented in unix years (i.e. year-1900, so ;; 2000 => 100.) We also want to allow full year specifications, ;; (i.e. 1999, 2001, etc) and there's a point at which you can't @@ -120,11 +120,11 @@ ((and (integer? post-read-value) (< post-read-value 1902)) (set! y2k-fixed-value (+ 1900 post-read-value))) - + ;; this is a normal, 4-digit year spec (1999, 2000, etc). ((integer? post-read-value) (set! y2k-fixed-value post-read-value)) - + ;; No idea what the string represents. Maybe a new bug in Quicken! (#t (gnc:warn "qif-file:fix-year: ay caramba! What is this? [" @@ -326,14 +326,14 @@ (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)) (s1 (car date-parts)) (s3 (caddr date-parts))) - + ;; filter the possibilities to eliminate (hopefully) ;; all but one (if (or (not (number? n1)) (> n1 12)) @@ -344,22 +344,22 @@ (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)) @@ -449,14 +449,14 @@ (match:substring m 2) (match:substring m 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)) - + ;; if the date parts list doesn't have 3 parts, we're in ;; trouble (if (not (eq? 3 (length date-parts))) @@ -473,7 +473,7 @@ (gnc:warn "qif-parse:parse-date/format: " "format is d/m/y, but date is [" date-string "].")))) - + ((m-d-y) (let ((m (car numeric-date-parts)) (d (cadr numeric-date-parts)) @@ -484,7 +484,7 @@ (gnc:warn "qif-parse:parse-date/format: " "format is m/d/y, but date is [" date-string "].")))) - + ((y-m-d) (let ((y (qif-parse:fix-year (car date-parts) 50)) (m (cadr numeric-date-parts)) @@ -495,7 +495,7 @@ (gnc:warn "qif-parse:parse-date/format: " "format is y/m/d, but date is [" date-string "].")))) - + ((y-d-m) (let ((y (qif-parse:fix-year (car date-parts) 50)) (d (cadr numeric-date-parts)) @@ -553,13 +553,9 @@ (define (qif-parse:parse-number/format value-string format) (case format ((decimal) - (let* ((filtered-string - (string-remove-char - (string-remove-char value-string #\,) - #\$)) - (read-val - (with-input-from-string filtered-string - (lambda () (read))))) + (let* ((filtered-string (string-remove-chars value-string ",$'")) + (read-val (with-input-from-string filtered-string + (lambda () (read))))) (if (number? read-val) (double-to-gnc-numeric (+ 0.0 read-val) GNC-DENOM-AUTO @@ -568,15 +564,11 @@ GNC-RND-ROUND)) (gnc-numeric-zero)))) ((comma) - (let* ((filtered-string - (string-remove-char - (string-replace-char! - (string-remove-char value-string #\.) - #\, #\.) - #\$)) - (read-val - (with-input-from-string filtered-string - (lambda () (read))))) + (let* ((filtered-string (string-replace-char + (string-remove-chars value-string ".$'") + #\, #\.)) + (read-val (with-input-from-string filtered-string + (lambda () (read))))) (if (number? read-val) (double-to-gnc-numeric (+ 0.0 read-val) GNC-DENOM-AUTO @@ -585,10 +577,9 @@ GNC-RND-ROUND)) (gnc-numeric-zero)))) ((integer) - (let ((read-val - (with-input-from-string - (string-remove-char value-string #\$) - (lambda () (read))))) + (let ((read-val (with-input-from-string (string-remove-char value-string + #\$) + (lambda () (read))))) (if (number? read-val) (double-to-gnc-numeric (+ 0.0 read-val) 1 GNC-RND-ROUND) diff --git a/src/import-export/qif-import/qif-utils.scm b/src/import-export/qif-import/qif-utils.scm index 2b9bd441d8..b52601cb9b 100644 --- a/src/import-export/qif-import/qif-utils.scm +++ b/src/import-export/qif-import/qif-utils.scm @@ -5,6 +5,9 @@ ;;; Bill Gribble 20 Feb 2000 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(use-modules (srfi srfi-13)) + + (define (simple-filter pred list) (let ((retval '())) (map (lambda (elt) @@ -45,10 +48,34 @@ (make-string 1 char))))) (regexp-substitute/global #f rexpstr str 'pre 'post))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; string-remove-chars +;; +;; Removes all characters in string "chars" from string "str". +;; Example: (string-remove-chars "abcd" "cb") returns "ad". +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (string-remove-chars str chars) + (string-delete str (lambda (c) (string-index chars c)))) + + (define (string-char-count str char) (length (simple-filter (lambda (elt) (eq? elt char)) (string->list str)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; string-replace-char +;; +;; Replaces all occurrences of char "old" with char "new". +;; Example: (string-replace-char "foo" #\o #\c) returns "fcc". +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (string-replace-char str old new) + (string-map (lambda (c) (if (char=? c old) new c)) str)) + + (define (string-replace-char! str old new) (let ((rexpstr (if (not (eq? old #\.))