view release on metacpan or  search on metacpan

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

# This uses the quotes pages like
#
#     http://www.bsx.com.au/markets_pricesresearch_pri.asp?security=20
#
# with the security code number from the symbols menu on the home page.
#
# www.bsx.com.au sends gzipped data, which is good since it compresses
# about 19kbytes of javascript junk down to about 3kbytes sent.
#
# The trade history pages like
#
#     http://www.bsx.com.au/markets_pricesresearch_tra.asp?security=1
#
# also have a current bid/offer and show the date/time of the last trade.
# Not sure if there's much value showing open/high/low/volume from trading
# that could be weeks ago.

# return list (ADATE TIME) for latest quote
#
# the BSX system takes changes only during 9:30am-11:30am weekdays (order
# entry 9:30 to 11, then trading 11 to 11:30), so outside those hours lock
# to 11:30am
#
# http://www.bsx.com.au/markets_aboutbsxmarkets_tra.asp
#
sub quote_date_time {
#   (tm->adate-time-within (localtime (current-time) (timezone-bendigo))
# 			 #,(hms->seconds 9 30 0)
# 			 #,(hms->seconds 11 30 0)))
}

sub bendigo_quote {

sub quote_parse {
  my ($resp) = @_;
  my $content = $resp->decoded_content (raise_error => 1);

  my @data = ();
  my $h = { source      => __PACKAGE__,
            resp        => $resp,
            date_format => 'dmy',
            data        => \@data };

  require HTML::TableExtract;

  my $te = HTML::TableExtract->new
    (headers   => ['code', 'bid', 'offer', 'last'],
     keep_html => 1);
  $te->parse($content);

  my ($ts) = $te->tables || die 'BSX: quote columns not found';
  $te = HTML::TableExtract->new
    (depth => $ts->depth,
     count => $ts->count + 1);
  $te->tables || die 'BSX: reparse table not found';

#   (receive-list (quote-adate quote-time)
#       (bendigo-quote-adate-time)

# 			# eg: <span class="Blue"><br><br><b>Capilano Honey Limited</b><br><font color=red>TRADING HALT</font><br></span><br>
# 			(m      (regexp-exec #,(regexp "Blue.*<b>.*red[^>]*>([^<]+)" regexp/icase regexp/newline) body))
# 			(note   (and m (match:substring m 1))))


  foreach my $row ($te->rows) {
    my ($code, $bid, $offer, $last) = @$row;
    $code =~ /(.*)\(([^)]+)\)/ or next;
    my $name   = $1;
    my $symbol = "$2.BEN";
    push @data, { symbol => $symbol,
                  name   => $name,
                  bid    => $bid,
                  offer  => $offer,
                  last   => $last };

			       #:quote-adate quote-adate
			       #:quote-time  quote-time
			       #:note        note
  }
}

(define (bendigo-latest-get symbol-list extra-list proc)
  (for-each (lambda (symbol)
	      (define option (symbol->option symbol))

	      (if (not option)
		  (proc (list (latest-new-unknown symbol)))

		  (receive (headers body)
		      (http-request (string-append "http://www.bsx.com.au/markets_pricesresearch_pri.asp?security=" option)
				    #:want-ok #t)
		    (proc (body->latest-list body)))))

	    symbol-list))

(latest-handler! #:selector   bendigo-symbol?  
		 #:handler    bendigo-latest-get
		 #:adate-time bendigo-quote-adate-time)



;;-----------------------------------------------------------------------------
;; download
;;
;; This uses the "view all" trade history pages like
;;
;;     http://www.bsx.com.au/markets_pricesresearch_tra_popup.asp?security=20
;;
;; with the security number from the home page menu (cached above).
;;
;; 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))