Hello,
here's a rexx script to fetch historical stock data from NASDAQ OMX (Sweden).
Please do note that the current version has been developed to target the Swedish stock market, but should help you if you want to add something similar in the country you live in.
The code use rxSock and POST data to retrieve information and thus doesn't rely on cURL or wget.
SSE366 = the code for a particular stock.
2012-05-04 = the start date to retrieve historical data from.
The output is a simple html code that Lotus 1-2-3 and OpenOffice.org Calc should be able to read and present as web query table data.
You may also want to modify the code to allow parameter input for dynamic usage.
While you're at it, rewrite it some more to retrieve current live stock data.
Those of you that feel a bit more adventures should figure out how to use it with the rexx web server sre2003 (srehttp/2) as a cgi-bin script to let the whole world get historical stock data.
(It's actually quite straight forward if you see test-cgi.cmd that come with srehttp/2)
/*
* Filename: fetchstockdata.cmd
* Author: JAN-ERIK LÄRKA
* Created: Mon Sep 3 2012
* Purpose: Fetch stock data for NASDAQ-OMX (Stockholmsbörsen)
* Changes:
*/
/* initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
rc = SockLoadFuncs()
end
CALL rxURLComponents 'host.1.', 'http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx'
vars = rxAddXMLTags( 'SSE366', '2012-05-04' )
CALL rxURLConnect
PARSE VALUE rxURLRetrieve( 1, 'Content-type: application/x-www-form-urlencoded; charset=UTF-8 '||"0D0A"x||'Content-length: '||LENGTH( vars )||"0D0A0D0A"x||vars ) WITH ."0D0A0D0A"x retval
CALL CHAROUT 'sse366.html', '<html><body>'||retval||'</body></html>'
RETURN 0
rxURLConnect: PROCEDURE EXPOSE host.
IF \DATATYPE( host.0, 'W' ) THEN
host.0 = 0
j = host.0 + 1
DO i = 1 TO host.0
IF TRANSLATE( host.i.location ) = TRANSLATE( host.j.location ) THEN LEAVE
END
IF i > host.0 THEN
DO
/* get dot address of host */
SAY 'Resolving ip address of "'host.i.location'"'
IF 1 <> SockGetHostByName( host.i.location, "host."i"." ) then
call error "Don't know who" host.i.location "is ... sorry"
END
ELSE
host.j.addr = host.i.addr
host.0 = j
i = j
/* Close the connection if already open but not closed */
IF SYMBOL( host.i.socket ) = 'VAR' THEN
rc = SockClose( host.i.socket )
SAY 'Connecting to 'host.i.addr
/* create socket */
host.i.socket = SockSocket( host.i.family, "SOCK_STREAM", 0 )
IF s < 0 then
call error "Error creating socket:" errno
SAY 'Connecting to 'host.i.location'/'host.i.path
/* connect it to the server */
rc = SockConnect( host.i.socket, "host."i"." )
if rc < 0 then
call error "Error connecting to" host.i.addr ":" errno
RETURN rc
/* PRocedure to build and encode the xmlquery */
rxAddXMLTags: PROCEDURE
param.1 = 'SubSystem'
param.2 = 'Action'
param.3 = 'ApendIntraDay'
param.4 = 'Instrument'
param.5 = 'FromDate'
param.6 = 'ToDate'
param.7 = 'hi_a'
param.8 = 'ext_xslt'
param.9 = 'ext_xslt_options'
param.10 = 'ext_xslt_lang'
param.11 = 'ext_xslt_hiddenattrs'
param.12 = 'ext_xslt_tableId'
param.13 = 'app'
param.0 = 13
swe_date = DATE( 'S' )
val.1 = 'History'
val.2 = 'GetDataSeries'
val.3 = 'no'
val.4 = ARG(1) /* Stock ID */
IF LENGTH( ARG(2) ) > 0 THEN
val.5 = ARG(2) /* From Date */
ELSE
val.5 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-01' /* From Date ( First day of month ) */
IF LENGTH( ARG(3) ) > 0 THEN
val.6 = ARG(3) /* To Date */
ELSE
val.6 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-'||RIGHT( swe_date, 2 ) /* To Date ( Today ) */
val.7 = '0,1,2,4,21,8,10,11,12,9'
val.8 = '/nordicV3/hi_table_shares_adjusted.xsl'
val.9 = ',undefined,'
val.10 = 'en'
val.11 = ',ip,iv,'
val.12 = 'historicalTable'
val.13 = '/shares/historical_prices'
val.0 = 13
retval = ''
DO i = 1 TO param.0
retval = retval||'<param name="'||param.i||'" value="'||val.i||'"/>'
END
/* Replace ' ' (space) with + (plus) */
retval = TRANSLATE( 'xmlquery=<post>'||retval||'</post>', '+', ' ' )
/* Find characters to encode */
rest = SPACE( TRANSLATE( XRANGE(),, XRANGE( 0, 9 )||XRANGE( 'A', 'Z' )||XRANGE( 'a', 'z' )||'%_+=' ), 0 )
chstr = ''
/* Replace each special character with its hex value preceded by %, use the changestr-function to do it. */
DO i = i TO LENGTH( rest )
retval = CHANGESTR( SUBSTR( rest, i, 1 ), retval, '%'||C2X( SUBSTR( rest, i, 1 ) ) )
END
RETURN retval
/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle<, caselss>> */
IF TRACE() = '?I' THEN CALL TRACE 'O'
PARSE ARG needle, haystack, newneedle, caselss
new_haystack = ''
IF caselss = '' THEN
DO WHILE POS( needle, haystack ) > 0
PARSE VALUE haystack WITH pre(needle)haystack
new_haystack = new_haystack||pre||newneedle
END
ELSE DO
needle = TRANSLATE( needle )
strpos = POS( needle, TRANSLATE( haystack ) )
DO WHILE strpos > 0
IF strpos > 1 THEN
pre = LEFT( haystack, strpos - 1 )
ELSE pre = ''
haystack = SUBSTR( haystack, strpos + LENGTH( needle ) )
new_haystack = new_haystack||pre||newneedle
strpos = POS( needle, TRANSLATE( haystack ) )
END
END
RETURN new_haystack||haystack
rxURLRetrieve: PROCEDURE EXPOSE host. text
/* send message across ... loop in case entire message can't be sent in one SockSend() */
i = host.0
IF LENGTH( ARG(1) ) > 0 THEN
message = 'POST /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||ARG(2)||"0D0A0D0A"x
ELSE IF SYMBOL( 'host.'i'.cookie' ) = 'VAR' THEN
message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||'Cookie: '||host.i.cookie||"0D0A0D0A"x
ELSE
message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A0D0A"x
do while ( message <> "" )
bytes = SockSend( host.i.socket, message )
message = substr( message, bytes + 1 )
end
say date() time() ':' host.i.location 'contacted.'
text = ''
IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
DO WHILE rc > -1 & chunk <> ''
rc = SockRecv( host.i.socket, 'chunk', 1000 )
text = text||chunk
CALL CHAROUT , '█'
END
IF LENGTH( text ) > 0 THEN
DO
SAY
SAY date() time() ':' host.i.location 'replied.'
END
/* wait for server to close the connection, then close our end */
rc = SockClose( host.i.socket )
DROP host.i.socket
RETURN text
rxURLComponents:
!_host_! = ARG(1)
CALL GetURLComponents ARG( 2 )
CALL VALUE !_host_!'scheme', host.scheme
CALL VALUE !_host_!'location', host.location
CALL VALUE !_host_!'port', host.port
CALL VALUE !_host_!'params', host.params
CALL VALUE !_host_!'query', host.query
CALL VALUE !_host_!'target', host.target
CALL VALUE !_host_!'file', host.file
CALL VALUE !_host_!'family', host.family
CALL VALUE !_host_!'path', host.path
RETURN
GetURLComponents: PROCEDURE EXPOSE host.
/* URL syntax consists of these components: */
/* <scheme>://<location>:<port>/<path><params>?<query>#<target> */
PARSE VALUE ARG( 1 ) WITH host.scheme '://' host.location '/' host.path
host.location = strip( host.location, 'L', '/' ) /* in case of scheme like "file:///" */
IF host.location = '' THEN
PARSE VALUE ARG( 1 ) WITH host.location '/' host.path
PARSE VALUE host.location WITH host.location ':' host.port
IF host.port = '' THEN
IF TRANSLATE( host.scheme ) = 'HTTP' then
host.port = 80
ELSE IF TRANSLATE( host.scheme ) = 'FTP' then
host.port = 21
PARSE VALUE host.path WITH host.file '' host.params '?' host.query '#' host.target
IF host.params = '' THEN
PARSE VALUE host.path WITH host.file '?' host.query '#' host.target
IF host.query = '' THEN
PARSE VALUE host.path WITH host.file '#' host.target
host.family = "AF_INET"
RETURN
GetURLComponent: PROCEDURE EXPOSE host.
IF LENGTH( ARG(1) ) > 0 THEN
CALL GetURLComponents ARG( 1 )
SELECT
WHEN TRANSLATE( ARG( 2 ) ) = 'S' THEN
RETURN host.scheme
WHEN TRANSLATE( ARG( 2 ) ) = 'H' THEN
RETURN host.location||':'||host.port
WHEN TRANSLATE( ARG( 2 ) ) = 'N' THEN
RETURN host.location
WHEN TRANSLATE( ARG( 2 ) ) = 'L' THEN
RETURN host.port
WHEN TRANSLATE( ARG( 2 ) ) = 'P' THEN
RETURN host.param
WHEN TRANSLATE( ARG( 2 ) ) = 'Q' THEN
RETURN host.query
WHEN TRANSLATE( ARG( 2 ) ) = 'T' THEN
RETURN host.target
WHEN TRANSLATE( ARG( 2 ) ) = 'F' THEN
RETURN FILESPEC( 'N', host.path )
OTHERWISE
RETURN host.path
END
/* print an error message */
error: procedure
say arg(1)
exit
//Jan-Erik
Here I get an error in line 19 about an extra close paren or comma. I removed the 1, just to see what would happen and it then runs without error but the output in sse336.html was
<html><body>xmlquery=%3Cpost%3E%3Cparam+name=%22SubSystem%22+value=%22History%22%2F%3E%3Cparam+name=%22Action%22+value=%22GetDataSeries%22%2F%3E%3Cparam+name=%22ApendIntraDay%22+value=%22no%22%2F%3E%3Cparam+name=%22Instrument%22+value=%22SSE366%22%2F%3E%3Cparam+name=%22FromDate%22+value=%222012%2D05%2D04%22%2F%3E%3Cparam+name=%22ToDate%22+value=%222012%2D09%2D03%22%2F%3E%3Cparam+name=%22hi_a%22+value=%220%2C1%2C2%2C4%2C21%2C8%2C10%2C11%2C12%2C9%22%2F%3E%3Cparam+name=%22ext_xslt%22+value=%22%2FnordicV3%2Fhi_table_shares_adjusted%2Exsl%22%2F%3E%3Cparam+name=%22ext_xslt_options%22+value=%22%2Cundefined%2C%22%2F%3E%3Cparam+name=%22ext_xslt_lang%22+value=%22en%22%2F%3E%3Cparam+name=%22ext_xslt_hiddenattrs%22+value=%22%2Cip%2Civ%2C%22%2F%3E%3Cparam+name=%22ext_xslt_tableId%22+value=%22historicalTable%22%2F%3E%3Cparam+name=%22app%22+value=%22%2Fshares%2Fhistorical_prices%22%2F%3E%3C%2Fpost%3E</body></html><html><body>xmlquery=%3Cpost%3E%3Cparam+name=%22SubSystem%22+value=%22History%22%2F%3E%3Cparam+name=%22Action%22+value=%22GetDataSeries%22%2F%3E%3Cparam+name=%22ApendIntraDay%22+value=%22no%22%2F%3E%3Cparam+name=%22Instrument%22+value=%22SSE366%22%2F%3E%3Cparam+name=%22FromDate%22+value=%222012%2D05%2D04%22%2F%3E%3Cparam+name=%22ToDate%22+value=%222012%2D09%2D03%22%2F%3E%3Cparam+name=%22hi_a%22+value=%220%2C1%2C2%2C4%2C21%2C8%2C10%2C11%2C12%2C9%22%2F%3E%3Cparam+name=%22ext_xslt%22+value=%22%2FnordicV3%2Fhi_table_shares_adjusted%2Exsl%22%2F%3E%3Cparam+name=%22ext_xslt_options%22+value=%22%2Cundefined%2C%22%2F%3E%3Cparam+name=%22ext_xslt_lang%22+value=%22en%22%2F%3E%3Cparam+name=%22ext_xslt_hiddenattrs%22+value=%22%2Cip%2Civ%2C%22%2F%3E%3Cparam+name=%22ext_xslt_tableId%22+value=%22historicalTable%22%2F%3E%3Cparam+name=%22app%22+value=%22%2Fshares%2Fhistorical_prices%22%2F%3E%3C%2Fpost%3E</body></html>
Well, please do se the modification I made to the code when I checked it again after a moment (1 h 7 min later) I had posted it.
PARSE VALUE rxURLRetrieve( 1, 'C...
I use FTE to edit the code as it support rexx syntax with highlightning, but I constantly forget to press ESC to deselect code before wokring with something else. The function name above was missing as I had accidently deleted it right before I copied it here. :-/
Ohh, by the way...
I wrote the cgi-bin script myself but have a problem I'd like your help with.
It's online and running, but as my web server fetch the data which it may take while to complete, especially the last part when it get the last bit of information. I know I can rewrite the code to be more smart and close as soon as a certain tag has been returned but I'd like to learn how to extend the transmission time for another project as well.
How do I make the connection stay alive so that the client web browser doesn't give up the wait before all data can be sent from my web server?
Links to the page that now let you look at stock data from NASDAQ OMX.
Volvo B (http://www.xn--lrka-loa.com/mail2/nasdaqomx?stockid=SSE366&fromdate=2012-07-04&todate=2012-09-03)
Assa Abloy B (http://www.xn--lrka-loa.com/mail2/nasdaqomx?stockid=SSE402&fromdate=2012-07-04&todate=2012-09-03)
SSAB B (http://www.xn--lrka-loa.com/mail2/nasdaqomx?stockid=SSE301&fromdate=2012-07-04&todate=2012-09-03)
etc.
Speed improvements applied to script on web server.
You should now get the data as soon as the data is available.
//Jan-Erik
/*
* Filename: nasdaqomx.cmd
* Author: JAN-ERIK
* Created: Tue Sep 4 2012
* Purpose: CGI-BIN script for web server to fetch historical stock data from NASDAQ OMX (Sweden)
* Changes:
*/
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
PARSE ARG argv
env = "OS2ENVIRONMENT"
argc = WORDS( argv )
/* The web server set some environment variables with information */
method = VALUE( "REQUEST_METHOD",, env )
len = VALUE( "CONTENT_LENGTH",, env )
stem = 'stem.'
/* Use the right method to read the information, GET is the most common */
IF method = 'GET' THEN
DO
query_string = VALUE( "QUERY_STRING",, env )
/* Parse data into variables */
Entries = ParseQueryString( query_string )
END
/* POST is not supported/untested here right now */
/*ELSE IF method = 'POST' & len \= '' THEN
DO
query_string = CHARIN( ,, len )
NF = ParseQueryString( query_string )
Entries = BreakDownInput( query_string, stem.Tag.1 )
END*/
/* Begin to write the html tags */
Say 'Connection: keep-alive'
Say
Say '<html>'||"0D0A"x||'<body>'
/* Set default values if the user leave one out */
stockid = 'SSE366'
fromdate = '2005-05-04'
todate = '2012-09-03'
/* Overwrite default values */
do i = 1 to Entries
CALL VALUE stem.Tag.i, stem.XVal.i
end
/* Initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
rc = SockLoadFuncs()
end
/* Split up the url into components */
CALL rxURLComponents 'host.1.', 'http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx'
/* Build the XML query */
vars = rxAddXMLTags( stockid, fromdate, todate )
rc = 0
/* xml query available? */
IF LENGTH( vars ) > 0 THEN
DO
/* Connect to host */
IF rxURLConnect() > -1 THEN
DO
/* Retrieve data from host, post (1) the data and append the data to post (Content-type....) */
retval = rxURLRetrieve( 1, 'Content-type: application/x-www-form-urlencoded; charset=UTF-8 '||"0D0A"x||'Content-length: '||LENGTH( vars )||"0D0A0D0A"x||vars )
IF retval < 0 THEN
DO
CALL CHAROUT , 'No data available.'
rc = 3
END
END
ELSE
DO
CALL CHAROUT , "An unknown error occured, couldn't connect to nasdaqomx to retrieve historical data.("||vars||")"
rc = 2
END
END
ELSE
DO
CALL CHAROUT , "An unknown error occured, xml tag builder error.("||vars||")"
rc = 1
END
Say '</body>'||"0D0A"x||'</html>'||"0D0A0D0A"x
RETURN rc
rxURLConnect: PROCEDURE EXPOSE host.
/* The following lines add new host to the array if you try to connect to several within the same script */
/* If none has been added before (host.0 is uninitialized) */
IF \DATATYPE( host.0, 'W' ) THEN
host.0 = 0
/* Add another */
j = host.0 + 1
/* Check if the host has been used already, then leave */
DO i = 1 TO host.0
IF TRANSLATE( host.i.location ) = TRANSLATE( host.j.location ) THEN LEAVE
END
/* If the host has not been added before, add it and check the ip-address (can take quite some time) */
IF i > host.0 THEN
DO
/* get dot address of host */
/* SAY 'Resolving ip address of "'host.i.location'"'*/
IF 1 <> SockGetHostByName( host.i.location, "host."i"." ) then
call error "Don't know who" host.i.location "is ... sorry"
END
ELSE
host.j.addr = host.i.addr
/* Set the number of unique hosts */
host.0 = j
i = j
/* Close the connection if already open but not closed */
IF SYMBOL( host.i.socket ) = 'VAR' THEN
rc = SockClose( host.i.socket )
/* SAY 'Connecting to 'host.i.addr*/
/* create socket */
host.i.socket = SockSocket( host.i.family, "SOCK_STREAM", 0 )
IF s < 0 then
call error "Error creating socket:" errno
/* SAY 'Connecting to 'host.i.location'/'host.i.path*/
/* connect it to the server */
rc = SockConnect( host.i.socket, "host."i"." )
if rc < 0 then
call error "Error connecting to" host.i.addr ":" errno
RETURN rc
/* Procedure to build and encode the xmlquery */
rxAddXMLTags: PROCEDURE
param.1 = 'SubSystem'
param.2 = 'Action'
param.3 = 'ApendIntraDay'
param.4 = 'Instrument'
param.5 = 'FromDate'
param.6 = 'ToDate'
param.7 = 'hi_a'
param.8 = 'ext_xslt'
param.9 = 'ext_xslt_options'
param.10 = 'ext_xslt_lang'
param.11 = 'ext_xslt_hiddenattrs'
param.12 = 'ext_xslt_tableId'
param.13 = 'app'
param.0 = 13
swe_date = DATE( 'S' )
val.1 = 'History'
val.2 = 'GetDataSeries'
val.3 = 'no'
val.4 = ARG(1) /* Stock ID */
IF LENGTH( ARG(2) ) > 0 THEN
val.5 = ARG(2) /* From Date */
ELSE
val.5 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-01' /* From Date ( First day of month ) */
IF LENGTH( ARG(3) ) > 0 THEN
val.6 = ARG(3) /* To Date */
ELSE
val.6 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-'||RIGHT( swe_date, 2 ) /* To Date ( Today ) */
val.7 = '0,1,2,4,21,8,10,11,12,9'
val.8 = '/nordicV3/hi_table_shares_adjusted.xsl'
val.9 = ',undefined,'
val.10 = 'en'
val.11 = ',ip,iv,'
val.12 = 'historicalTable'
val.13 = '/shares/historical_prices'
val.0 = 13
retval = ''
DO i = 1 TO param.0
retval = retval||'<param name="'||param.i||'" value="'||val.i||'"/>'
END
/* Replace ' ' (space) with + (plus) */
retval = TRANSLATE( 'xmlquery=<post>'||retval||'</post>', '+', ' ' )
/* Find characters to encode */
rest = SPACE( TRANSLATE( XRANGE(),, XRANGE( 0, 9 )||XRANGE( 'A', 'Z' )||XRANGE( 'a', 'z' )||'%_+=' ), 0 )
chstr = ''
/* Replace each special character with its hex value preceded by %, use the changestr-function to do it. */
DO i = i TO LENGTH( rest )
retval = CHANGESTR( SUBSTR( rest, i, 1 ), retval, '%'||C2X( SUBSTR( rest, i, 1 ) ) )
END
RETURN retval
/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle<, caselss>> */
IF TRACE() = '?I' THEN CALL TRACE 'O'
PARSE ARG needle, haystack, newneedle, caselss
new_haystack = ''
IF caselss = '' THEN
DO WHILE POS( needle, haystack ) > 0
PARSE VALUE haystack WITH pre(needle)haystack
new_haystack = new_haystack||pre||newneedle
END
ELSE DO
needle = TRANSLATE( needle )
strpos = POS( needle, TRANSLATE( haystack ) )
DO WHILE strpos > 0
IF strpos > 1 THEN
pre = LEFT( haystack, strpos - 1 )
ELSE pre = ''
haystack = SUBSTR( haystack, strpos + LENGTH( needle ) )
new_haystack = new_haystack||pre||newneedle
strpos = POS( needle, TRANSLATE( haystack ) )
END
END
RETURN new_haystack||haystack
rxURLRetrieve: PROCEDURE EXPOSE host. text
/* send message across ... loop in case entire message can't be sent in one SockSend() */
i = host.0
IF LENGTH( ARG(1) ) > 0 THEN
message = 'POST /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||ARG(2)||"0D0A0D0A"x
ELSE IF SYMBOL( 'host.'i'.cookie' ) = 'VAR' THEN
message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||'Cookie: '||host.i.cookie||"0D0A0D0A"x
ELSE
message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A0D0A"x
do while ( message <> "" )
bytes = SockSend( host.i.socket, message )
message = substr( message, bytes + 1 )
end
/* say date() time() ':' host.i.location 'contacted.'
text = ''*/
onoff = 0
IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
DO WHILE rc > -1 & chunk <> ''
rc = SockRecv( host.i.socket, 'chunk', 1000 )
IF POS( "0D0A0D0A"x, chunk ) > 0 THEN DO
PARSE VALUE chunk WITH ."0D0A0D0A"x chunk
onoff = 1
END
IF onoff = 1 THEN
CALL CHAROUT , chunk
/* test = text||chunk
CALL CHAROUT , '█'*/
IF POS( '</table>', chunk ) > 0 THEN LEAVE
END
/* IF LENGTH( text ) > 0 THEN
DO
SAY
SAY date() time() ':' host.i.location 'replied.'
END*/
/* wait for server to close the connection, then close our end */
rc = SockClose( host.i.socket )
DROP host.i.socket
RETURN rc /*text*/
rxURLComponents:
!_host_! = ARG(1)
CALL GetURLComponents ARG( 2 )
CALL VALUE !_host_!'scheme', host.scheme
CALL VALUE !_host_!'location', host.location
CALL VALUE !_host_!'port', host.port
CALL VALUE !_host_!'params', host.params
CALL VALUE !_host_!'query', host.query
CALL VALUE !_host_!'target', host.target
CALL VALUE !_host_!'file', host.file
CALL VALUE !_host_!'family', host.family
CALL VALUE !_host_!'path', host.path
RETURN
GetURLComponents: PROCEDURE EXPOSE host.
/* URL syntax consists of these components: */
/* <scheme>://<location>:<port>/<path><params>?<query>#<target> */
PARSE VALUE ARG( 1 ) WITH host.scheme '://' host.location '/' host.path
host.location = strip( host.location, 'L', '/' ) /* in case of scheme like "file:///" */
IF host.location = '' THEN
PARSE VALUE ARG( 1 ) WITH host.location '/' host.path
PARSE VALUE host.location WITH host.location ':' host.port
IF host.port = '' THEN
IF TRANSLATE( host.scheme ) = 'HTTP' then
host.port = 80
ELSE IF TRANSLATE( host.scheme ) = 'FTP' then
host.port = 21
PARSE VALUE host.path WITH host.file '' host.params '?' host.query '#' host.target
IF host.params = '' THEN
PARSE VALUE host.path WITH host.file '?' host.query '#' host.target
IF host.query = '' THEN
PARSE VALUE host.path WITH host.file '#' host.target
host.family = "AF_INET"
RETURN
GetURLComponent: PROCEDURE EXPOSE host.
IF LENGTH( ARG(1) ) > 0 THEN
CALL GetURLComponents ARG( 1 )
SELECT
WHEN TRANSLATE( ARG( 2 ) ) = 'S' THEN
RETURN host.scheme
WHEN TRANSLATE( ARG( 2 ) ) = 'H' THEN
RETURN host.location||':'||host.port
WHEN TRANSLATE( ARG( 2 ) ) = 'N' THEN
RETURN host.location
WHEN TRANSLATE( ARG( 2 ) ) = 'L' THEN
RETURN host.port
WHEN TRANSLATE( ARG( 2 ) ) = 'P' THEN
RETURN host.param
WHEN TRANSLATE( ARG( 2 ) ) = 'Q' THEN
RETURN host.query
WHEN TRANSLATE( ARG( 2 ) ) = 'T' THEN
RETURN host.target
WHEN TRANSLATE( ARG( 2 ) ) = 'F' THEN
RETURN FILESPEC( 'N', host.path )
OTHERWISE
RETURN host.path
END
/* print an error message */
error: procedure
say arg(1)
exit
/* Uppercase and return only A-Z and 0-9 */
rxCleanup: PROCEDURE
RETURN SPACE( TRANSLATE( TRANSLATE( ARG(1) ),, TRANSLATE( XRANGE(),, XRANGE( 'A', 'Z' )||XRANGE( '0', '9' ) ) ), 0 )
BreakDownInput: PROCEDURE EXPOSE (stem)
q_string = ARG(1)
delim = ARG(2)
newln = D2C(13)||D2C(10)
i = 0
IF LENGTH( delim ) > 0 THEN
DO WHILE POS( delim, q_string ) > 0
i = i + 1
PARSE VALUE q_string WITH .'"'t_name'"'t_var(delim)q_string
CALL VALUE stem'KeyVal.i', t_var
PARSE VALUE t_var WITH (newln)(newln)t_var(newln).
CALL VALUE stem'Tag.i', t_name
CALL VALUE stem'XVal.i', t_var
CALL VALUE stem''t_name, t_var
END
CALL VALUE stem'0', i
Return i
/* Do not modify below this line -- Important parsing code... */
ParseQueryString: PROCEDURE EXPOSE (stem)
PARSE ARG P
i = 0
DO WHILE ( ( P \= '' ) & ( i < 10 ) )
i = i + 1
PARSE VALUE P WITH txt '&' P
PARSE VALUE txt WITH tagval '=' kval
CALL VALUE stem'Text.i', txt
CALL VALUE stem'KeyVal.i', kval
CALL VALUE stem'Tag.i', tagval
CALL VALUE stem'XVal.i', DecodeKeyVal( kval )
END
RETURN i
/* Code from the test-cgi.cmd example SRE2003, SREHTTP/2 */
/************************************************/
/* procedure from TEST-CGI.CMD, modified by daniel hellerstein 12/97,
from code by Frankie Fan <kfan@netcom.com> 7/11/94 */
DecodeKeyVal: PROCEDURE
PARSE ARG Code
Text = ''
Code = TRANSLATE( Code, ' ', '+' )
rest = '%'
DO WHILE ( rest \= '' )
PARSE VAR Code T '%' rest
Text = Text || T
IF rest \= '' THEN
DO
ch = TRANSLATE( LEFT( rest, 2 ) )
IF VERIFY( ch,'01234567890ABCDEF' ) = 0 THEN
c = X2C( ch )
ELSE
c = ch
Text = Text || c
Code = SUBSTR( rest, 3 )
END
END
RETURN Text
/* Code from RExx Tips & Tricks 3.60 */
RXQUEUE: PROCEDURE
parse arg action, queue_name
/* init the return code (40 = incorrect call) */
rc = 40
currentQueue = ""
/* install local error handler */
SIGNAL ON SYNTAX NAME RxQueueError
SIGNAL ON FAILURE NAME RxQueueError
SIGNAL ON ERROR NAME RxQueueError
curAction = TRANSLATE( action )
curQueue = TRANSLATE( STRIP( queue_name ) )
SELECT
WHEN curAction = "QUERY" THEN
DO
IF curQueue <> '' THEN
DO
/* try to create the queue ... */
tempQueue = "RXQUEUE"( "CREATE", curQueue )
/* ... and delete the just created queue */
CALL "RXQUEUE" "DELETE", tempQueue
/* set the return code */
rc = ( tempQueue <> curQueue )
END
END
WHEN curAction = "TEST" THEN
DO
rc = 1
/* save the current queue name */
IF queue_name <> '' THEN
currentQueue = "RXQUEUE"( "SET", queue_name )
/* The current queue is restored a the end of the routine */
queue_teststring = "rxqueue test function"
queue queue_teststring
IF QUEUED() <> 0 THEN
DO
curString = LINEIN( 'QUEUE:' )
IF curString <> queue_testString THEN
QUEUE curString
ELSE
rc = 0
END
END
OTHERWISE
DO
/* call the original RXQUEUE function */
IF queue_name <> '' THEN
rc = "RXQUEUE"( action, queue_name )
ELSE
rc = "RXQUEUE"( action )
END
END
RxQueueError:
/* restore the current queue if necessary */
IF currentQueue <> '' THEN
CALL "RXQUEUE" 'set', currentQueue
RETURN rc