OS/2, eCS & ArcaOS - Technical > Programming
JSon to Rexx (stem)
Jan-Erik Lärka:
Hello,
couldn't hold back, had to write some rexx code to parse a JSon file.
I've tested and adjusted the code to handle variations to it, so it should be quite stable.
It should cope with incomplete input as well, but it will then return a non 0 value to indicate how far from complete the input is.
There are many services out there that pass data in JSon format.
--- Code: ---/*
* Filename: JSon2Rx.cmd
* Author: Jan-Erik
* Created: Sat Feb 23 2013
* Purpose: Interpret a JSon-file and place in stem
* Changes:
*/
IF ARG() > 0 THEN
IF STREAM( ARG(1), 'C', 'QUERY EXISTS' ) <> '' THEN
f_name = ARG(1)
ELSE
f_name = 'london.json'
ELSE
f_name = 'london.json'
IF STREAM( f_name, 'C', 'QUERY EXISTS' ) = '' THEN RETURN 1
f_size = STREAM( f_name, 'C', 'QUERY SIZE' )
f_input = CHARIN( f_name, 1, f_size )
CALL STREAM f_name, 'C', 'CLOSE'
stem = 'json.'
DO WHILE fromJSon( f_input ) > 0
CALL CHAROUT 'STDERR', 'Parts of the file missing! Press Enter to read it again. '
PARSE PULL
f_size = STREAM( f_name, 'C', 'QUERY SIZE' )
f_input = CHARIN( f_name, 1, f_size )
CALL STREAM f_name, 'C', 'CLOSE'
END
DO i = 1 TO json.0
SAY json.i '=' VALUE( json.i )
END
RETURN 0
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
/* Count the number of occurances of needle in haystack from start pos to end pos (whole string by default) */
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
IF TRACE() = '?I' THEN CALL TRACE 'O'
IF ARG() < 2 THEN RETURN -1
IF DATATYPE( ARG(3), 'W' ) THEN
next = ARG(3)
ELSE
next = 1
needle = ARG(1)
haystack = ARG(2)
IF DATATYPE( ARG(4), 'W' ) THEN
haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
next = 1
count = 0
DO WHILE next > 0
next = POS( needle, haystack, next )
IF next > 0 THEN DO
next = next + LENGTH( needle )
count = count + 1
END
END
RETURN count
--- End code ---
It's much easier to update a rexx script than a compiled application if they change something.
The rexx script should however pass the collected data to the desktop application.
Wouldn't mind to have a weather widget in eCS to show the weather and forecasts. OpenWeatherMap
I know there are additions to eCenter, but wouldn't mind something more than text.
Anyone feel up to write a eCenter/SysTray/Desktop widget with graphics?
I'd suggest to combine it with transparent png's to make it pleasant to use and look at!
//Jan-Erik
Jan-Erik Lärka:
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
--- Code: ---/*
* 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()
--- End code ---
Jan-Erik Lärka:
continued...
--- Code: ---
ReadWriteCfg: PROCEDURE EXPOSE (stem)
PARSE SOURCE . . this
PARSE VALUE REVERSE( this ) WITH .'.'this
this = REVERSE( this )||'.ini'
IF \DATATYPE( VALUE( stem'0' ), 'W' ) THEN
DO
retval = SysIni( this, TRANSLATE( STRIP( stem, 'T', '.' ) ), 'ALL:', TRANSLATE( STRIP( stem, 'T', '.' ) ) )
IF retval = '' THEN /* Read Cfg */
DO i = 1 TO VALUE( stem'0' )
CALL VALUE VALUE( stem''i ), SysIni( this, TRANSLATE( STRIP( stem, 'T', '.' ) ), VALUE( VALUE( stem''i ) ) )
END
END
IF DATATYPE( VALUE( stem'0' ), 'W' ) THEN
DO i = 1 TO VALUE( stem'0' )
PARSE VALUE REVERSE( VALUE( stem''i ) ) WITH tag'.'num'.'rest
tag = REVERSE( tag )
IF TRANSLATE( tag ) = 'NAME' THEN
tag = 'CITY'
ELSE IF DATATYPE( num, 'W' ) THEN
tag = REVERSE( num )||'.'||tag
IF TRANSLATE( VALUE( VALUE( stem''i ) ) ) <> 'NULL' & VALUE( VALUE( stem''i ) ) <> '' THEN
IF ARG(1) = 1 THEN /* Write Cfg */
CALL SysIni this, STRIP( stem, 'T', '.' ), stem''tag, VALUE( VALUE( stem''i ) )
ELSE
CALL VALUE stem''tag, VALUE( VALUE( stem''i ) )
END
RETURN ( retval = 'ERROR:' )
PreCfg: PROCEDURE EXPOSE (stem)
f_name = 'geo.cfg'
DO WHILE LINES( f_name ) > 0
PARSE VALUE LINEIN( f_name ) WITH tag_name' = 'tag_value
IF TRANSLATE( tag_value ) <> 'NULL' & tag_value <> '' THEN
CALL VALUE tag_name, tag_value
END
CALL STREAM f_name, 'C', 'CLOSE'
RETURN 0
/* Count the number of occurances of needle in haystack from start pos to end pos (whole string by default) */
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
IF TRACE() = '?I' THEN CALL TRACE 'O'
IF ARG() < 2 THEN RETURN -1
IF DATATYPE( ARG(3), 'W' ) THEN
next = ARG(3)
ELSE
next = 1
needle = ARG(1)
haystack = ARG(2)
IF DATATYPE( ARG(4), 'W' ) THEN
haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
next = 1
count = 0
DO WHILE next > 0
next = POS( needle, haystack, next )
IF next > 0 THEN DO
next = next + LENGTH( needle )
count = count + 1
END
END
RETURN count
UTF.I: procedure expose UTF. /* UTF-8 to local charset */
parse arg SRC ; DST = '' ; UTF.8 = UTF.8( arg( 2 ))
do while SRC <> ''
POS = verify( SRC, UTF.8 ) -1 ; if POS < 0 then leave
DST = DST || left( SRC, POS ) ; SRC = substr( SRC, POS + 1 )
POS = verify( x2b( c2x( left( SRC, 1 ))), 1 ) -1
if POS > 1 & POS < 7 then do /* C0..FD introduce 2-6 bytes */
TOP = left( SRC, POS ) ; SRC = substr( SRC, POS + 1 )
DST = DST || UTF.TOP /* surrogates implicitly bad, */
end /* C0..C1 are implicitly bad, */
else do /* 80..BF and FE..FF illegal: */
DST = DST || UTF.? ; SRC = substr( SRC, 2 )
end /* show error character UTF.? */
end
return DST || SRC
UTF.O: procedure expose UTF. /* local charset to UTF-8 */
parse arg SRC ; DST = '' ; UTF.8 = UTF.8( arg( 2 ))
do while SRC <> ''
POS = verify( SRC, UTF.8 ) -1 ; if POS < 0 then leave
DST = DST || left( SRC, POS ) ; SRC = substr( SRC, POS + 1 )
parse var SRC TOP 2 SRC ; DST = DST || UTF.TOP
end
return DST || SRC
UTF.8: procedure expose UTF. /* initialize Unicode table */
arg PAGE
select
when PAGE = value( 'UTF..' ) then nop
when PAGE = '' & symbol( 'UTF..' ) = 'VAR' then nop
otherwise
if symbol( 'UTF.?' ) = 'VAR' then T = UTF.?
else T = x2c( 1A )
drop UTF. ; UTF. = T /* SUB unknown char.s by 0x1A */
UTF.. = PAGE ; T = '' /* note actual codepage UTF.. */
select /* -------------------------- */
when PAGE = 437 then do /* US OEM DOS */
T = T ' C7 FC E9 E2 E4 E0 E5 E7' /* 80 */
T = T ' EA EB E8 EF EE EC C4 C5' /* 88 */
T = T ' C9 E6 C6 F4 F6 F2 FB F9' /* 90 */
T = T ' FF D6 DC A2 A3 A5 20A7 192' /* 98 */
T = T ' E1 ED F3 FA F1 D1 AA BA' /* A0 */
T = T ' BF 2310 AC BD BC A1 AB BB' /* A8 */
T = T '2591 2592 2593 2502 2524 2561 2562 2556' /* B0 */
T = T '2555 2563 2551 2557 255D 255C 255B 2510' /* B8 */
T = T '2514 2534 252C 251C 2500 253C 255E 255F' /* C0 */
T = T '255A 2554 2569 2566 2560 2550 256C 2567' /* C8 */
T = T '2568 2564 2565 2559 2558 2552 2553 256B' /* D0 */
T = T '256A 2518 250C 2588 2584 258C 2590 2580' /* D8 */
T = T ' 3B1 DF 393 3C0 3A3 3C3 B5 3C4' /* E0 */
T = T ' 3A6 398 3A9 3B4 221E 3C6 3B5 2229' /* E8 */
T = T '2261 B1 2265 2264 2320 2321 F7 2248' /* F0 */
T = T ' B0 2219 B7 221A 207F B2 25A0 A0' /* F8 */
end /* -------------------------- */
when PAGE = 858 | PAGE = 850 then do /* western DOS */
T = T ' C7 FC E9 E2 E4 E0 E5 E7' /* 80 */
T = T ' EA EB E8 EF EE EC C4 C5' /* 88 */
T = T ' C9 E6 C6 F4 F6 F2 FB F9' /* 90 */
T = T ' FF D6 DC F8 A3 D8 D7 192' /* 98 */
T = T ' E1 ED F3 FA F1 D1 AA BA' /* A0 */
T = T ' BF AE AC BD BC A1 AB BB' /* A8 */
T = T '2591 2592 2593 2502 2524 C1 C2 C0' /* B0 */
T = T ' A9 2563 2551 2557 255D A2 A5 2510' /* B8 */
T = T '2514 2534 252C 251C 2500 253C E3 C3' /* C0 */
T = T '255A 2554 2569 2566 2560 2550 256C A4' /* C8 */
T = T ' F0 D0 CA CB C8 20AC CD CE' /* D0 */
T = T ' CF 2518 250C 2588 2584 A6 CC 2580' /* D8 */
T = T ' D3 DF D4 D2 F5 D5 B5 FE' /* E0 */
T = T ' DE DA DB D9 FD DD AF B4' /* E8 */
T = T ' AD B1 2017 BE B6 A7 F7 B8' /* F0 */
T = T ' B0 A8 B7 B9 B3 B2 25A0 A0' /* F8 */
/* 0xD5 850: u+0131 small dotless i, 858: u+20AC Euro */
end /* -------------------------- */
when PAGE = 819 | PAGE = 28591 then do /* ISO 8859-1 */
do N = 128 to 255 ; T = T d2x( N ) ; end N /* 80-FF */
end /* -------------------------- */
when PAGE = 923 | PAGE = 28605 then do /* ISO 8859-15 */
do N = 128 to 159 ; T = T d2x( N ) ; end N /* 80-9F */
T = T ' A0 A1 A2 A3 20AC A5 160 A7' /* A0 */
T = T ' 161 A9 AA AB AC AD AE AF' /* A8 */
T = T ' B0 B1 B2 B3 17D B5 B6 B7' /* B0 */
T = T ' 17E B9 BA BB 152 153 178 BF' /* B8 */
do N = 192 to 255 ; T = T d2x( N ) ; end N /* C0-FF */
end /* -------------------------- */
when PAGE = 1252 | PAGE = 1004 then do /* OEM Latin-1 */
T = T '20AC 81 201A 192 201E 2026 2020 2021' /* 80 */
T = T ' 2C6 2030 160 2039 152 8D 17D 8F' /* 88 */
T = T ' 90 2018 2019 201C 201D 2022 2013 2014' /* 90 */
T = T ' 2DC 2122 161 203A 153 9D 17E 17F' /* 98 */
do N = 160 to 255 ; T = T d2x( N ) ; end N /* A0-FF */
end /* -------------------------- */
when PAGE = 878 then do /* KOI8-R (ibm-878) */
T = T '2500 2502 250C 2510 2514 2518 251C 2524' /* 80 */
T = T '252C 2534 253C 2580 2584 2588 258C 2590' /* 88 */
T = T '2591 2592 2593 2320 25A0 2219 221A 2248' /* 90 */
T = T '2264 2265 A0 2321 B0 B2 B7 F7' /* 98 */
T = T '2550 2551 2552 451 2553 2554 2555 2556' /* A0 */
T = T '2557 2558 2559 255A 255B 255C 255D 255E' /* A8 */
T = T '255F 2560 2561 401 2562 2563 2564 2565' /* B0 */
T = T '2566 2567 2568 2569 256A 256B 256C A9' /* B8 */
T = T ' 44E 430 431 446 434 435 444 433' /* C0 */
T = T ' 445 438 439 43A 43B 43C 43D 43E' /* C8 */
T = T ' 43F 44F 440 441 442 443 436 432' /* D0 */
T = T ' 44C 44B 437 448 44D 449 447 44A' /* D8 */
T = T ' 42E 410 411 426 414 415 424 413' /* E0 */
T = T ' 425 418 419 41A 41B 41C 41D 41E' /* E8 */
T = T ' 41F 42F 420 421 422 423 416 412' /* F0 */
T = T ' 42C 42B 417 428 42D 429 427 42A' /* F8 */
end /* -------------------------- */
when PAGE = '10000' then do /* MAC Roman */
T = T ' C4 C5 C7 C9 D1 D6 DC E1' /* 80 */
T = T ' E0 E2 E4 E3 E5 E7 E9 E8' /* 88 */
T = T ' EA EB ED EC EE EF F1 F3' /* 90 */
T = T ' F2 F4 F6 F5 FA F9 FB FC' /* 98 */
T = T '2020 B0 A2 A3 A7 2022 B6 DF' /* A0 */
T = T ' AE A9 2122 B4 A8 2260 C6 D8' /* A8 */
T = T '221E B1 2264 2265 A5 B5 2202 2211' /* B0 */
T = T '220F 3C0 222B AA BA 3A9 E6 F8' /* B8 */
T = T ' BF A1 AC 221A 192 2248 2206 AB' /* C0 */
T = T ' BB 2026 A0 C0 C3 D5 152 153' /* C8 */
T = T '2013 2014 201C 201D 2018 2019 F7 25CA' /* D0 */
T = T ' FF 178 2044 20AC 2039 203A FB01 FB02' /* D8 */
T = T '2021 B7 201A 201E 2030 C2 CA C1' /* E0 */
T = T ' CB C8 CD CE CF CC D3 D4' /* E8 */
T = T 'F8FF D2 DA DB D9 131 2C6 2DC' /* F0 */
T = T ' AF 2D8 2D9 2DA B8 2DD 2DB 2C7' /* F8 */
/* 0xBD old u+2126 Ohm : new u+03A9 Omega */
/* 0xDB old u+00A4 currency symbol : new u+20AC Euro */
/* 0xF0 old u+2665 black heart suit: new u+F8FF priv. */
end /* -------------------------- */
OTHERWISE NOP
end /* otherwise force REXX error */
do N = 128 to 255 /* table of UTF-8 characters: */
parse var T SRC T ; DST = ''
SRC = reverse( x2b( SRC )) /* scalar bits right to left */
do LEN = 2 until verify( substr( SRC, 8 - LEN ), 0 ) = 0
DST = DST || left( SRC, 6, 0 ) || '01'
SRC = substr( SRC, 7 ) /* encoded 6 bits of scalar */
end LEN /* remaining bits of scalar: */
DST = DST || left( SRC, 7 - LEN, 0 ) || 0
DST = x2c( b2x( reverse( DST || copies( 1, LEN ))))
SRC = d2c( N ) /* SRC: 1 byte (local char.) */
UTF.DST = SRC /* DST: 2 or more UTF-8 bytes */
UTF.SRC = DST /* excluding us-ascii 0..127 */
end N
end
return xrange( x2c( 0 ), x2c( 7F ))
TRAP: /* select REXX exception handler */
call trace 'O' ; trace N /* don't trace interactive */
parse source TRAP /* source on separate line */
TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */
TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' ))
select
when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
if condition( 'd' ) > '' /* need an additional line */
then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
TRAP = TRAP '(RC' rc || ')' /* any system error codes */
if condition( 'c' ) = 'FAILURE' then rc = -3
end
when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do
if condition( 'c' ) = 'HALT' then rc = 4
if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
if condition( 'd' ) <> errortext( rc ) then do
TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
TRAP = TRAP errortext( rc )
end /* future condition( 'd' ) */
end /* may use errortext( rc ) */
else TRAP = TRAP errortext( rc )
rc = -rc /* rc < 0: REXX error code */
end
when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */
when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */
otherwise /* force non-zero whole rc */
if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
if rc = 0 then rc = 1
if condition() = '' then TRAP = TRAP arg( 1 )
end /* direct: TRAP( message ) */
TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
signal on syntax name TRAP.SIGL /* throw syntax error 3... */
if 0 < sigl & sigl <= sourceline() /* if no handle for source */
then TRAP = TRAP '*-*' strip( sourceline( sigl ))
else TRAP = TRAP '+++ (source line unavailable)'
TRAP.SIGL: /* ...catch syntax error 3 */
if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc
end
select
when 0 then do /* in pipes STDERR: output */
parse version TRAP.REXX /* REXX/Personal: \dev\con */
if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ ,
6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR'
else TRAP.REXX = '\dev\con'
signal on syntax name TRAP.FAIL
call lineout TRAP.REXX , TRAP /* fails if no more handle */
end
when 0 then do /* OS/2 PM or ooREXX on NT */
signal on syntax name TRAP.FAIL
call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ ,
'Trap' time(),, 'ERROR'
end
otherwise say TRAP ; trace ?L /* interactive Label trace */
end
if condition() = 'SIGNAL' then signal TRAP.EXIT
TRAP.CALL: return rc /* continue after CALL ON */
TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */
TRAP.EXIT: exit rc /* exit for any SIGNAL ON */
--- End code ---
melf:
Hi Jan-Erik,
I'm not used to use Rexx, but anyway I pasted your code into a textfile "openweather.cmd" and executed... This rendered an ini-file which could be downloaded here, http://elfonnet.nu/pics/OPENWEATHER.INI . Seems to work well as far as I can see, but it seem to think I'm near Norrköping while I live in Gothenburg. Anyway this is exciting. Would be quite nice with a weather widget that also has a some graphics as you say.
Jan-Erik Lärka:
Thank you melf for you feedback!
Seems like Norrköping have clear weather and almost 4°C (277.05-273.15) as seen in "geo.temp"
while Gothenburg have clear weather and -3°C (270.02-273.15)
Please do try to delete the file and run the command:
OpenWeather geo CITY Goteborg
(yes without the dots over it) to set info for Gothenburg
You can then use just the command OpenWeather to update the info for Gothenburg.
The reason to why it found Norrköping and not Gothenburg may come from the fact that the service it use rely on information from your ISP I guess.
You can read the script and see what services it use... http://geoip.prototypeapp.com/api/locate tries to locate you and they state that it's in alpha stage. Another and perhaps better service would be smashing.
Hmm, OpenWeatherMap is a bit picky about the spelling of the city name.
//Jan-Erik
Navigation
[0] Message Index
[#] Next page
Go to full version