crap bad diffs file there, please disregard and use the attached.
A On Fri, 17 Feb 2006 16:33:43 -0800 Andrew Sackville-West <[EMAIL PROTECTED]> wrote: > Okay, the advanced portfolio report was broken in a number of ways. I've > masssaged it pretty well I think, but made some assumptions about how it > should behave. Essentially, there are three cases we encounter, listed below: > > 1). a normal, properly formed stock account with pricedb entries etc. In this > case, the report should work as expected, handling multiple currencies etc. I > do not use multiple currencies and don't really grok them so if someone could > test this properly, that would be great > > 2) a stock account with no shares in it. In this case, the report just spews > a bunch of zeros for the particular stock, as expected. It no longer crashes > which should solve Eildert's problem > > 3) a stock account with shares in it but with no pricedb entry. In this case, > I made the assumption that the file was broken. There should always be a > pricedb entry if there are any shares in an account, IMO. Probably the code > should be fixed so that any buy or sell or similar action automatically > creates a pricedb entry. Still we have to account for 1.8 files that might be > broken in this regard. phew. What it does: flags the particular stock as > being "dirty" and tries to make a reasonable guess at what the current value > and gain is based on data pulled from the actual transactions. I am not > convinced however that this data is properly exchanged across multiple > currencies. So the report spews what it can on this stock, but sticks a * in > the price column and places a warning at the bottom of the report explaining > the situation. Also, any stocks that don't have a pricedb entry are EXCLUDED > from the totals at the bottom of the report as the information is not > reliable. > > please give me feedback on this monster and my assumptions. I would like to > make it behave appropriately and I don't know if my assumptions are correct. > > thanks > > A >
Index: src/report/standard-reports/advanced-portfolio.scm
===================================================================
--- src/report/standard-reports/advanced-portfolio.scm (revision 13285)
+++ src/report/standard-reports/advanced-portfolio.scm (working copy)
@@ -46,6 +46,7 @@
(define optname-show-listing (N_ "Show listings"))
(define optname-show-price (N_ "Show prices"))
(define optname-show-shares (N_ "Show number of shares"))
+(define price-is-dirty #f) ;;keep track of whether we're using good price data
(define (options-generator)
(let* ((options (gnc:new-options))
@@ -151,7 +152,8 @@
(define (advanced-portfolio-renderer report-obj)
(let ((work-done 0)
- (work-to-do 0))
+ (work-to-do 0)
+ (warn-price-dirty #f))
;; These are some helper functions for looking up option values.
(define (get-op section name)
@@ -201,15 +203,23 @@
(moneyincoll (gnc:make-commodity-collector))
(moneyoutcoll (gnc:make-commodity-collector))
(gaincoll (gnc:make-commodity-collector))
+ (dirty-value (gnc:numeric-zero))
+ (dirty-amount (gnc:numeric-zero))
(price-list (price-fn commodity to-date))
(price (if (> (length price-list) 0)
(car price-list) #f))
- (commod-currency (gnc:price-get-currency price))
+ ;; if there is no price, set a sane commod-currency for those
zero-share
+ ;; accounts. if its a no price account with shares, we'll get
a currency later.
+ (commod-currency (if (not price) (gnc:price-get-currency
price) currency))
(value (exchange-fn (gnc:make-gnc-monetary commodity units)
currency))
+ ;;if we have shares but no price in pricedb, we'll make a
dirty price guess at things
+ (price-is-dirty (if (and (not price) (< 0
(gnc:numeric-to-double units))) #t #f))
)
+ (if price-is-dirty (set! warn-price-dirty #t))
+
;; (gnc:debug "---" name "---")
(for-each
(lambda (split)
@@ -217,47 +227,69 @@
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
(let ((parent (gnc:split-get-parent split)))
(if (gnc:timepair-le (gnc:transaction-get-date-posted parent)
to-date)
- (for-each
- (lambda (s)
- (cond
- ((same-split? s split)
+ (begin
+ (for-each
+ (lambda (s)
+ ;; if price-is dirty and this is an asset type
account for buy or sell, then grab a
+ ;; currency and a dirty-value for later computation
+ (if (and price-is-dirty (not (or (split-account-type?
s 'stock)
+ (split-account-type?
s 'mutualfund)
+ (split-account-type?
s 'expense)
+ (split-account-type?
s 'income))))
+ (begin
+ (set! commod-currency
(gnc:account-get-commodity (gnc:split-get-account s)))
+ (set! dirty-value (gnc:split-get-value s))
+ (if (gnc:numeric-negative-p dirty-value)
+ (set! dirty-value (gnc:numeric-sub
(gnc:numeric-zero) dirty-value
+ 10000
GNC-RND-ROUND)))))
+ )
+
+ (gnc:transaction-get-splits parent))
+
+ (for-each
+ (lambda (s)
+ (cond
+ ((same-split? s split)
;; (gnc:debug "amount " (gnc:numeric-to-double
(gnc:split-get-amount s))
;; " acct " (gnc:account-get-name
(gnc:split-get-account s)) )
;; (gnc:debug "value " (gnc:numeric-to-double
(gnc:split-get-value s))
;; " in " (gnc:commodity-get-printname
commod-currency)
;; " from " (gnc:transaction-get-description
(gnc:split-get-parent s)))
- (cond
- ((or include-gains (not (gnc:numeric-zero-p
(gnc:split-get-amount s))))
- (unitscoll 'add commodity (gnc:split-get-amount s))
;; Is the stock transaction?
- (if (< 0 (gnc:numeric-to-double
- (gnc:split-get-amount s)))
- (set! totalunits
- (+ totalunits
- (gnc:numeric-to-double
(gnc:split-get-amount s)))))
- (set! totalunityears
- (+ totalunityears
- (* (gnc:numeric-to-double
(gnc:split-get-amount s))
- (gnc:date-year-delta
- (car (gnc:transaction-get-date-posted
parent))
- (current-time)))))
- (cond
- ((gnc:numeric-negative-p (gnc:split-get-value s))
- (moneyoutcoll
- 'add commod-currency
- (gnc:numeric-neg (gnc:split-get-value s))))
- (else (moneyincoll
- 'add commod-currency
- (gnc:numeric-neg (gnc:split-get-value
s))))))))
+ (cond
+ ((or include-gains (not (gnc:numeric-zero-p
(gnc:split-get-amount s))))
+ (unitscoll 'add commodity (gnc:split-get-amount
s)) ;; Is the stock transaction?
+ (set! dirty-amount (gnc:split-get-amount s))
+ (if (< 0 (gnc:numeric-to-double
+ (gnc:split-get-amount s)))
+ (set! totalunits
+ (+ totalunits
+ (gnc:numeric-to-double
(gnc:split-get-amount s)))))
+
+ (set! totalunityears
+ (+ totalunityears
+ (* (gnc:numeric-to-double
(gnc:split-get-amount s))
+ (gnc:date-year-delta
+ (car
(gnc:transaction-get-date-posted parent))
+ (current-time)))))
+ (cond
+ ((gnc:numeric-negative-p (gnc:split-get-value s))
+ (moneyoutcoll
+ 'add commod-currency
+ (gnc:numeric-neg (gnc:split-get-value s))))
+ (else (moneyincoll
+ 'add commod-currency
+ (gnc:numeric-neg (gnc:split-get-value
s))))))))
- ((split-account-type? s 'expense)
- (brokeragecoll 'add commod-currency
(gnc:split-get-value s)))
-
- ((split-account-type? s 'income)
- (dividendcoll 'add commod-currency
(gnc:split-get-value s)))
- )
+ ((split-account-type? s 'expense)
+ (brokeragecoll 'add commod-currency
(gnc:split-get-value s)))
+
+ ((split-account-type? s 'income)
+ (dividendcoll 'add commod-currency
(gnc:split-get-value s)))
+ )
+ )
+ (gnc:transaction-get-splits parent)
)
- (gnc:transaction-get-splits parent)
- )
+ )
)
)
)
@@ -266,25 +298,41 @@
;; (gnc:debug "totalunits" totalunits)
;; (gnc:debug "totalunityears" totalunityears)
- (moneyincoll 'minusmerge dividendcoll #f)
+
+ (if price-is-dirty
+ (set! value (gnc:make-gnc-monetary commod-currency
+ (gnc:numeric-mul units
+
(gnc:numeric-div dirty-value
+
dirty-amount
+
10000 GNC-RND-ROUND)
+ 10000
GNC-RND-ROUND))))
+ (moneyincoll 'minusmerge dividendcoll #f)
(moneyoutcoll 'minusmerge brokeragecoll #f)
(gaincoll 'merge moneyoutcoll #f)
(gaincoll 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
(gaincoll 'merge moneyincoll #f)
(if (or include-empty (not (gnc:numeric-zero-p units)))
- (let ((moneyin (gnc:monetary-neg
+ (let* ((moneyin (gnc:monetary-neg
(gnc:sum-collector-commodity moneyincoll currency
exchange-fn)))
(moneyout (gnc:sum-collector-commodity moneyoutcoll currency
exchange-fn))
- (gain (gnc:sum-collector-commodity gaincoll currency
exchange-fn))
+ (gain (if price-is-dirty
+ (gnc:make-gnc-monetary commod-currency
+ (gnc:numeric-sub
(gnc:gnc-monetary-amount value)
+
(gnc:gnc-monetary-amount moneyin)
+ 10000
GNC-RND-ROUND))
+ (gnc:sum-collector-commodity gaincoll currency
exchange-fn)))
(activecols (list (gnc:html-account-anchor current)))
)
- (total-value 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
- (total-moneyin 'merge moneyincoll #f)
- (total-moneyout 'merge moneyoutcoll #f)
- (total-gain 'merge gaincoll #f)
+ (if (not price-is-dirty)
+ (begin
+ (total-value 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
+ (total-moneyin 'merge moneyincoll #f)
+ (total-moneyout 'merge moneyoutcoll #f)
+ (total-gain 'merge gaincoll #f)))
+
;; build a list for the row based on user selections
(if show-symbol (append! activecols (list ticker-symbol)))
(if show-listing (append! activecols (list listing)))
@@ -298,14 +346,14 @@
(gnc:make-gnc-monetary
(gnc:price-get-currency price)
(gnc:price-get-value price)))
- #f)))))
+ (if price-is-dirty "*" #f))))))
(append! activecols (list (gnc:make-html-table-header-cell/markup
"number-cell" value)
(gnc:make-html-table-header-cell/markup
"number-cell"
- (gnc:monetary-neg
(gnc:sum-collector-commodity moneyincoll currency exchange-fn)))
+ moneyin)
(gnc:make-html-table-header-cell/markup
"number-cell"
- (gnc:sum-collector-commodity
moneyoutcoll currency exchange-fn))
+ moneyout)
(gnc:make-html-table-header-cell/markup
"number-cell"
- (gnc:sum-collector-commodity
gaincoll currency exchange-fn))
+ gain)
(gnc:make-html-table-header-cell/markup
"number-cell"
(let ((moneyinvalue
(gnc:numeric-to-double
(cadr
(moneyincoll 'getpair currency #t)))))
@@ -423,9 +471,9 @@
(table-add-stock-rows
table accounts to-date currency price-fn exchange-fn
- include-empty include-gains show-symbol show-listing show-shares
show-price
+ include-empty include-gains show-symbol show-listing show-shares
show-price
total-value total-moneyin total-moneyout total-gain)
-
+
(gnc:html-table-append-row/markup!
table
"grand-total"
@@ -459,10 +507,15 @@
table
"grand-total"
totalscols
- )
-
- (gnc:html-document-add-object! document table))
+ )
+ (gnc:html-document-add-object! document table)
+ (if warn-price-dirty
+ (gnc:html-document-append-objects! document
+ (list (gnc:make-html-text (_
"* no valid price data for this commodity. It has been exluded from totals
and<BR>"))
+ (gnc:make-html-text (_
"may not be properly exchanged. Please enter a price in the Price Editor.")))))
+)
+
;if no accounts selected.
(gnc:html-document-add-object!
document
pgpDyUEzwKWHR.pgp
Description: PGP signature
_______________________________________________ gnucash-devel mailing list gnucash-devel@gnucash.org https://lists.gnucash.org/mailman/listinfo/gnucash-devel
