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

[price-quotes] compact gnc:book-add-quotes

Browse Source
This commit is contained in:
Christopher Lam 2019-08-10 23:33:00 +08:00
parent 4a4f81b320
commit e15f2610ba
1 changed files with 97 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

218
libgnucash/scm/price-quotes.scm
View File

@ -409,149 +409,125 @@
#f))) #f)))
prices))) prices)))
(define (show-error msg)
(gnc:gui-error msg (_ msg)))
;; Add the alphavantage api key to the environment. This value is taken from ;; Add the alphavantage api key to the environment. This value is taken from
;; the Online Quotes preference tab ;; the Online Quotes preference tab
(let* ((alphavantage-api-key (gnc-prefs-get-string "general.finance-quote" "alphavantage-api-key"))) (let ((alphavantage-api-key
(gnc:debug (string-concatenate (list "ALPHAVANTAGE_API_KEY=" alphavantage-api-key))) (gnc-prefs-get-string "general.finance-quote" "alphavantage-api-key")))
(if (not (string-null? alphavantage-api-key)) (gnc:debug "ALPHAVANTAGE_API_KEY=" alphavantage-api-key)
(setenv "ALPHAVANTAGE_API_KEY" alphavantage-api-key))) (unless (string-null? alphavantage-api-key)
(setenv "ALPHAVANTAGE_API_KEY" alphavantage-api-key)))
;; FIXME: uses of gnc:warn in here need to be cleaned up. Right
;; now, they'll result in funny formatting.
(let* ((fq-call-data (book->commodity->fq-call-data book)) (let* ((fq-call-data (book->commodity->fq-call-data book))
(fq-calls (and fq-call-data (fq-calls (and fq-call-data
(apply append (append-map fq-call-data->fq-calls fq-call-data)))
(map fq-call-data->fq-calls fq-call-data))))
(fq-results (and fq-calls (gnc:fq-get-quotes fq-calls))) (fq-results (and fq-calls (gnc:fq-get-quotes fq-calls)))
(commod-tz-quote-triples (commod-tz-quote-triples (and fq-results (list? (car fq-results))
(and fq-results (list? (car fq-results)) (fq-results->commod-tz-quote-triples
(fq-results->commod-tz-quote-triples fq-call-data fq-results))) fq-call-data fq-results)))
;; At this point commod-tz-quote-triples will either be #f or a ;; At this point commod-tz-quote-triples will either be #f or a
;; list of items. Each item will either be (commodity ;; list of items. Each item will either be (commodity
;; timezone quote-data) or (#f . problem-commodity) ;; timezone quote-data) or (#f . problem-commodity)
(problem-syms (problem-syms (and commod-tz-quote-triples
(and commod-tz-quote-triples (filter-map
(filter-map (lambda (cq-pair) (lambda (cq-pair)
(if (car cq-pair) (and (not (car cq-pair))
#f (string-append
(string-append (gnc-commodity-get-namespace (cdr cq-pair))
(gnc-commodity-get-namespace (cdr cq-pair)) ":"
":" (gnc-commodity-get-mnemonic (cdr cq-pair)))))
(gnc-commodity-get-mnemonic (cdr cq-pair))))) commod-tz-quote-triples)))
commod-tz-quote-triples)))
;; strip out the "bad" ones from above. ;; strip out the "bad" ones from above.
(ok-syms (ok-syms (and commod-tz-quote-triples (filter car commod-tz-quote-triples)))
(and commod-tz-quote-triples
(filter car commod-tz-quote-triples)))
(keep-going? #t)) (keep-going? #t))
(cond (cond
((eq? fq-call-data #f) ((not fq-call-data)
(set! keep-going? #f) (set! keep-going? #f)
(if (gnucash-ui-is-running) (show-error (N_ "No commodities marked for quote retrieval.")))
(gnc-error-dialog window (_ "No commodities marked for quote retrieval."))
(gnc:warn "No commodities marked for quote retrieval."))) ((not fq-results)
((eq? fq-results #f)
(set! keep-going? #f) (set! keep-going? #f)
(if (gnucash-ui-is-running) (show-error (N_ "Unable to get quotes or diagnose the problem.")))
(gnc-error-dialog window (_ "Unable to get quotes or diagnose the problem."))
(gnc:warn "Unable to get quotes or diagnose the problem."))) ((memq 'missing-lib fq-results)
((member 'missing-lib fq-results)
(set! keep-going? #f) (set! keep-going? #f)
(if (gnucash-ui-is-running) (show-error (N_ "You are missing some needed Perl libraries.
(gnc-error-dialog window Run 'gnc-fq-update' as root to install them.")))
(_ "You are missing some needed Perl libraries.
Run 'gnc-fq-update' as root to install them.")) ((memq 'system-error fq-results)
(gnc:warn "You are missing some needed Perl libraries.
Run 'gnc-fq-update' as root to install them." "\n")))
((member 'system-error fq-results)
(set! keep-going? #f) (set! keep-going? #f)
(if (gnucash-ui-is-running) (show-error (N_ "There was a system error while retrieving the price quotes.")))
(gnc-error-dialog window
(_ "There was a system error while retrieving the price quotes."))
(gnc:warn "There was a system error while retrieving the price quotes." "\n")))
((not (list? (car fq-results))) ((not (list? (car fq-results)))
(set! keep-going? #f) (set! keep-going? #f)
(if (gnucash-ui-is-running) (show-error (N_ "There was an unknown error while retrieving the price quotes.")))
(gnc-error-dialog window
(_ "There was an unknown error while retrieving the price quotes."))
(gnc:warn "There was an unknown error while retrieving the price quotes." "\n")))
((and (not commod-tz-quote-triples) (gnucash-ui-is-running))
(gnc-error-dialog window
(_ "Unable to get quotes or diagnose the problem."))
(set! keep-going? #f))
((not commod-tz-quote-triples) ((not commod-tz-quote-triples)
(gnc:warn "Unable to get quotes or diagnose the problem.") (set! keep-going? #f)
(set! keep-going? #f)) (show-error (N_ "Unable to get quotes or diagnose the problem.")))
((not (null? problem-syms))
(if (gnucash-ui-is-running)
(if (and ok-syms (not (null? ok-syms)))
(set!
keep-going?
(gnc-verify-dialog window #t
(call-with-output-string
(lambda (p)
(display (_ "Unable to retrieve quotes for these items:") p)
(newline p)
(display " " p)
(display (string-join problem-syms "\n ") p)
(newline p)
(display (_ "Continue using only the good quotes?") p)))))
(begin
(gnc-error-dialog window
(call-with-output-string
(lambda (p)
(display
(_ "Unable to retrieve quotes for these items:") p)
(newline p)
(display " " p)
(display (string-join problem-syms "\n ") p))))
(set! keep-going? #f)))
(gnc:warn
(call-with-output-string
(lambda (p)
(display "Unable to retrieve quotes for these items:" p)
(newline p)
(display " " p)
(display (string-join problem-syms "\n ") p)
(newline p)
(display "Continuing with good quotes." p)
(newline p)))))))
(if ((pair? problem-syms)
keep-going? (cond
(let ((prices (map (lambda (triple) ((not (gnucash-ui-is-running))
(commodity-tz-quote-triple->price book triple)) (gnc:warn
ok-syms))) (with-output-to-string
(if (any string? prices) (lambda ()
(if (gnucash-ui-is-running) (display "Unable to retrieve quotes for these items:\n")
(set! (display (string-join problem-syms "\n "))
keep-going? (newline)
(gnc-verify-dialog window #t (display "Continuing with good quotes.")
(call-with-output-string (newline)))))
(lambda (p)
(display (_ "Unable to create prices for these items:") p)
(newline p)
(display " " p)
(display (string-join (filter string? prices) "\n ") p)
(newline p)
(display (_ "Add remaining good quotes?") p)))))
(gnc:warn
(call-with-output-string
(lambda (p)
(display "Unable to create prices for these items:" p)
(newline p)
(display " " p)
(display (string-join (filter string? prices) "\n ") p)
(newline p)
(display "Adding remaining good quotes." p)
(newline p))))))
(if keep-going? ((and ok-syms (not (null? ok-syms)))
(book-add-prices! book (filter (set! keep-going?
(lambda (x) (not (string? x))) (gnc-verify-dialog
prices))))))) window #t (with-output-to-string
(lambda ()
(display (_ "Unable to retrieve quotes for these items:"))
(display "\n ")
(display (string-join problem-syms "\n "))
(newline)
(display (_ "Continue using only the good quotes?")))))))
(else
(set! keep-going? #f)
(gnc-error-dialog
window (with-output-to-string
(lambda ()
(display (_ "Unable to retrieve quotes for these items:"))
(display "\n ")
(display (string-join problem-syms "\n ")))))))))
(when keep-going?
(let ((prices (map (lambda (triple)
(commodity-tz-quote-triple->price book triple))
ok-syms)))
(when (any string? prices)
(if (gnucash-ui-is-running)
(set! keep-going?
(gnc-verify-dialog
window #t
(with-output-to-string
(lambda ()
(display (_ "Unable to create prices for these items:"))
(display "\n ")
(display (string-join (filter string? prices) "\n "))
(newline)
(display (_ "Add remaining good quotes?"))))))
(gnc:warn
(with-output-to-string
(lambda ()
(display "Unable to create prices for these items:\n ")
(display (string-join (filter string? prices) "\n "))
(newline)
(display "Adding remaining good quotes.")
(newline))))))
(when keep-going?
(book-add-prices! book (filter (negate string?) prices)))))))
(define (gnc:price-quotes-install-sources) (define (gnc:price-quotes-install-sources)
(let ((sources (gnc:fq-check-sources))) (let ((sources (gnc:fq-check-sources)))