And here's the totally insane code to retrieve information about the weather and write it to a ini file that other apps can use. The script store the found information for later use in a file called OpenWeather.ini
Please do test the code to see if it work and report back to me. Be aware that cut and paste + line feed may cause problems you need to resolv first.
The current code expand the radius for the search area from 1 km to a maximum of 101 km in the current setup.
I think that should be sufficient!
Usage:
OpenWeather
Automatic mode, tries to determine your position on the globe and the nearest weather station available and then the nearest town, use the default name "geo"
OpenWeather mums_house COORDS 61.32 17.45
Tries to find the nearest weather station to the coordinates specified and name the entry "mums_house" in the ini-file
OpenWeather summerhouse CITY Barcelona
Name the entry in the ini-file "summerhouse" and find the current weather for Barcelona
OpenWeather mums_house
To refresh the data about weather for that entry
/*
* Filename: OpenWeather.cmd
* Author: Jan-Erik
* Created: Mon Feb 25 2013
* Purpose:
* Changes:
*/
/* initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
rc = SockLoadFuncs()
end
label = ''
stem = 'GEO.'
PARSE SOURCE . callType .
IF callType = "COMMAND" THEN
DO
label = SUBWORD( ARG(1), 1, 1 )
type = SUBWORD( ARG(1), 2, 1 )
param = SUBWORD( ARG(1), 3 )
END
ELSE IF ARG() > 1 THEN
PARSE VALUE ARG label, type, param
label = TRANSLATE( label )
type = TRANSLATE( type )
label = SPACE( TRANSLATE( label,, SPACE( TRANSLATE( XRANGE(),, XRANGE( 'A', 'Z' )||XRANGE( 0, 9 )||'_' ), 0 ) ), 0 )
IF LENGTH( label ) > 0 THEN
stem = label||'.'
IF type = 'COORDS' THEN
DO
CALL VALUE stem'LATITUDE' = SUBWORD( param, 1, 1 )
IF \DATATYPE( VALUE( stem'LATITUDE' ), 'N' ) THEN
CALL VALUE stem'LATITUDE', ''
CALL VALUE stem'LONGITUDE', SUBWORD( param, 2, 1 )
IF \DATATYPE( VALUE( stem'LONGITUDE' ), 'N' ) THEN
CALL VALUE stem'LONGITUDE', ''
END
ELSE IF type = 'CITY' THEN
CALL VALUE stem'CITY', param
ELSE IF type = 'COUNTRIES' THEN
RETURN rxLoadCountryCodes()
CALL PreCfg
reStart:
/* Split up the url into components */
DO WHILE rxConnect() > -1
/* Retrieve data from host */
IF rxURLRetrieve() < 0 THEN
SAY 'No data available.'
ELSE DO
PARSE VALUE text WITH .'{'text
text = '{'||text
IF fromJSon( text ) > 0 THEN CALL reStart
stem = stem||'.'
END
IF VALUE( stem'CITY' ) <> stem'CITY' & TRANSLATE( VALUE( stem'CITY' ) ) <> 'NULL' & VALUE( stem'CITY' ) <> '' THEN RETURN ReadWriteCfg( 1 )
IF type = 'COORDS' & DATATYPE( VALUE( stem'LAT' ), 'N' ) & DATATYPE( VALUE( stem'LON' ), 'N' ) THEN RETURN ReadWriteCfg( 1 )
END
RETURN 1
rxURLConnect: PROCEDURE EXPOSE (stem)
/* 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( VALUE( stem'host.0' ), 'W' ) THEN
CALL VALUE stem'host.0', 0
/* Make room for another */
j = VALUE( stem'host.0' ) + 1
/* Check if the host has been used already, then leave */
DO i = 1 TO VALUE( stem'host.0' )
IF TRANSLATE( VALUE( stem'host.'i'.location' ) ) = TRANSLATE( VALUE( stem'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 > VALUE( stem'host.0' ) THEN
DO
/* get dot address of host */
IF 1 <> SockGetHostByName( VALUE( stem'host.'i'.location' ), stem||"host."i"." ) THEN
CALL LINEOUT 'STDERR', VALUE( stem'host.'i'.location' )||" is unknown and can't be found."
END
ELSE
CALL VALUE stem'host.'j'.addr', VALUE( stem||'host.'i'.addr' )
/* Set the number of unique hosts */
CALL VALUE stem'host.0', j
i = j
/* Close the connection if already open but not closed */
IF SYMBOL( VALUE( stem'host.'i'.socket' ) ) = 'VAR' THEN
rc = SockClose( VALUE( stem'host.'i'.socket' ) )
/* Create socket */
CALL VALUE stem'host.'i'.socket', SockSocket( VALUE( stem'host.'i'.family' ), "SOCK_STREAM", 0 )
IF rc < 0 THEN
CALL LINEOUT 'STDERR', "Error creating socket: "||errno
/* Connect it to the server */
rc = SockConnect( VALUE( stem'host.'i'.socket' ), stem"host."i"." )
IF rc < 0 THEN
CALL LINEOUT 'STDERR', "Error connecting to "||VALUE( stem'host.'i'.addr' )" :"||errno
RETURN rc
rxURLRetrieve: PROCEDURE EXPOSE (stem) text output
/* send message across ... loop in case entire message can't be sent in one SockSend() */
i = VALUE( stem'host.0' )
message = 'T /'||VALUE( stem'host.'i'.path' )||' HTTP/1.1'||"0D0A"x||'Host: '||VALUE( stem'host.'i'.location' )
IF LENGTH( ARG(1) ) > 0 THEN
message = 'POS'||message||"0D0A"x||ARG(2)||"0D0A0D0A"x
ELSE IF SYMBOL( VALUE( stem'host.'i'.cookie' ) ) = 'VAR' THEN
message = 'GE'||message||"0D0A"x||'Cookie: '||VALUE( stem'host.'i'.cookie' )||"0D0A0D0A"x
ELSE
message = 'GE'||message||"0D0A0D0A"x
DO WHILE ( message <> "" )
bytes = SockSend( VALUE( stem'host.'i'.socket' ), message )
message = SUBSTR( message, bytes + 1 )
END
CALL LINEOUT 'STDERR', VALUE( stem'host.'i'.location' )||' contacted '||date()||' '||time()
text = ''
CALL SysSleep 0.5
onoff = 0
ret_len = 1000
IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
DO WHILE rc > -1 & chunk <> '' & LENGTH( text ) < ret_len
rc = SockRecv( VALUE( stem'host.'i'.socket' ), 'chunk', ret_len )
IF POS( 'CONTENT-LENGTH:', TRANSLATE( chunk ) ) > 0 THEN
PARSE UPPER VALUE chunk WITH ."CONTENT-LENGTH:" ret_len "0D0A"x
IF onoff = 0 THEN DO
PARSE VALUE chunk WITH ."0D0A0D0A"x chunk
onoff = 1
END
text = text||chunk
ret_len = STRIP( ret_len )
IF \DATATYPE( ret_len, 'W' ) THEN
ret_len = 1000
END
/* wait for server to close the connection, then close our end */
rc = SockClose( VALUE( stem'host.'i'.socket' ) )
INTERPRET 'DROP '||stem'host.'||i||'.socket'
RETURN rc /*text*/
rxURLComponents: PROCEDURE EXPOSE (stem)
CALL GetURLComponents ARG( 2 )
CALL VALUE ARG(1)'scheme', host.scheme
CALL VALUE ARG(1)'location', host.location
CALL VALUE ARG(1)'port', host.port
CALL VALUE ARG(1)'params', host.params
CALL VALUE ARG(1)'query', host.query
CALL VALUE ARG(1)'target', host.target
CALL VALUE ARG(1)'file', host.file
CALL VALUE ARG(1)'family', host.family
CALL VALUE ARG(1)'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
rxLoadCountryCodes:
IF SYMBOL( code.shrt ) <> 'LIT' | LENGTH( ARG(1) ) > 0 THEN
DO
country_code = 'cc.cfg'
DO WHILE LINES( country_code ) > 0
PARSE VALUE LINEIN( country_code ) WITH code.country','code.shrt';'code.long'#'code.num
END
PARSE VALUE VALUE( 'COUNTRY',, 'OS2ENVIRONMENT' ) WITH country_num';'.
IF DATATYPE( country_num, 'W' ) THEN RETURN code.num
END
RETURN
fromJSon: PROCEDURE EXPOSE (stem)
!_str_json_! = ARG(1)
!_stem_counter_! = 0
!_not_in_key_range_! = SPACE( TRANSLATE( XRANGE(),, XRANGE( 'a', 'z' )||XRANGE( 'A', 'Z' )||XRANGE( 0, 9 )||'_' ), 0 )
IF SYMBOL( stem ) <> 'LIT' THEN
stem = 'STEM'
stem = STRIP( TRANSLATE( stem ), 'T', '.' )
!_s_name_! = stem
DO WHILE LENGTH( !_str_json_! ) > 0
PARSE VALUE !_str_json_! WITH !_key_!':'!_str_json_!
IF POS( '{', STRIP( !_key_! ) ) = 1 THEN
DO
PARSE VALUE !_key_! WITH '{'!_key_!
!_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
END
CALL calc4Pos
IF !_strt_brkt_! < !_key_val_del_! & !_strt_brkt_! < !_end_brkt_! & 0 < !_strt_brkt_! THEN
DO
PARSE VALUE !_str_json_! WITH '{'!_str_json_!
!_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
IF !_strt_sqr_brkt_! < !_strt_brkt_! & 0 < !_strt_sqr_brkt_! THEN
DO
!_s_name_! = !_s_name_!'.'TRANSLATE( !_key_! )'.0'
IF POS( '.', !_s_name_! ) > 0 THEN
DO
PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
!_n_! = REVERSE( !_n_! )
!_s_name_! = REVERSE( !_s_name_! )
IF DATATYPE( !_n_!, 'W' ) THEN
DO
!_n_! = !_n_! + 1
CALL VALUE !_s_name_!'.0', !_n_!
END
!_s_name_! = !_s_name_!'.'!_n_!
END
ELSE
!_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
END
ELSE
!_s_name_! = !_s_name_!'.'STRIP( TRANSLATE( !_key_! ),, '"' )
ITERATE
END
!_stem_counter_! = !_stem_counter_! + 1
PARSE VALUE !_str_json_! WITH !_val_!','!_str_json_!
PARSE VALUE !_val_! WITH !_val_!'}'!_rest_!
!_key_! = SPACE( TRANSLATE( !_key_!,, !_not_in_key_range_! ), 0 )
IF POS( '"', !_val_! ) > 0 THEN
PARSE VALUE !_val_! WITH '"'!_val_!'"'
!_val_! = STRIP( STRIP( STRIP( STRIP( STRIP( STRIP( !_val_! ), 'T', D2C(10) ), 'T', D2C(13) ) ),, '"' ) )
CALL VALUE !_s_name_!'.'TRANSLATE( !_key_! ), !_val_!
CALL VALUE VALUE( stem )'.'!_stem_counter_!, !_s_name_!'.'TRANSLATE( !_key_! )
CALL VALUE VALUE( stem )'.0', !_stem_counter_!
IF ( !_end_brkt_! < !_key_val_sep_! | !_key_val_sep_! = 0 ) & ( !_end_brkt_! < !_end_sqr_brkt_! | !_end_sqr_brkt_! = 0 ) THEN
DO
!_n_! = ''
!_rest_! = '}'||SPACE( TRANSLATE( !_rest_!,, SPACE( TRANSLATE( XRANGE(),, '}]' ), 0 ) ), 0 )
DO WHILE LENGTH( !_rest_! ) > 0
PARSE VALUE !_rest_! WITH !_sign_! +1 !_rest_!
IF POS( '.', !_s_name_! ) > 0 THEN
DO
PARSE VALUE REVERSE( !_s_name_! ) WITH !_n_!'.'!_s_name_!
!_s_name_! = REVERSE( !_s_name_! )
!_n_! = REVERSE( !_n_! )
IF DATATYPE( !_n_!, 'W' ) & LEFT( !_rest_!, 1 ) <> ']' THEN
DO
!_n_! = !_n_! + 1
!_s_name_! = !_s_name_!'.'!_n_!
END
END
END
END
END
RETURN COUNTSTR( '.', !_s_name_! ) /* IF retval > 0 THEN INCOMPLETE FILE OR ERROR IN FUNCTION */
calc4Pos:
!_strt_sqr_brkt_! = POS( '[', !_str_json_! )
!_end_sqr_brkt_! = POS( ']', !_str_json_! )
!_strt_brkt_! = POS( '{', !_str_json_! )
!_end_brkt_! = POS( '}', !_str_json_! )
!_key_val_sep_! = POS( ',', !_str_json_! )
!_key_val_del_! = POS( ':', !_str_json_! )
RETURN 0
NLS2HTMLHEX:
retval = UTF.I( UTF.O( ARG(1), SysQueryProcessCodePage() ), 1004 )
chstr = SPACE( TRANSLATE( retval,, XRANGE( D2C(32), D2C(126) ) ), 0 )
DO i = 1 TO LENGTH( chstr )
retval = CHANGESTR( SUBSTR( chstr, i, 1 ), retval, '%C3%'||D2X( C2D( SUBSTR( chstr, i, 1 ) ) - 32 ) )
END
RETURN retval
/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle> */
IF TRACE() = '?I' THEN CALL TRACE 'O'
PARSE ARG needle, haystack, newneedle
new_haystack = ''
DO WHILE POS( needle, haystack ) > 0
PARSE VALUE haystack WITH pre(needle)haystack
new_haystack = new_haystack||pre||newneedle
END
RETURN new_haystack||haystack
rxConnect: PROCEDURE EXPOSE (stem)
CALL ReadWriteCfg
IF \DATATYPE( VALUE( stem'host.0' ), 'W' ) THEN
CALL VALUE stem'host.0', 0
IF VALUE( stem'CITY' ) <> TRANSLATE( stem'CITY' ) & TRANSLATE( VALUE( stem'CITY' ) ) <> 'NULL' & VALUE( stem'CITY' ) <> '' THEN
DO
IF VALUE( stem'COUNTRY_CODE' ) <> TRANSLATE( stem'COUNTRY_CODE' ) & TRANSLATE( VALUE( stem'COUNTRY_CODE' ) ) <> 'NULL' & VALUE( stem'COUNTRY_CODE' ) <> '' THEN
CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://api.openweathermap.org/data/2.1/find/name?q='||NLS2HTMLHEX( TRANSLATE( VALUE( stem'CITY' ) ) )||','||TRANSLATE( VALUE( stem'COUNTRY_CODE' ) )
ELSE
CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://api.openweathermap.org/data/2.1/find/name?q='||NLS2HTMLHEX( TRANSLATE( VALUE( stem'CITY' ) ) )
END
ELSE IF DATATYPE( VALUE( stem'LATITUDE' ), 'N' ) & DATATYPE( VALUE( stem'LONGITUDE' ), 'N' ) THEN
DO
IF DATATYPE( VALUE( stem'radius' ), 'W' ) THEN
CALL VALUE stem'radius', VALUE( stem'radius' ) + 10
ELSE
CALL VALUE stem'radius', 1
IF VALUE( stem'radius' ) < 102 THEN
CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://api.openweathermap.org/data/2.1/find/city?lat='||VALUE( stem'LATITUDE' )||'&lon='||VALUE( stem'LONGITUDE' )||'&radius='||VALUE( stem'radius' )
ELSE RETURN -1
END
ELSE
CALL rxURLComponents stem||'host.'||( VALUE( stem'host.0' ) + 1 )||'.', 'http://geoip.prototypeapp.com/api/locate'
RETURN rxURLConnect()