#
# StockQuotes 
#
# This module queries a webserver, currently finance.yahoo.com, for stock
# quotes. 
#
# Examples:
#
# StockQuotes:-Get("SUNW","YHOO");
# StockQuotes:-GetDecimal("SUNW");
# StockQuotes:-GetHistory("EGN.V");
# StockQuotes:-PlotHistory("EGN.V");
#
# The implementation is tied closely to the structure of the page returned
# by finance.yahoo.com, is not easily ported to other servers and will not
# deal gracefully with changes in the output format of finance.yahoo.com.
#
# LB, March 2001
#

StockQuotes := module()
	export Get,GetDecimal,GetHistory,PlotHistory;
	local ReadPage;

	ReadPage := proc(s) local text,line;
		text := "";
		line := Sockets:-Read(s):
		while line <> false do
			text := cat(text,line);
			line := Sockets:-Read(s):
		end do;
		text
	end:

	Get := proc(stock1::{string,symbol,list({string,symbol})})
		local stock,server,s,text,line,id,i,j;

		# map over multiple arguments
		if nargs>1 then
			return op(map(Get,[args]));
		elif stock1::'list' then
			return map(Get,stock1);
		end if;

		# Convert to all uppercase and convert symbols to strings
		stock := StringTools:-UpperCase(convert(stock1,'string'));

		# Contact webserver at port 80
		server := "finance.yahoo.com";
		s := Sockets:-Open(server,80);

		# the following magical incantation asks yahoo for a
		# stock quote
		Sockets:-Write(s,cat("GET /q?s=",stock,"&d=v1&o=t\n"));

		# Now read in complete result page
		text := ReadPage(s);
		#line := Sockets:-Read(s):
		#while line <> false do
			#text := cat(text,line);
			#line := Sockets:-Read(s):
		#end do;
		Sockets:-Close(s);

		# Search for the line in the result that contains the quote
		id := cat(``,"</small><big><b>");
		i := SearchText(id,cat(``,text));
		if i=0 then
			i := SearchText("No such ticker symbol",cat(``,text));
			if i>0 then
				error "%1 is an unknown ticker symbol",stock
			end if;
			error "Unable to interpret results from %1",server;
		end if;

		# We found the start of the quote line, now look for the
		# quote (enclosed in <b>...</b>)
		j := SearchText("<b>",cat(``,text),i..-1);
		if j=0 then
			error "Quote for %1 not found",stock
		end if;
		i := i+j+2;
		j := SearchText("</b>",cat(``,text),i..-1);
		if j=0 then
			error "Unable to interpret results from %1",server;
		end if;
		
		# Isolate and return price for quote
		StringTools:-SubString(text,i..i+j-2);
	end:

	GetDecimal := proc(stock::{string,symbol,list({string,symbol})}) local price,i;

		# map over multiple arguments
		if nargs>1 then
			return op(map(GetDecimal,[args]));
		elif stock::'list' then
			return map(GetDecimal,stock);
		end if;	

		# get quote in fractional notation, e.g. "18 3/5"
		price := Get(stock);

		# now turn the first space into a plus sign
		i := StringTools:-FirstFromLeft(" ",price);
		price := cat(StringTools:-Take(price,i),
				"+",StringTools:-Drop(price,i));

		# return quote in decimal notation.
		evalf(parse(price));
	end:

	GetHistory := proc(stock1::{string,symbol,list({string,symbol})})
		local stock,server,s,smonth,sday,syear,emonth,eday,eyear,freq,
			req,text,i,j,headerfound,xmldata,ntext,result;

		# map over multiple arguments
                if nargs>1 then
                        return op(map(GetHistory,[args]));
                elif stock::'list' then
                        return map(GetHistory,stock);
                end if;

		# convert to all uppercase
		stock := StringTools:-UpperCase(convert(stock1,'string'));

		# contact chart.yahoo.com
		server := "chart.yahoo.com";
                s := Sockets:-Open(server,80);

		# TODO: add a way of specifying the dates to be queried
		smonth := "01"; sday := "01"; syear := "01";
		emonth := "04"; eday := "01"; eyear := "01";
		freq := "d"; # sample every 'd'ay

		# this is the request for chart.yahoo.com if you want to specify dates and sampling
		#req := cat("GET /t?a=",smonth,"&b=",sday,"&c=",syear,"&d=",emonth,"&e=",eday,"&f=",eyear,"&g=",freq,"&s=",stock,"&y=0&z=",stock," HTTP/1.0\n\n");

		# this is the request for chart.yahoo.com if you do not want to specify selection of dates and sampling
		req := cat("GET /d?s=",stock," HTTP/1.0\n\n");

		# send the request
		Sockets:-Write(s,req);

		# read result page
		text := ReadPage(s);

		# shut connection down
		Sockets:-Close(s);

		# extract table of historical quote values
		i := SearchText("<td align=center><b>Date</b></td><td align=center><b>Open</b></td><td align=center><b>High</b></td><td align=center><b>Low</b></td><td align=center><b>Close</b></td><td align=center><b>Volume</b></td>",text);
		if i=0 then
			error "Could not find start of chart"
		end if;
		text := StringTools:-SubString(text,i-100..-1);
		i := SearchText("<table ",text);
		if i=0 then
			error "Start of table not found"
		end if;
		text := StringTools:-SubString(text,i..-1);
		j := SearchText("</table>",text);
		if j=0 then
			error "End of table not found"
		end if;
		j := j+length("</table>")-1;

		text := StringTools:-SubString(text,1..j);

		# transform carriage returns into whitespace
		text := StringTools:-CharacterMap("\n"," ",text);

		# quote all HTML attributes to conform with XML spec.
		while ntext<>text do
			ntext := text;
			text := StringTools:-RegSub(text,"(.*)=([a-z0-9][a-z0-9]*)(.*)","\\1=\'\\2\'\\3");
			if text=FAIL then
				text := ntext;
			end if;
		end do;

		# interpret result as XML string
		result := XMLTools:-FromString(text);

		# extract relevant part from XML datastructure
		headerfound := false;
		for i from 1 to nops(result) do
			if op(i,result)::'specfunc(anything,_XML_tr)' then
				if headerfound then
					result := [op(i..-1,result)];
					break;
				end if;
				headerfound := true;
			end if;
		end do;

		# package quotes into a new XML datastructure of the form:
		# <stockhistory>
		#	<quote>
		#		<date> date of sample </date>
		#		<open> opening price of period </open>
		#		<high> high price of period </high>
		#		<low>  low price of period </low>
		#		<close> closing price of period </close>
		#		<volume> trading volume during period </volume>
		#		<adjclose> closing price adjusted for dividends and splits </adjclose>
		#	</quote>
		# </stockhistory>
		#
		xmldata := map(proc(tt) local t;
				t := remove(type,tt,'equation');
				if nops(t)=7 then
				  _XML_quote(
					_XML_date(op(op(2,op(1,t)))),
					_XML_open(op(op(2,op(2,t)))),
					_XML_high(op(op(2,op(3,t)))),
					_XML_low(op(op(2,op(4,t)))),
					_XML_close(op(op(op(2,op(5,t))))),
					_XML_volume(op(op(2,op(6,t)))),
					_XML_adjclose(op(op(2,op(7,t))))
					)
				else
				  NULL
				end if
			       end, ListTools:-Reverse(result));
		_XML_stockhistory('stock'=stock,op(xmldata));
	end:

	PlotHistory := proc(stock) local xmldata, sdate,edate,ltext;
                # map over multiple arguments.
                if nargs>1 then
                        return plots[display](map(PlotHistory,[args]));
                elif stock::'list' then
                        return plots[display](map(PlotHistory,stock));
                end if;

		xmldata := GetHistory(stock);

		# remove stock=... attribute
		xmldata := remove(type,xmldata,'equation');

		# extract date of first and last period
		sdate := op(op(op(1,op(1,xmldata))));
		edate := op(op(op(1,op(-1,xmldata))));

		# assemble string to use as legend
		ltext := cat("",stock," ",sdate," to ",edate);

		# plot history
		plots[listplot]([op(map(t->op(op(-1,t)),xmldata))],legend=ltext);
	end:
end:

#savelib('StockQuotes'):