#lang racket/base
(require net/url
racket/port
(planet neil/mcfly))
(module+ test
(require (planet neil/overeasy:3)))
(doc (section "Introduction")
(para "This package provides a Racket interface for accessing the precious
metal market spot prices published on the Web by Kitco Metals, Inc. The
information is represented in Racket as either Racket objects (structs), or as
SXML (for writing as XML).")
(para "This is useful for research, for hobby experimentation, and for
prototyping Web apps. Please note that this is "
(italic "not")
" for mission-critical use; once your app is advancing from
prototype to production use, you normally will want to have a contract with a
data service that can offer guarantees about reliability and correctness.")
(para "For example, here is a use of this package to fetch the information
and return it in SXML format (using dummy information, and with some parts
elided):")
(racketinput (current-kitco-user-agent "Mozilla (my app) Firefox/NOT"))
(racketinput (get-kitco-market-sxml))
(racketresultblock
(market (spot (@ (name "newyork")
(timestamp "2000-12-25T12:34:56")
(status "open"))
(pm (@ (name "gold")
(bid "900.0")
(ask "909.09")
(change "10.0")
(change-percent "1.0")
(low "888.88")
(high "999.99")))
(pm (@ (name "silver")
(bid "50.0")
(ask "50.01")
(change "-5.5")
(change-percent "-10.10")
(low "49.49")
(high "51.50")))
(pm (@ (name "platinum")
#,(italic "...attributes...")))
(pm (@ (name "palladium")
#,(italic "...attributes..."))))
(spot (@ (name "eurasia")
(timestamp "2000-12-25T12:34:56")
(status "closed"))
(pm (@ (name "gold")
(bid "901.0")
(ask "902.0")
(ny-change "1.0")
(ny-change-percent "0.5")))
#,(italic "...pms..."))))
(para "(See the documentation for "
(racket current-kitco-user-agent)
" for why we say ``Mozilla'' and ``Firefox'' here.)")
(para "For another example, here is getting the information into a graph
of objects and navigating the graph to get the New York Gold bid and ask
prices:")
(racketinput (current-kitco-user-agent "Mozilla (my app) Firefox/NOT"))
(racketinput (define km (get-kitco-market)))
(racketinput (define spot (kitco-market-newyork-spot km)))
(racketinput (define pms (kitco-spot-pm-hash spot)))
(racketinput (define gold (hash-ref pms 'gold)))
(racketinput (kitco-pm-bid gold)
#,(racketresult 900.05))
(racketinput (kitco-pm-ask gold)
#,(racketresult 900.10))
(para "Please note that you should not rely on this package, nor on this
data feed. If someday it says silver is back up to 50, double-check with
authoritative sources before you quit your job. And don't assume that this
data feed won't suddenly stop working without warning. And under no
circumstances should you even think of suing the author of this package.")
(para "This package is independent of Kitco Metals, Inc., and they are not
responsible in any way for this package, nor are we aware that they offer any
guarantees about the data that this package accesses."))
(define-logger kitco)
(doc (section "Objects"))
(doc (defstruct* kitco-pm
((name symbol?)
(bid number?)
(ask number?)
(change (or/c #f number?))
(change-percent (or/c #f number?))
(low (or/c #f number?))
(high (or/c #f number?))
(ny-change (or/c #f number?))
(ny-change-percent (or/c #f number?)))
(para "This struct represents information about a single precious metal, and is associated with a single "
(racket kitco-spot)
". The "
(tt "name")
" field value is a symbol such as "
(racket 'gold)
". Note that New York data will not use the "
(tt "ny-change")
" and "
(tt "ny-change-percent")
" fields, but Europe/Asia data currently does.")))
(provide (rename-out
(kitco-pm-struct? kitco-pm?)
(kitco-pm-struct-name kitco-pm-name)
(kitco-pm-struct-bid kitco-pm-bid)
(kitco-pm-struct-ask kitco-pm-ask)
(kitco-pm-struct-change kitco-pm-change)
(kitco-pm-struct-change-percent kitco-pm-change-percent)
(kitco-pm-struct-low kitco-pm-low)
(kitco-pm-struct-high kitco-pm-high)
(kitco-pm-struct-ny-change kitco-pm-ny-change)
(kitco-pm-struct-ny-change-percent kitco-pm-ny-change-percent)))
(define-struct kitco-pm-struct
(name
bid
ask
change
change-percent
low
high
ny-change
ny-change-percent))
(doc (defstruct* kitco-spot
((name symbol?)
(timestamp-string string?)
(status (or/c 'open 'closed))
(pm-hash (hash/c symbol? kitco-pm?)))
(para "This struct represents spot prices on a particular region's exchange(s). The "
(tt "name")
" field is a symbol -- either "
(racket 'newyork)
" or "
(racket 'eurasia)
". "
(tt "timestamp-string")
" is in human-readable ISO 8601 format. "
(tt "pm-hash")
" is a hash of symbols (e.g., "
(racket 'gold)
", like the "
(tt "name")
" field of "
(racket kitco-pm)
") to "
(racket kitco-pm)
" objects.")))
(provide (rename-out
(kitco-spot-struct? kitco-spot?)
(kitco-spot-struct-name kitco-spot-name)
(kitco-spot-struct-timestamp-string kitco-spot-timestamp-string)
(kitco-spot-struct-status kitco-spot-status)
(kitco-spot-struct-pm-hash kitco-spot-pm-hash)))
(define-struct kitco-spot-struct
(name
timestamp-string
status
pm-hash))
(doc (defstruct* kitco-market
((newyork-spot (or/c #f kitco-spot?))
(eurasia-spot (or/c #f kitco-spot?)))
(para "This struct represents the entirety of the market data received
from a request, such as by "
(racket get-kitco-market)
".")))
(provide (rename-out
(kitco-market-struct? kitco-market?)
(kitco-market-struct-newyork-spot kitco-market-newyork-spot)
(kitco-market-struct-eurasia-spot kitco-market-eurasia-spot)))
(define-struct kitco-market-struct
(newyork-spot
eurasia-spot))
(doc (section "SXML"))
(define (%kitco-status->sxml status)
(if status
(symbol->string status)
""))
(doc (defproc* (((kitco-pm->sxml (x kitco-pm?)) sxml?)
((kitco-spot->sxml (x kitco-spot?)) sxml?)
((kitco-market->sxml (x kitco-market?)) sxml?))
(para "Convert the object to SXML format.")
(para "Note that the ordering of the XML "
(tt "pm")
" elements within a "
(tt "spot")
" element is undefined.")))
(provide kitco-pm->sxml
kitco-spot->sxml
kitco-market->sxml)
(define kitco-pm->sxml
(let ((optional-numeric (lambda (name number)
(if number
`((,name ,(number->string number)))
'()))))
(lambda (x)
`(pm (@ (name ,(symbol->string (kitco-pm-struct-name x)))
,@(optional-numeric 'bid (kitco-pm-struct-bid x))
,@(optional-numeric 'ask (kitco-pm-struct-ask x))
,@(optional-numeric 'change (kitco-pm-struct-change x))
,@(optional-numeric 'change-percent (kitco-pm-struct-change-percent x))
,@(optional-numeric 'low (kitco-pm-struct-low x))
,@(optional-numeric 'high (kitco-pm-struct-high x))
,@(optional-numeric 'ny-change (kitco-pm-struct-ny-change x))
,@(optional-numeric 'ny-change-percent (kitco-pm-struct-ny-change-percent x)))))))
(define (kitco-spot->sxml spot)
`(spot (@ (name ,(symbol->string (kitco-spot-struct-name spot)))
(timestamp ,(or (kitco-spot-struct-timestamp-string spot)
""))
(status ,(%kitco-status->sxml (kitco-spot-struct-status spot))))
,@(map kitco-pm->sxml
(hash-values (kitco-spot-struct-pm-hash spot)))))
(provide kitco-market->sxml)
(define (kitco-market->sxml x)
`(market ,(kitco-spot->sxml (kitco-market-struct-newyork-spot x))
,(kitco-spot->sxml (kitco-market-struct-eurasia-spot x))))
(doc (section "Parsing"))
(define multiline-whitespace-rxs "[ \t\r\n]+")
(define minuses-line-rxs " *--------+ *\r?\n")
(define immediate-minuses-line-rx (regexp (string-append "^" minuses-line-rxs)))
(define newline-rxs " *\r?\n")
(define ignored-nonnewline-rxs "[^\r\n]*")
(define %kitco:unsigned-fractional-rxs "[0-9]+\\.[0-9]+")
(define %kitco:signed-fractional-rxs "[-+]?[0-9]+\\.[0-9]+")
(define (%kitco:bytes->number bstr)
(string->number (bytes->string/latin-1 bstr)))
(define (%kitco-last-update-timestamp-bytes-decode bstr)
(log-kitco-debug "(%kitco-last-update-timestamp-bytes-decode ~S)" bstr)
(cond ((regexp-match #rx#"^ *([A-Z][a-z]+) ([0-9]+), ([0-9]+) at ([0-9]+):([0-9]+)[.:]([0-9]+) *$"
bstr)
=> (lambda (m)
(apply (lambda (all month mday year hours minutes seconds)
(cond ((hash-ref #hash((#"Jan" . #"01")
(#"Feb" . #"02")
(#"Mar" . #"03")
(#"Apr" . #"04")
(#"May" . #"05")
(#"Jun" . #"06")
(#"Jul" . #"07")
(#"Aug" . #"08")
(#"Sep" . #"09")
(#"Oct" . #"10")
(#"Nov" . #"11")
(#"Dec" . #"12"))
month
#f)
=> (lambda (month)
(bytes->string/latin-1 (bytes-append year
#"-"
month
#"-"
mday
#"T"
hours
#":"
minutes
#":"
seconds))))
(else #f)))
m)))
(else #f)))
(module+ test
(test-section '%kitco-last-update-timestamp-bytes-decode
(test 'decodeable
(%kitco-last-update-timestamp-bytes-decode #"Sep 26, 2013 at 19:26.02")
"2013-09-26T19:26:02")
(test 'non-decodeable
(%kitco-last-update-timestamp-bytes-decode #"26 Sep 2013 19:26.02")
#f)))
(define %parse-kitco-spot-html
(let ((%kitco-market-header-status-bytes->status
(lambda (str)
(case str
((#"CLOSED") 'closed)
((#"OPEN") 'open)
(else #f))))
(last-update-rx
(regexp (string-append "^[ \t]+Last Update on *([^\r\n]*)"
newline-rxs))))
(lambda (#:name name
#:header-rx header-rx
#:pm-rx pm-rx
#:pm-decode-proc pm-decode-proc
#:in in)
(let* ((status (let ((m (or (regexp-match header-rx in)
(error '%parse-kitco-market-section
"could not match ~S header"
name))))
(%kitco-market-header-status-bytes->status (list-ref m 1))))
(pm-hash (let loop ((pm-hash (make-immutable-hasheq)))
(cond ((regexp-try-match pm-rx in)
=> (lambda (m)
(let-values (((name pm) (pm-decode-proc m)))
(loop (hash-set pm-hash
name
pm)))))
((regexp-try-match immediate-minuses-line-rx in)
pm-hash)
(else
(error '%parse-kitco-market-section
"problem while matching ~S pms. hash=~S"
name
pm-hash)))))
(timestamp-string (let* ((m (or (regexp-match last-update-rx in)
(error '%parse-kitco-market-section
"could not match ~S last update line"
name))))
(%kitco-last-update-timestamp-bytes-decode (list-ref m 1))))
(m (or (regexp-match? immediate-minuses-line-rx in)
(error '%parse-kitco-market-section
"could not match minuses after ~S last update line"
name))))
(log-kitco-debug "%parse-kitco-spot-html: timestamp-string=~S" timestamp-string)
(make-kitco-spot-struct name
timestamp-string
status
pm-hash)))))
(doc (defproc (parse-kitco-market-html (in input-port?))
kitco-market?
(para "Parses HTML from the Kitco Market Web page, from input port "
(racket in)
". Note that usually you will call "
(racket get-kitco-market)
" or "
(racket get-kitco-market-sxml)
" rather than calling this parsing procedure directly.")))
(provide parse-kitco-market-html)
(define parse-kitco-market-html
(let* ((market-status-rxs
(string-append
"[ \t]+MARKET IS +"
"([^ \r\n]+)" newline-rxs
"[ \t]+Will (?:close|open) in"
ignored-nonnewline-rxs
newline-rxs))
(newyork-header-rx
(regexp
(string-append "New York Spot Price"
newline-rxs
market-status-rxs
minuses-line-rxs
"[ \t]*Metals +Bid +Ask +Change +Low +High"
newline-rxs
minuses-line-rxs)))
(eurasia-header-rx
(regexp
(string-append "Asia / Europe Spot Price"
newline-rxs
market-status-rxs
minuses-line-rxs
"[ \t]*Metals +Bid +Ask +Change from NY close"
newline-rxs
minuses-line-rxs)))
(pm-bytes->name
(lambda (bstr)
(or (hash-ref #hash((#"Gold" . gold)
(#"Silver" . silver)
(#"Platinum" . platinum)
(#"Palladium" . palladium))
bstr)
(string->symbol (string-downcase (bytes->string/latin-1 bstr))))))
(newyork-pm-rx
(regexp (string-append "^[ \t]+([A-Za-z]+)" "[ \t]+("
%kitco:unsigned-fractional-rxs ")[ \t]+("
%kitco:unsigned-fractional-rxs ")[ \t]+("
%kitco:signed-fractional-rxs ")[ \t]+("
%kitco:signed-fractional-rxs ")%[ \t]+("
%kitco:unsigned-fractional-rxs ")[ \t]+("
%kitco:unsigned-fractional-rxs ")"
newline-rxs)))
(newyork-pm-decode
(lambda (m)
(apply (lambda (all name bid ask change change-percent low high)
(let ((name (pm-bytes->name name)))
(values name
(make-kitco-pm-struct name
(%kitco:bytes->number bid)
(%kitco:bytes->number ask)
(%kitco:bytes->number change)
(%kitco:bytes->number change-percent)
(%kitco:bytes->number low)
(%kitco:bytes->number high)
#f
#f))))
m)))
(eurasia-pm-rx
(regexp (string-append "^[ \t]+([A-Za-z]+)" "[ \t]+("
%kitco:unsigned-fractional-rxs ")[ \t]+("
%kitco:unsigned-fractional-rxs ")[ \t]+("
%kitco:signed-fractional-rxs ")[ \t]+("
%kitco:signed-fractional-rxs ")%"
newline-rxs)))
(eurasia-pm-decode
(lambda (m)
(apply (lambda (all name bid ask ny-change ny-change-percent)
(let ((name (pm-bytes->name name)))
(values name
(make-kitco-pm-struct name
(%kitco:bytes->number bid)
(%kitco:bytes->number ask)
#f
#f
#f
#f
(%kitco:bytes->number ny-change)
(%kitco:bytes->number ny-change-percent)))))
m))))
(lambda (in)
(or (regexp-match? #rx"<pre>" in)
(error 'parse-kitco-market-html
"could not find pre html tag"))
(let* ((newyork-spot (%parse-kitco-spot-html #:name 'newyork
#:header-rx newyork-header-rx
#:pm-rx newyork-pm-rx
#:pm-decode-proc newyork-pm-decode
#:in in))
(eurasia-spot (%parse-kitco-spot-html #:name 'eurasia
#:header-rx eurasia-header-rx
#:pm-rx eurasia-pm-rx
#:pm-decode-proc eurasia-pm-decode
#:in in)))
(make-kitco-market-struct newyork-spot
eurasia-spot)))))
(doc (defproc (parse-kitco-market-html-string (str string?))
kitco-market?
(para "Like "
(racket parse-kitco-market-html)
" but takes a string rather than an input port.")))
(provide parse-kitco-market-html-string)
(define (parse-kitco-market-html-string str)
(call-with-input-string str parse-kitco-market-html))
(module+ test
(test-section 'parsing-and-sxml
(test
'first-test
(kitco-market->sxml
(parse-kitco-market-html-string
(string-append
"<html>\r\n"
"<head>\r\n"
"<title>Text Only Market Page</title>\r\n"
"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">\r\n"
"</head>\r\n"
"\r\n"
"<body bgcolor=\"#FFFFFF\">\r\n"
"<br><br>\r\n"
"<pre>\r\n"
"<b><font size=6>\r\n"
" Kitco Inc.\r\n"
"\r\n"
" Text Only Market Page</font></b>\r\n"
"\t \r\n"
" <a href=\"http://www.kitco.com/market/\">Graphic version of this page</a>\r\n"
"\t \r\n"
" <a href=\"http://www.kitco.com/market/LFrate.html\">Precious Metals Lease Rates</a> \r\n"
" <a href=\"http://www.kitco.com/gold.londonfix.html\">Historical Price Data</a> \r\n"
" <a href=\"http://www.kitco.com/market/marketnews.html\">Precious Metals News Headlines</a>\r\n"
"\t \r\n"
" <font size=4><b><a href=\"https://online.kitco.com/bullion/completelist_USD.html#gold\">Buy gold and silver online direct from Kitco!</a> \r\n"
" Live quotes for all bullion products.</b></font>\r\n"
"\t\t\r\n"
"\r\n"
" --------------------------------------------------------------------------------\r\n"
" London Fix GOLD SILVER PLATINUM PALLADIUM\r\n"
" AM PM AM PM AM PM\r\n"
" --------------------------------------------------------------------------------\r\n"
" Sep 27,2013 1321.50 1341.00 21.6100 1411.00 1416.00 720.00 725.00 \r\n"
" Sep 26,2013 1332.50 1333.00 21.9700 1432.00 1424.00 725.00 724.00 \r\n"
" --------------------------------------------------------------------------------\r\n"
"\r\n"
"\r\n"
"\t\t\t New York Spot Price\r\n"
"\t\t\t\tMARKET IS CLOSED\r\n"
"\t\t\t Will open in \r\n"
" ----------------------------------------------------------------------\r\n"
" Metals Bid Ask Change Low High \r\n"
" ----------------------------------------------------------------------\r\n"
" Gold 1336.20 1337.20 +12.40 +0.94%\t 1332.90 1345.30 \r\n"
" Silver 21.78 21.88 +0.05 +0.25%\t 21.67 22.25 \r\n"
" Platinum 1415.00 1425.00 +9.00 +0.64%\t 1409.00 1428.00 \r\n"
" Palladium 728.00 733.00 +9.00 +1.25%\t 722.00 738.00 \r\n"
" ----------------------------------------------------------------------\r\n"
" Last Update on Sep 27, 2013 at 17:14.57\r\n"
" ----------------------------------------------------------------------\r\n"
"\r\n"
"\r\n"
"\t\t\t Asia / Europe Spot Price\r\n"
"\t\t\t\tMARKET IS CLOSED\r\n"
"\t\t\tWill open in 17 hours \r\n"
" ----------------------------------------------------------------------\r\n"
" Metals Bid Ask Change from NY close\r\n"
" ----------------------------------------------------------------------\r\n"
" Gold 1336.20 1337.20 +12.40 +0.94%\r\n"
" Silver 21.78 21.88 +0.05 +0.25%\r\n"
" Platinum 1415.00 1425.00 +9.00 +0.64%\r\n"
" Palladium 728.00 733.00 +9.00 +1.25%\r\n"
" ----------------------------------------------------------------------\r\n"
" Last Update on Sep 27, 2013 at 17:14.57\r\n"
" ----------------------------------------------------------------------\r\n"
"\r\n"
"\r\n"
"<b> File created on Sun Sep 29 00:21:35 2013</b>\r\n"
"\r\n"
"\r\n"
"\t\t<style type=\"text/css\"><!--\r\n"
" #main_container_footer {width:100%;text-align: center;}\r\n"
"\t#main_container_footer #footer_container {width:auto; margin:25px auto 25px auto;}\r\n"
"\t#main_container_footer #footer_container ul {margin:0; padding:0;}\r\n"
"\t#main_container_footer #footer_container ul li {float:left; display:inline; list-style:none; padding:0 8px; font-family:Verdana, Arial, Helvetica, sans-serif; font-size:12px; color:#000; border-right:1px #000 solid;}\r\n"
"\t#main_container_footer #footer_container ul li a {font-family:Verdana, Arial, Helvetica, sans-serif; font-size:12px; color:#000; text-decoration:underline; font-weight:normal;}\r\n"
"\t#main_container_footer #footer_container ul li a:hover {color:#ac1a2f; text-decoration:none; font-weight:normal;}\r\n"
"\t#main_container_footer #footer_container ul li.no_border {border:0px;}\r\n"
"--></style>\r\n"
" <table border=\"0\" cellspacing=\"0\" cellpadding=\"0\"><tr><td>\r\n"
" <div id=\"main_container_footer\">\r\n"
" \t<div id=\"footer_container\">\r\n"
" \t<ul>\r\n"
" \t<li class=\"no_border\"><script type=\"text/javascript\">\r\n"
"copyright=new Date();\r\n"
"update=copyright.getFullYear();\r\n"
"document.write(\"© \"+ update + \" Kitco Metals Inc.\");\r\n"
"</script></li>\r\n"
" <li><a href=\"https://corp.kitco.com/index.html\">About Us</a></li>\r\n"
" <li><a href=\"http://www.kitco.com/TermsofUse/\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Website Terms of Use</a></li>\r\n"
" <li><a href=\"https://online.kitco.com/help/privacy_policy.html\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Privacy Policy</a></li>\r\n"
" <li><a href=\"http://www.kitco.com/ads/\">Advertise With Us</a></li>\r\n"
" <li><a href=\"https://corp.kitco.com/en/corporate_culture.html\">Careers</a></li>\r\n"
" <li><a href=\"https://corp.kitco.com/en/contact.html\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Contact Us</a></li>\r\n"
" <li class=\"no_border\"><a href=\"https://corp.kitco.com/en/feedback.html\" target=\"_top\" onclick=\"Window_open(this.href,'KITCO','top=120,left=250,width=500,height=350'); return false\">Feedback</a></li>\r\n"
"\t\t\t</ul>\r\n"
" </div>\r\n"
" </div>\t\r\n"
"\t\r\n"
"\t</td></tr></table><br /><br />\r\n"
"<script language=\"JavaScript\" type=\"text/javascript\">\r\n"
"<!--\r\n"
"function Window_open (Address) {\r\n"
" NewWindow = window.open(Address, \"Popup\", \"width=695,height=600,left=100,top=200,resizable=yes,scrollbars=yes\");\r\n"
" NewWindow.focus();\r\n"
"}\r\n"
"// -->\r\n"
"</script>\r\n"
" <!-- img src=\"http://www.kitco.com/scripts/counter/counter.pl?txtonlyE.txt\" width=\"1\" height=\"1\" -->\r\n"
"<!-- Google-Analytics Code-->\r\n"
"<script type=\"text/javascript\">\r\n"
" var _gaq = _gaq || [];\r\n"
" _gaq.push(['_setAccount', 'UA-4074364-3']);\r\n"
" _gaq.push(['_trackPageview']);\r\n"
"\r\n"
" (function() {\r\n"
" var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;\r\n"
" ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';\r\n"
" var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);\r\n"
" })();\r\n"
"</script>\r\n"
"</body>\r\n"
"</html>\r\n")))
'(market (spot (@ (name "newyork")
(timestamp "2013-09-27T17:14:57")
(status "closed"))
(pm (@ (name "gold") (bid "1336.2") (ask "1337.2") (change "12.4") (change-percent "0.94") (low "1332.9") (high "1345.3")))
(pm (@ (name "silver") (bid "21.78") (ask "21.88") (change "0.05") (change-percent "0.25") (low "21.67") (high "22.25")))
(pm (@ (name "platinum") (bid "1415.0") (ask "1425.0") (change "9.0") (change-percent "0.64") (low "1409.0") (high "1428.0")))
(pm (@ (name "palladium") (bid "728.0") (ask "733.0") (change "9.0") (change-percent "1.25") (low "722.0") (high "738.0"))))
(spot (@ (name "eurasia")
(timestamp "2013-09-27T17:14:57")
(status "closed"))
(pm (@ (name "gold") (bid "1336.2") (ask "1337.2") (ny-change "12.4") (ny-change-percent "0.94")))
(pm (@ (name "silver") (bid "21.78") (ask "21.88") (ny-change "0.05") (ny-change-percent "0.25")))
(pm (@ (name "platinum") (bid "1415.0") (ask "1425.0") (ny-change "9.0") (ny-change-percent "0.64")))
(pm (@ (name "palladium") (bid "728.0") (ask "733.0") (ny-change "9.0") (ny-change-percent "1.25"))))))))
(doc (section "Network"))
(doc (defparam current-kitco-market-url url url?
(para "A URL used internally by "
(racket get-kitco-market)
" and "
(racket get-kitco-market-sxml)
". You should not normally change this except for testing or
simulation.")))
(provide current-kitco-market-url)
(define current-kitco-market-url
(make-parameter (string->url "http://www.kitco.com/texten/texten.html")))
(doc (defparam current-kitco-user-agent str string?
(para "String for the default value of HTTP header "
(tt "User-Agent")
".")
(para "In general, you should use a different user agent string for each
app that you make. For example, if your app is named NW-O-Matic, do something
like:")
(racketblock
(define km
(parameterize ((current-kitco-user-agent
"Mozilla (NW-O-Matic) Firefox/NOT"))
(get-kitco-market))))
"or:"
(racketblock
(current-kitco-user-agent "Mozilla (NW-O-Matic) Firefox/NOT")
(define km (get-kitco-market)))
(para "or use a "
(racket "#:user-agent")
" command-line argument instead of the parameter:")
(racketblock
(define km
(get-kitco-market #:user-agent "Mozilla (NW-O-Matic) Firefox/NOT")))
(para "The reason for including keywords like ``Mozilla'' and
``Firefox'' is historical: in the early days of Web browsers, a very small
number of Web sites used the user agent string to detect Netscape (nee Mosaic
Communications) Navigator (based on ``Mozilla'', the publicly-known internal
name for Navigator, in the user agent string) and send different HTML to it
than for other browsers; browsers like Microsoft Internet Explorer began
sending user agent strings that also included the string ``Mozilla''. This
remains a convention, even after a well-known Netscape spinoff eventually
adopted the internal ``Mozilla'' name as its corporate name.")))
(provide current-kitco-user-agent)
(define current-kitco-user-agent
(make-parameter "Mozilla (kitco.rkt) Firefox/NOT"))
(doc (defproc (get-kitco-market (#:user-agent user-agent string? #f))
kitco-market?
(para "Get a "
(racket kitco-market)
" object by making an HTTP request and parsing the result.")
(para "If "
(racket user-agent)
" is "
(racket #f)
", the value of the "
(racket current-kitco-user-agent)
" parameter is used. See the documentation for that parameter for
why you should specify a user agent specific to your app.")
(para "Please note that, since this procedure makes HTTP requests of an
external server operated by someone else, it is important not to abuse the
server with requests that are too frequent.")))
(provide get-kitco-market)
(define (get-kitco-market #:user-agent (user-agent #f))
(call/input-url (current-kitco-market-url)
get-pure-port
parse-kitco-market-html
(list (string-append "User-Agent: "
(current-kitco-user-agent)))))
(doc (defproc (get-kitco-market-sxml (#:user-agent user-agent string? #f))
sxml?
(para "Like "
(racket get-kitco-market)
", but returns SXML rather than a "
(racket kitco-market)
" object. See the documentation for "
(racket get-kitco-market)
".")))
(provide get-kitco-market-sxml)
(define (get-kitco-market-sxml #:user-agent (user-agent #f))
(kitco-market->sxml (get-kitco-market #:user-agent user-agent)))
(doc (section "Known Issues")
(itemlist
(item "Find out for-pay sources of same information, with some service
guarantees, and perhaps offer an interface to those, too.")
(item "Parse London Fix section, and add it to market struct.")
(item "Pull timestamp out of any ``"
(tt "File created on")
"'' towards bottom of page, and add it to the market struct.")
(item "Add custom-writers for structs.")
(item "In SXML format, sort the PMs, either alphabetically, or in the default Kitco order.")))
(doc history
(#:planet 1:1 #:date "2013-09-30"
(itemlist
(item "Documentation fix.")))
(#:planet 1:0 #:date "2013-09-30"
(itemlist
(item "Initial release."))))
![[logo]](/logo.png){kind=logo}