Initial commit of bloomberg.tcl

bloomberg.tcl

@@ -0,0 +1,130 @@
+#
+# 20/07/2011
+#
+
+package require http
+
+namespace eval ::bloomberg {
+	bind pub -|- !metals ::bloomberg::metals
+	bind pub -|- !gold   ::bloomberg::gold
+	bind pub -|- !silver ::bloomberg::silver
+	bind pub -|- !oil    ::bloomberg::oil
+
+	variable futures_url {http://www.bloomberg.com/markets/commodities/futures/}
+
+	variable user_agent "Lynx/2.8.5rel.1 libwww-FM/2.14 SSL-MM/1.4.1 OpenSSL/0.9.7e"
+	# ms
+	variable http_timeout 60000
+
+	setudef flag bloomberg
+}
+
+proc ::bloomberg::fetch_data {} {
+	::http::config -useragent $::bloomberg::user_agent
+	set token [::http::geturl $::bloomberg::futures_url -timeout $::bloomberg::http_timeout]
+	set data [::http::data $token]
+	set ncode [::http::ncode $token]
+	::http::cleanup $token
+
+	if {$ncode != 200} {
+		error "HTTP error code $ncode $data"
+	}
+	return $data
+}
+
+# Returns a dict, each key name of commodity
+# Each value for key is itself a dict with values
+# name, value, updown, change, change_percent, datetime
+proc ::bloomberg::parse_html {html} {
+	# Get rid of everything before energy table
+	regexp -- {<a class="nohov">(.*)} $html -> html
+
+	set bulk_commodity_regexp {<tr.*?>.*?<td class="change value_.*?">.*?</tr>}
+	set commodity_regexp {<td class="name">(.*?)</td>.*?<td class="value">(.*?)</td>.*?<td class="change value_(.*?)">(.*?)</td>.*?<td class="change value_.*?">(.*?)</td>.*?<td class="datetime">(.*?)</td>}
+
+	set commodity_dict [dict create]
+	foreach commodity_html [regexp -all -inline -- $bulk_commodity_regexp $html] {
+		#puts "comm $commodity_html"
+		regexp -- $commodity_regexp $commodity_html -> name value updown change change_percent datetime
+		# Name can have excessive spacing
+		set name [regsub -all -- {\s+} $name " "]
+
+		#puts "name $name value $value updown $updown change $change change_percent $change_percent datetime $datetime"
+		dict append commodity_dict $name [list name $name value $value updown $updown change $change change_percent $change_percent datetime $datetime]
+	}
+	return $commodity_dict
+}
+
+# Get commodities with names matching the names in list_of_commodities
+proc ::bloomberg::get_futures {list_of_commodities} {
+	set raw_data [::bloomberg::fetch_data]
+	set futures_dict [::bloomberg::parse_html $raw_data]
+
+	set wanted_commodities [list]
+	foreach commodity_key [dict keys $futures_dict] {
+		foreach wanted_commodity $list_of_commodities {
+			if {[regexp -nocase -- $wanted_commodity $commodity_key]} {
+				lappend wanted_commodities [dict get $futures_dict $commodity_key]
+			}
+		}
+	}
+	return $wanted_commodities
+}
+
+proc ::bloomberg::colour {updown str} {
+	if {[regexp -nocase -- {up} $updown]} {
+		return \00309+$str\017\003
+	} elseif {[regexp -nocase -- {down} $updown]} {
+		return \00304$str\017\003
+	} else {
+		return $str\003
+	}
+}
+
+proc ::bloomberg::output_commodity {chan commodity_dict} {
+	set colour []
+	set name [dict get $commodity_dict name]
+	set value [dict get $commodity_dict value]
+	set change [::bloomberg::colour [dict get $commodity_dict updown] "[dict get $commodity_dict change] [dict get $commodity_dict change_percent]"]
+	set datetime [dict get $commodity_dict datetime]
+
+	putserv "PRIVMSG $chan :$name: \00310$value $change $datetime"
+}
+
+proc ::bloomberg::oil {nick uhost hand chan argv} {
+	if {![channel get $chan bloomberg]} { return }
+
+	set commodities [::bloomberg::get_futures [list crude]]
+	foreach commodity_dict $commodities {
+		::bloomberg::output_commodity $chan $commodity_dict
+	}
+}
+
+proc ::bloomberg::metals {nick uhost hand chan argv} {
+	if {![channel get $chan bloomberg]} { return }
+
+	set commodities [::bloomberg::get_futures [list copper gold silver]]
+	foreach commodity_dict $commodities {
+		::bloomberg::output_commodity $chan $commodity_dict
+	}
+}
+
+proc ::bloomberg::gold {nick uhost hand chan argv} {
+	if {![channel get $chan bloomberg]} { return }
+
+	set commodities [::bloomberg::get_futures [list gold]]
+	foreach commodity_dict $commodities {
+		::bloomberg::output_commodity $chan $commodity_dict
+	}
+}
+
+proc ::bloomberg::silver {nick uhost hand chan argv} {
+	if {![channel get $chan bloomberg]} { return }
+
+	set commodities [::bloomberg::get_futures [list silver]]
+	foreach commodity_dict $commodities {
+		::bloomberg::output_commodity $chan $commodity_dict
+	}
+}
+
+putlog "bloomberg.tcl loaded"