aherman
/
gnucash
mirror of https://github.com/Gnucash/gnucash
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge James White's 'prices1' into stable.

Browse Source
pull/1765/head
John Ralls 3 years ago
parent a8c20604ab 737e732e1c
commit ab63595cc1
8 changed files with 466 additions and 6 deletions
Show Stats Download Patch File Download Diff File

84
doc/examples/price.qif
Unescape View File

@ -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"
^

7
gnucash/import-export/qif-imp/assistant-qif-import.c
Unescape View File

@ -171,6 +171,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;
@ -1546,6 +1547,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);
@ -1853,6 +1855,8 @@ gnc_ui_qif_import_load_progress_start_cb (GtkButton * button,
wind->busy = FALSE;
wind->load_stop = TRUE;
}
else
wind->read_file_warnings = TRUE;
}
/*
@ -1991,7 +1995,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);

17
gnucash/import-export/qif-imp/file-format.txt
Unescape View File

@ -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
=====================================================================

86
gnucash/import-export/qif-imp/qif-file.scm
Unescape View File

@ -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))
@ -49,6 +50,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 +231,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 +517,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 +739,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 +810,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 rational)
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
;;
@ -833,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
@ -1083,3 +1134,32 @@
(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)
(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))))

62
gnucash/import-export/qif-imp/qif-objects.scm
Unescape View File

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

8
gnucash/import-export/qif-imp/qif-parse.scm
Unescape View File

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

183
gnucash/import-export/qif-imp/qif-to-gnc.scm
Unescape View File

@ -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,88 @@
(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 (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
(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 +1347,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))

25
gnucash/import-export/qif-imp/test/test-qif-imp.scm
Unescape View File

@ -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,27 @@
(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")
(qif-price:set-date! model "1/1/04")
(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 "7/4")
(qif-price:set-date! model "1/1' 4")
(test-equal "parse-price-line-fraction" parsed model))
(let ((parsed (qif-file:parse-price-line "\"ABC\",,\"1/1' 4\"")))
(test-equal "parse-price-line-empty" #f parsed))
(let ((parsed (qif-file:parse-price-line "\"ABC\",\"1/1' 4\"")))
(test-equal "parse-price-line-missingcomma" #f parsed)))

Write Preview
Loading…
Cancel
Save