|
The SQLRPGLE for List of Cities display
// ______________________________________________________________________
// __ _ _ __ __ _
// | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _
// | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' |
// |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_|
//
// 11/2019 booth@martinvt.com
// ______________________________________________________________________
// Web demo of Weather, Moscow, Kiev, London
// The sample OpenWeather API always returns the same response
// regardless of the input.
// ie Moscow, Kiev and London.
//
// ______________________________________________________________________
ctl-opt
copyright('(C) Copyright Booth Martin, 2019, All rights reserved.')
option(*nodebugio) dftactgrp(*no) actgrp(*new);
dcl-f WEBMOSCOWD workstn;
dcl-c cTrq x'30';
dcl-c SQL_NOT_EOF *OFF;
dcl-c SQL_EOF *ON;
dcl-s URL varchar(400);
dcl-c cURL 'http://api.openweathermap.org/data/2.5/weather?';
dcl-c cAPIKEY 'ac100566d03d8617ea3442864df88bfe';
dcl-s wCITYCODE varchar(12);
dcl-s response SQLTYPE(CLOB_LOCATOR);
dcl-s requestHeaders SQLTYPE(XML_LOCATOR);
// Reference fields for use where using SQLTYPE is not legal.
dcl-ds ref_t template qualified inz;
xmlLocator SQLTYPE(XML_LOCATOR);
end-ds;
// Extracted weather data.
dcl-ds json_data_t qualified template inz;
city varchar(128);
temp packed(5: 2);
id int(10);
main varchar(128);
desc varchar(1024);
end-ds;
dcl-ds json_data likeds(json_data_t);
dcl-s message varchar(1000);
dcl-ds *n PSDS;
USERID char(10) pos(358);
end-ds;
dcl-s wNdx zoned(3);
dcl-s wCmd varchar(1024);
// _______________________________________________________________________
// Mainline
// The immediately following /EXEC SQL set options is SQL's version of
// RPG's H Spec. It is never executed. Just used at compile time.
// MUST be in source code above any other exec SQL statements.
exec sql set option
Commit = *None,
SrtSeq = *LangIDShr; // allows sort & search with upper/lower
// _____________________________________________________________________
exsr GetHeading;
dow *inkc = *off;
exsr ChangeColors;
exsr GetWeather;
exfmt FMT01;
select;
when *inkc; // exit
when *inki; // show json in browser
exsr OpenURL;
other;
endsl;
enddo;
*inlr = *on;
// _____________________________________________________________________
// Mainline - end
// _____________________________________________________________________
// __ Fetch the Weather API __________________________________________
begsr GetWeather;
// Create the XML representation of the HTTP request headers.
requestHeaders = CreateHttpRequestHeaders();
URL =
'https://samples.openweathermap.org/data/2.5/group?'
+ 'id=524901,703448,2643743'
+ '&units=metric'
+ '&appid=b6907d289e10d714a6e88b30761fae22';
// + '&appid=ac100566d03d8617ea3442864df88bfe'; // my API
// Execute the webservice call.
exec sql
set :response = systools.httpgetclob(:URL, :requestHeaders);
CheckSqlState(SQLSTT);
// Create and open a cursor to parse the JSON response.
exec sql
declare JSON_CURSOR cursor for
select coalesce(CITY, ''),
coalesce(TEMP, 0),
coalesce(WEATHER_ID, 0),
coalesce(MAIN, ''),
coalesce(DESC, '')
from json_table(
:response,
'lax $.list[*]' -- Occurs once per city
columns(
CITY varchar(128) path '$.name',
TEMP dec(5, 2) path '$.main.temp',
nested path 'lax $.weather[*]'
columns(
WEATHER_ID integer path '$.id',
MAIN varchar(128) path '$.main',
DESC varchar(1024) path '$.description'
)
)
) as X;
exec sql open JSON_CURSOR;
CheckSqlState(SQLSTT);
wNdx = 0;
clear json_data;
dow wNdx < 3;
wNdx += 1;
exec sql fetch JSON_CURSOR into :json_data;
if json_data.city <> ' ';
message = 'The weather in ' + json_data.city + ' is '
+ %char(json_data.temp) + ' degrees centigrade and '
+ json_data.main + '!';
select;
when wNdx = 1;
S1LINE1 = message;
when wNdx = 2;
S1LINE2 = message;
when wNdx = 3;
S1LINE3 = message;
when wNdx = 4;
S1LINE4 = message;
when wNdx = 5;
S1LINE5 = message;
endsl;
endif;
enddo;
exec sql close JSON_CURSOR;
CheckSqlState(SQLSTT);
endsr;
// ____________________________________________________________________
// __ Open the .json data in a web page _____________________________
begsr OpenURL;
wCmd = 'STRPCO PCTA(*NO)';
monitor;
exec sql CALL QSYS2.QCMDEXC(:wCmd);
on-error;
endmon;
wCITYCODE = '524901';
wCmd = 'STRPCCMD PCCMD(''start '
+ cURL + 'id=' + wCITYCODE + '^&units=imperial^&appid='
+ cAPIKEY + ''') PAUSE(*NO)';
exec sql CALL QSYS2.QCMDEXC(:wCmd);
// Qcmd(wCmd: %len(wCmd));
endsr;
// _____________________________________________________________________
// __ Get & set the screen heading ____________________________________
begsr GetHeading;
HDG5X40 =
' _ __ __ -= ---Weather--- =-'
+ ' | | /| / /__ / / -= Moscow =-'
+ ' | |/ |/ / -_) _ \ -= Kiev =-'
+ ' |__/|__/\__/_.__/ -= London =-';
HDG7X23 =
' '
+ ' '
+ ' ,,, '
+ ' (O-O) '
+ ' ----oo0-(_)-0oo---- '
+ ' '
+ ' ';
exec SQL // Get user's name to display.
select CID.ODOBTX
into :S1USERNAME
from table( QSYS2/USERS() ) AS CID
where CID.ODOBNM = :USERID;
evalr S1USERNAME = 'with' + cTrq + %trim(S1USERNAME);
endsr;
// _____________________________________________________________________
// __ Change the headings colors _____________________________________
begsr ChangeColors;
select;
when *in61;
*in61 = *off;
*in62 = *on;
when *in62;
*in62 = *off;
*in63 = *on;
when *in63;
*in63 = *off;
*in64 = *on;
when *in64;
*in64 = *off;
*in65 = *on;
when *in65;
*in65 = *off;
*in66 = *on;
when *in66;
*in66 = *off;
*in67 = *on;
other;
*in67 = *off;
*in61 = *on;
endsl;
endsr;
// ____________________________________________________________________
// Check SQL state (DUMMY!)
// This would be replaced by a proper SQL exception testing procedure
// ____________________________________________________________________
dcl-proc CheckSqlState;
dcl-pi *N like(*IN);
sqlState like(SQLSTT) const;
end-pi;
dcl-s x int(5);
select;
when sqlState = '02000';
return SQL_EOF;
when sqlState = '00000';
return SQL_NOT_EOF;
other;
dsply 'Error!';
// Force a stupid error in lieu of sending a proper exception...
x = x / x;
return SQL_EOF;
endsl;
end-proc;
// ____________________________________________________________________
// Create HTTP request headers.
// Returns an ... element as required
// by the SQL webservice APIs
// We must accept a JSON response,
// so set "Accept" header accordingly.
// ____________________________________________________________________
dcl-proc CreateHttpRequestHeaders;
dcl-pi *N like(ref_t.xmlLocator);
end-pi;
dcl-s headers like(ref_t.xmlLocator);
exec sql
set :headers = xmlelement(
name "httpHeader",
xmlattributes(10000 as "connectTimeout",
'true' as "followRedirects"),
xmlelement(
name "header",
xmlattributes('application/json' as "Accept")
)
);
return headers;
end-proc;
// ____________________________________________________________________
|
The DSPL file for a List of Cities display
* _______________________________________________________________________
* ___ _ _ __ __ _ _
* | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _
* | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' |
* |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_|
*
* booth@martinvt.com
* _______________________________________________________________________
* Web demo of Weathger API, Moscow, Kiev, London
*
* _______________________________________________________________________
DSPSIZ(*DS3)
CHGINPDFT
ERRSFL
CA03 CA10
* _______________________________________________________________________
R FMT01 MOUBTN(*ULP ENTER)
1 2'System i'
2 2'WEBMOSCOW'
HDG5X40 200 B 1 13CNTFLD(40) CHGINPDFT
DSPATR(PR)
67 COLOR(GRN)
61 COLOR(PNK)
62 COLOR(TRQ)
63 COLOR(WHT)
64 COLOR(BLU)
65 COLOR(RED)
66 COLOR(YLW)
HDG7X23 161 B 1 56CNTFLD(23) CHGINPDFT
DSPATR(PR)
61 COLOR(GRN)
62 COLOR(PNK)
63 COLOR(TRQ)
64 COLOR(WHT)
65 COLOR(BLU)
66 COLOR(RED)
67 COLOR(YLW)
S1USERNAME 50 6 3COLOR(YLW)
* _______________________________________________________________________
S1HEADING 75 B 10 2DFTVAL('Weather:')
DSPATR(UL PR) COLOR(BLU)
S1LINE1 75 11 4
S1LINE2 75 12 4
S1LINE3 75 13 4
S1LINE4 75 14 4
S1LINE5 75 15 4
* _______________________________________________________________________
PB2 2Y 0B 23 3PSHBTNFLD((*GUTTER 2))
PSHBTNCHC(1 'Enter')
PSHBTNCHC(2 'Done' CA03)
PSHBTNCHC(3 'See .json F9' CA09)
CHCAVAIL((*COLOR PNK))
|
|
|