view release on metacpan or  search on metacpan

lib/App/Chart/Suffix/BEN.pm  view on Meta::CPAN

;; This history has each trade individually, but we collapse that to daily
;; open/high/low/close.


;; Eg:
;; <span class="Blue"><b>Capilano Honey Limited</b></span><br>
;; <span class="Blue"><br>Trade History<br></span><br>
;; <table ...
;;
;; Or when ex dividend:
;; <span class="Blue"><b>Capilano Honey Limited</b><br><font color=red>XD</font></span><br>
;; <span class="Blue"><br>Trade History<br></span><br>
;;
;; Or when halted:
;; <span class="Blue"><b>Capilano Honey Limited</b><br><font color=red>TRADING HALT</font></span><br>
;; <span class="Blue"><br>Trade History<br></span><br>
;;
;; match 1 is company name
;;
(define history-regexp
  "<b>([^<]+)[^\n]*\n[^\n]*<br>Trade History")

(define (bendigo-process-download symbol url headers body)
  (define commodity (chart-symbol-sans-dot symbol))

  (let* ((m        (must-match (string-match history-regexp body)))
	 (name     (match:substring m 1))
	 (row-list (html-table-rows body
				    ;; skip empty table, the second is wanted
				    (string-contains-after-ci body "<table"
							      (match:end m)))))

    (let ((headings (map! string-trim-right (first row-list))))
      (or (equal? headings '("Qty" "Price" "Date" "Time"))
	  (error "BSX: unrecognised data columns:" headings)))
    (set! row-list (cdr row-list))

    (download-process
     #:module          (_ "BSX")
     #:symbol-list     (list symbol)
     #:name            name
     #:url             url
     #:headers         headers
     #:currency        "AUD"
     #:hi              (bendigo-available-tdate)
     #:last-download   #t
     #:prefer-decimals 2
     #:row-list
     (map (lambda (row-list)
	    (receive-list (volume-1 price-1 date time-1)
		(first row-list)
	      ;; most recent first in list, so reverse for sessions
	      (list #:tdate     (d/m/y-str->tdate date)
		    #:commodity commodity
		    #:sessions  (reverse! (map second row-list))
		    #:volume    (apply + (map! string->number-err
					       (map first row-list))))))
	  (partition-equal-adjacent third row-list)))))

;; latest download data available
;; guess today available from 6pm
;;
(define (bendigo-available-tdate)
  (tdate-today-after 18 0 (timezone-melbourne)))

(define (bendigo-download symbol-list)
  (for-each
   (lambda (symbol)
     (download-status (_ "BSX") (_ "data") symbol)

     (let ((option (symbol->option symbol)))
       (if (not option)
	   (download-message
	    (string-append (_ "BSX") ": " (_ "unknown symbol") " " symbol))

	   (let ((url (string-append "http://www.bsx.com.au/markets_pricesresearch_tra_popup.asp?security=" option)))
	     (receive (headers body)
		 (http-request url #:want-ok #t)
	       (bendigo-process-download symbol url headers body))))))
   symbol-list))

(define (bendigo-backto want-tdate symbol-list)
  (download-message
   (string-append (_ "BSX") ": " (_ "no further historical data available"))))

(download-handler! #:selector   bendigo-symbol?
		   #:update     bendigo-download
		   #:avail-proc bendigo-available-tdate
		   #:backto     bendigo-backto)