Implement support for !Type:Prices QIF records.

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:
+"<symbol>",<price>,"<date>"
+where <symbol> is the security's ticker symbol, <price> is the security
+price, and <date> 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
 =====================================================================

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.
+                           (set! current-xtn (make-qif-price)))
-                           #f)
 
                           ((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))

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 <qif-acct>  
 ;;  cats         : list of <qif-cat>  
 ;;  classes      : list of <qif-class>  
+;;  prices       : list of <qif-price>
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define <qif-file>
@@ -166,7 +176,8 @@
      xtns                
      accounts 
      cats
-     classes)))
+     classes
+     prices)))
 
 (define qif-file?
   (record-predicate <qif-file>))
@@ -207,6 +218,12 @@
 (define qif-file:set-accounts!
   (record-modifier <qif-file> 'accounts))
 
+(define qif-file:prices
+  (record-accessor <qif-file> 'prices))
+
+(define qif-file:set-prices!
+  (record-modifier <qif-file> 'prices))
+
 (define (make-qif-file) 
   (let ((self (construct <qif-file>)))
     (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))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  <qif-price>
+;;  Symbol,shares,date
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define <qif-price>
+  (make-record-type
+   'qif-price
+   '(symbol share-price date)))
+
+(define qif-price:symbol
+  (record-accessor <qif-price> 'symbol))
+
+(define qif-price:set-symbol!
+  (record-modifier <qif-price> 'symbol))
+
+(define qif-price:share-price
+  (record-accessor <qif-price> 'share-price))
+
+(define qif-price:set-share-price!
+  (record-modifier <qif-price> 'share-price))
+
+(define qif-price:date
+  (record-accessor <qif-price> 'date))
+
+(define qif-price:set-date!
+  (record-modifier <qif-price> 'date))
+
+(define (qif-price:print self)
+  (write self))
+
+(define (make-qif-price)
+  (let ((retval (construct <qif-price>)))
+    (qif-price:set-symbol! retval "")
+    (qif-price:set-share-price! retval "")
+    (qif-price:set-date! retval "")
+    retval))
+
 (define <qif-ticker-map>
   (make-record-type
    'qif-ticker-map

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<? (qif-price:symbol a) (qif-price:symbol b)))))
+
+        (gnc-pricedb-begin-edit pricedb)
+        ;; Turning off bulk update avoids an n^2 performance
+        ;;  cost, but also turns off duplicate checking
+        (gnc-pricedb-set-bulk-update pricedb #t)
+
+        (if progress-dialog
+            (gnc-progress-dialog-set-sub progress-dialog
+                (string-append (G_ "Discarding duplicate prices"))))
+
+        ;; Prune duplicate records before inserting
+        (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 (equal? commodity #f)
+                      (qif-import:log progress-dialog
+                          "qif-import:qif-to-gnc"
+                          (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-price-count (+ 1 pruned-price-count))))
+            (update-progress))
+         sorted-prices)
+
+        (if progress-dialog
+            (begin
+                (if (> 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))

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)))