- DICTIONARY - PF
- CBROPTP - SQLTABL
- CBROPTR - SQLRPGLE
- JSON00R - RPGLE
1
*========================================================================** AUTHOR...........: *
* DATE.............: 2019-07-10 *
* OBJECT NAME......: DICTIONARY *
* DESCRIPTION......: DATA DICTIONARY *
* *
* AMENDMENTS: *
* DD.MM.YYYY NAME COMMENT WITH SHORTCODE *
* *
*========================================================================*
A R DICTION01
A*
A*===============================================================*
A* ALGEMEEN
A*===============================================================*
A COMPANYC 3S 0 TEXT('Company Code')
A COLHDG('Company' 'Code')
A ALIAS(COMPANY_CODE)
A EDTCDE(4)
A*
A*----------------------------------------------------------------
A*
A COMPANYD 30 TEXT('Company Desciption')
A COLHDG('Company' 'Description')
A ALIAS(COMPANY_DESCRIPTION)
A VARLEN
A*
A*----------------------------------------------------------------
A*
A BRANCHC 3S 0 TEXT('Branch Code')
A COLHDG('Branch' 'Code')
A ALIAS(BRANCH_CODE)
A EDTCDE(4)
A*
A*----------------------------------------------------------------
A*
A BRANCHD 30 TEXT('Branch Desciption')
A COLHDG('Branch' 'Description')
A ALIAS(BRANCH_DESCRIPTION)
A VARLEN
A*
A*----------------------------------------------------------------
A*
A USERC 4 TEXT('User Code')
A COLHDG('User' 'Code')
A ALIAS(USER_CODE)
A*
A*----------------------------------------------------------------
A*
A UNIQUENO 9S 0 TEXT('Unique Number')
A COLHDG('Unique' 'Number')
A ALIAS(UNIQUE_NUMBER)
A EDTCDE(4)
A*
A*----------------------------------------------------------------
A*
A ISODAT Z TEXT('ISO Date')
A COLHDG('ISO' 'Date')
A ALIAS(ISO_DATE)
A*
A*----------------------------------------------------------------
A*
A YESNO 1 TEXT('Y/N Flag')
A COLHDG('Y/N' 'Flag')
A ALIAS(YES_NO_FLAG)
A VALUES('Y' 'N')
A*
A*----------------------------------------------------------------
A*
A MESSAGE 256 TEXT('Message')
A COLHDG('Message')
A VARLEN
A*
A*----------------------------------------------------------------
A*
A RECSTAT 1 TEXT('Record Status')
A COLHDG('Record' 'Status')
A ALIAS(RECORD_STATUS)
A VALUES(' ' 'D')
A*
A*----------------------------------------------------------------
A*
A HOUR 2S TEXT('Hours In Day')
A COLHDG('Hours' 'In' 'Day')
A ALIAS(HOURS_IN_DAY)
A RANGE(0 24)
A*
A*----------------------------------------------------------------
A*
A MINUTE 2S TEXT('Minutes In Hour')
A COLHDG('Minutes' 'In' 'Hour')
A ALIAS(MINUTES_IN_HOUR)
A RANGE(0 60)
A*
A*----------------------------------------------------------------
A*
A EMAIL 50 TEXT('Email Address')
A COLHDG('Email' 'Address')
A ALIAS(EMAIL_ADDRESS)
A VARLEN
A*
A*----------------------------------------------------------------
A*
A PNAME 30 TEXT('Person Name')
A COLHDG('Person' 'Name')
A ALIAS(PERSON_NAME)
A VARLEN
A*
A*----------------------------------------------------------------
A*
A TELEPHONE 15S TEXT('Telphone Number')
A COLHDG('Telephone' 'Number')
A ALIAS(TELEPHONE_NUMBER)
A*
A*----------------------------------------------------------------
A*
A COUNTRYC 7S TEXT('Telephone Country Code')
A COLHDG('Telephone' 'Country' 'Code')
A ALIAS(TELEPHONE_COUNTRY_CODE)
A*
A*----------------------------------------------------------------
A*
A COUNTRYD 30 TEXT('Telephone Country +
A Description')
A COLHDG('Telephone' 'Country' +
A 'Description')
A ALIAS(TELEPHONE_COUNTRY_DESCRIPTION)
A VARLEN
2
-- RUNSQLSTM SRCFILE(DEVEC1/QSQLSRC) SRCMBR(CBROPTP)
CREATE TABLE DEVEC1."CBROptionsFile" for system name CBROPTP
-- DEFINE TABLE HERE
-- CREATE TABLE "CBROptionsFile" for system name CBROPTP
(
"CompanyCode" FOR COLUMN COMPANY,
"BranchCode" FOR COLUMN BRANCH,
"SLATime" FOR COLUMN SLAMIN,
"SLAPrewarnTime" FOR COLUMN SLAPRE,
"SendEmail" FOR COLUMN SNDMAIL,
"SendSMS" FOR COLUMN SNDSMS,
"DateCreated" FOR COLUMN DATCRT,
"CreatorUserID" FOR COLUMN CUID,
"DateDeleted" FOR COLUMN DATDLT,
"DeletorUserID" FOR COLUMN DUID,
"RecordStatus" FOR COLUMN RECSTAT
)
AS (SELECT
COMPANY,
BRANCH ,
MINUTES,
MINUTES,
YESNO,
YESNO,
ISODAT,
UID,
ISODAT,
UID,
RECSTAT
FROM DICTIONARY
)
WITH NO DATA
RCDFMT CBROPTPR
;
ALTER TABLE CBROPTP ADD CONSTRAINT CBROPTP_K1 PRIMARY KEY
(COMPANY,BRANCH,RECSTAT,DATCRT)
;
ALTER TABLE CBROPTP ADD CONSTRAINT CBROPTP_C1 CHECK
(SNDMAIL IN('Y','N'))
;
ALTER TABLE CBROPTP ADD CONSTRAINT CBROPTP_C2 CHECK
(SNDSMS IN('Y','N'))
;
ALTER TABLE CBROPTP ADD CONSTRAINT CBROPTP_C3 CHECK
(RECSTAT IN(' ','D'))
;
-- DEFINE LABELS HERE - TABLE
LABEL ON TABLE CBROPTP IS 'CBR Options File'
;
-- DEFINE COLUMN LABELS HERE
LABEL ON COLUMN CBROPTP (
SLAMIN TEXT IS 'SLA Time' ,
SLAPRE TEXT IS 'SLA Prewarn Time' ,
SNDMAIL TEXT IS 'Send Email' ,
DATCRT TEXT IS 'Date Created' ,
CUID TEXT IS 'Creator User ID' ,
DATDLT TEXT IS 'Date Deleted' ,
DUID TEXT IS 'Deletor User ID' ,
SNDSMS TEXT IS 'Send SMS'
);
LABEL ON COLUMN CBROPTP (
SLAMIN IS 'SLA Time',
SLAPRE IS 'SLA Prewarn Time',
SNDMAIL IS 'Send Email',
SNDSMS IS 'Send SMS',
DATCRT IS 'Date Created',
CUID IS 'Creator User ID',
DATDLT IS 'Date Deleted',
DUID IS 'Deletor User ID'
);
3
//=======================================================================
//= Author...........: Esteban Cabero =
//= Date.............: 2019/08/15 =
//= Description......: File CBROPTP API =
//= Program summary..: REST =
//= Before Compile...: CRTSQLRPGI OBJ(CBROPTR) OBJTYPE(*MODULE) =
//= RPGPPOPT(*LVL2) DBGVIEW(*SOURCE) =
//= =
//= CRTPGM PGM(CBROPTR) MODULE(CBROPTR JSON00R) =
//= BNDSRVPGM((YAJL) (YAJLR4) (QHTTPSVR/QZHBCGI)) =
//= ACTGRP(REST) =
//= Amendments: =
//= DD.MM.YYYY Name Comment with shortcode =
//= =
//=======================================================================
CTL-OPT COPYRIGHT('Test')
DATEDIT(*DMY)
DATFMT(*EUR.)
TIMFMT(*HMS:)
// DFTACTGRP(*NO) //
// ACTGRP(*NEW) //
OPTIMIZE(*NONE)
// USRPRF(*USER) //
TEXT(*SRCMBRTXT)
OPTION(*SRCSTMT)
BNDDIR('QC2LE')
BNDDIR('@SYSFUNC')
PGMINFO(*PCML: *MODULE)
BNDDIR('YAJL');
//=======================================================================
// D E C L A R E I N P U T P A R A M E T E R S =
//=======================================================================
DCL-PR CBROPTR EXTPGM('CBROPTR');
END-PR;
DCL-PI CBROPTR;
END-PI;
DCL-PR JSON00R EXTPGM;
ERRMSG VARCHAR(80);
METHOD VARCHAR(10);
API VARCHAR(10);
PARAMETER VARCHAR(1000);
END-PR;
DCL-PR EnvError;
END-PR;
DCL-PR GETRec;
FIELD LIKE(FILE_T.COMPANY) CONST;
DATA LIKEDS(DATA_T);
END-PR;
DCL-PR CreateJSON;
DATA LIKEDS(DATA_T) CONST;
JSONDATA LIKE(JSONBUF_T);
SUCCESS IND CONST;
END-PR;
DCL-PR PUTRec;
END-PR;
DCL-PR POSTRec;
END-PR;
DCL-PR DELETERec;
END-PR;
//===================================================================
/COPY YAJL_H
//===================================================================
// D E C L A R E D A T A S T R U C T U R E A R R A Y S =
//===================================================================
DCL-DS PARAMETER1;
PARAMETER2 VARCHAR(1000);
PARAMETER3 ZONED(3:0) OVERLAY(PARAMETER2:3);
END-DS;
DCL-DS FILE_T QUALIFIED TEMPLATE;
COMPANY ZONED(3:0);
BRANCH ZONED(3:0);
SLAMIN ZONED(3:0);
SLAPRE ZONED(3:0);
SNDMAIL CHAR(1);
SNDSMS CHAR(1);
DATCRT TIMESTAMP;
CUID CHAR(10);
DATDLT TIMESTAMP;
DUID CHAR(10);
RECSTAT CHAR(1);
END-DS;
DCL-DS DATA_T QUALIFIED TEMPLATE;
SUCCESS IND;
ERRMSG CHAR(80);
COUNT INT(10);
FILE1 LIKEDS(FILE_T) DIM(999);
FILE2 LIKEDS(FILE_T) DIM(999);
END-DS;
DCL-DS DATA LIKEDS(DATA_T);
DCL-DS FILE1 LIKEDS(FILE_T);
DCL-DS FILE2 LIKEDS(FILE_T);
//=====================================================================
// D E C L A R E V A R I A B L E S =
//=====================================================================
DCL-S ERRMSG VARCHAR(80) INZ(*Blanks);
DCL-S METHOD VARCHAR(10) INZ(*BLANKS);
DCL-S API VARCHAR(10) INZ('cbroptr');
DCL-S PARAMETER VARCHAR(1000) INZ(*BLANKS);
DCL-S FIELD LIKE(FILE_T.COMPANY);
DCL-S JSONBUF_T VARCHAR(200000) TEMPLATE;
DCL-S X INT(10);
DCL-S JSONBUF LIKE(JSONBUF_T);
DCL-S HEADER VARCHAR(500);
//=====================================================================
// M A I N F L O W O F P R O G R A M =
//=====================================================================
JSON00R(ERRMSG:METHOD:API:PARAMETER);
IF ERRMSG = *BLANKS;
// Environment error
MONITOR;
PARAMETER2 = PARAMETER;
FIELD = PARAMETER3;
ON-ERROR;
FIELD = 0;
ENDMON;
SELECT;
WHEN METHOD = 'GET';
// Code to retrieve record/s
GETRec(FIELD:DATA);
WHEN METHOD = 'PUT';
// Code to update a record (idempotent)
PUTRec();
WHEN METHOD = 'POST';
// Code to write a new record (non-idempotent)
POSTRec();
WHEN METHOD = 'DELETE';
DELETERec();
// Code to delete a record
ENDSL;
ELSE;
EnvError();
ENDIF;
CreateJSON(DATA:JSONBUF:DATA.SUCCESS);
*INLR = *ON;
RETURN;
//=====================================================================
// P R O S E D U R E S =
//=====================================================================
//---------------------------------------------------------------------
//-- Environment error
//---------------------------------------------------------------------
DCL-PROC EnvError;
DCL-PI EnvError;
END-PI;
DATA.SUCCESS = *OFF;
DATA.ERRMSG = ERRMSG;
DATA.COUNT = 0;
RETURN;
END-PROC;
//---------------------------------------------------------------------
//-- ReadData(): Read data into the data struct
//--
//-- FIELD = (input) the the record to read, or *Blanks
//-- for all records
//--
//-- Data = (output) the 'data' data structure that contains
//-- the data to be output
//---------------------------------------------------------------------
DCL-PROC GETRec;
DCL-PI GETRec;
FIELD LIKE(FILE_T.COMPANY) CONST;
DATA LIKEDS(DATA_T);
END-PI;
CLEAR DATA;
IF FIELD = 0;
EXEC SQL DECLARE FILE1 CURSOR FOR
SELECT COMPANY, BRANCH, SLAMIN, SLAPRE, SNDMAIL,
SNDSMS, DATCRT, CUID, DATDLT, DUID, RECSTAT
FROM CBROPTP
ORDER BY COMPANY;
EXEC SQL OPEN FILE1;
EXEC SQL FETCH NEXT FROM FILE1 INTO :FILE1;
ELSE;
EXEC SQL DECLARE FILE2 CURSOR FOR
SELECT COMPANY, BRANCH, SLAMIN, SLAPRE, SNDMAIL,
SNDSMS, DATCRT, CUID, DATDLT, DUID, RECSTAT
FROM CBROPTP
WHERE COMPANY = :FIELD;
EXEC SQL OPEN FILE2;
EXEC SQL FETCH NEXT FROM FILE2 INTO :FILE2;
ENDIF;
IF %SUBST(SQLSTT:1:2)='00' or %SUBST(SQLSTT:1:2)='01';
DATA.COUNT = 0;
DATA.SUCCESS = *ON;
ELSEIF %SUBST(SQLSTT:1:2) = '02';
DATA.SUCCESS = *OFF;
DATA.ERRMSG = 'No records found in option file CBROPTP';
ELSE;
DATA.SUCCESS = *OFF;
DATA.ERRMSG = 'SQL statement failed; see job log.';
ENDIF;
IF FIELD = 0;
DOW %SUBST(SQLSTT:1:2)='00' or %SUBST(SQLSTT:1:2)='01';
DATA.COUNT += 1;
EVAL-CORR DATA.FILE1(DATA.COUNT) = FILE1;
EXEC SQL FETCH NEXT FROM FILE1 INTO :FILE1;
ENDDO;
EXEC SQL CLOSE FILE1;
ELSE;
DOW %SUBST(SQLSTT:1:2)='00' or %SUBST(SQLSTT:1:2)='01';
DATA.COUNT += 1;
EVAL-CORR DATA.FILE1(DATA.COUNT) = FILE2;
EXEC SQL FETCH NEXT FROM FILE2 INTO :FILE2;
ENDDO;
EXEC SQL CLOSE FILE2;
ENDIF;
RETURN;
END-PROC;
//---------------------------------------------------------------------
//-- CreateJSON(): Transform the 'data' ds/array into JSON
//--
//-- data = (input) data struct with data to return
//-- jsonData = (output) the same data in JSON format
//--
//-- returns YAJL generator status
//---------------------------------------------------------------------
DCL-PROC CreateJSON;
DCL-PI CreateJSON;
DATA LIKEDS(DATA_T) CONST;
JSONDATA LIKE(JSONBUF_T);
SUCCESS IND CONST;
END-PI;
//-- Generated document is "pretty" for test (readable)
// YAJL_GENOPEN(*ON);
//-- Generated document is not "pretty" for live
//-- More efficient for the computer to process
YAJL_GENOPEN(*OFF);
YAJL_BEGINOBJ();
YAJL_addBool('SUCCESS': DATA.SUCCESS );
YAJL_addChar('ERRMSG': %TRIMR(DATA.ERRMSG));
YAJL_addNum('COUNT': %CHAR(DATA.COUNT) );
YAJL_beginArray('FILE1');
FOR X = 1 TO DATA.COUNT;
YAJL_beginObj();
YAJL_addNum
('CompanyCode' :%CHAR(DATA.FILE1(X).COMPANY));
YAJL_addNum
('BranchCode' :%CHAR(DATA.FILE1(X).BRANCH));
YAJL_addNum
('SLATime' :%CHAR(DATA.FILE1(X).SLAMIN));
YAJL_addNum
('SLAPrewarnTime':%CHAR(DATA.FILE1(X).SLAPRE));
YAJL_addChar
('SendEmail' :%TRIMR(DATA.FILE1(X).SNDMAIL));
YAJL_addChar
('SendSMS' :%TRIMR(DATA.FILE1(X).SNDSMS));
YAJL_addChar
// 10 long
// ('DateCreated' :%TRIMR(%CHAR(%DATE
// 26 long
('DateCreated' :%TRIMR(%CHAR(%TIMESTAMP
(DATA.FILE1(X).DATCRT):*ISO)));
YAJL_addChar
('CreatorUserID' :%CHAR(DATA.FILE1(X).CUID));
YAJL_addChar
('DateDeleted' :%TRIMR(%CHAR(%TIMESTAMP
(DATA.FILE1(X).DATDLT):*ISO)));
YAJL_addChar
('DeletorUserID' :%TRIMR(DATA.FILE1(X).DUID));
YAJL_addChar
('RecordStatus' :%TRIMR(DATA.FILE1(X).RECSTAT));
YAJL_endObj();
ENDFOR;
YAJL_endArray();
YAJL_endObj();
HEADER = 'Content-type: application/json; charset=utf-8';
IF DATA.SUCCESS;
yajl_writeStdout(200: HEADER);
ELSE;
yajl_writeStdout(500: HEADER);
ENDIF;
YAJL_genClose();
RETURN;
END-PROC;
//---------------------------------------------------------------------
DCL-PROC POSTRec;
DCL-PI POSTRec;
END-PI;
DATA.SUCCESS = *OFF;
DATA.ERRMSG = 'POST In Development';
DATA.COUNT = 0;
RETURN;
END-PROC;
//---------------------------------------------------------------------
DCL-PROC PUTRec;
DCL-PI PUTRec;
END-PI;
DATA.SUCCESS = *OFF;
DATA.ERRMSG = 'PUT In Development';
DATA.COUNT = 0;
RETURN;
END-PROC;
//---------------------------------------------------------------------
DCL-PROC DELETERec;
DCL-PI DELETERec;
END-PI;
DATA.SUCCESS = *OFF;
DATA.ERRMSG = 'DELETE In Development';
DATA.COUNT = 0;
RETURN;
END-PROC;
//---------------------------------------------------------------------
4
//=======================================================================//= Author...........: Esteban Cabero =
//= Date.............: 2019/08/15 =
//= Description......: JSON REST API Service =
//= Program summary..: REQUEST_METHOD =
//= REQUEST_URI =
//= Parameter Supplied in URL =
//= Before Compile...: CRTRPGMOD =
//= CRTPGM =
//= Amendments: =
//= DD.MM.YYYY Name Comment with shortcode =
//= =
//=======================================================================
CTL-OPT COPYRIGHT('TWK AGRI (PTY) LTD')
DATEDIT(*DMY)
DATFMT(*EUR.)
TIMFMT(*HMS:)
// DFTACTGRP(*NO) //
// ACTGRP(*NEW) //
OPTIMIZE(*NONE)
// USRPRF(*USER) //
TEXT(*SRCMBRTXT)
OPTION(*SRCSTMT);
//=======================================================================
// D E C L A R E I N P U T P A R A M E T E R S =
//=======================================================================
DCL-PR JSON00R EXTPGM('JSON00R');
ERRMSG VARCHAR(80);
METHOD VARCHAR(10);
APIA VARCHAR(10);
PARAMETER VARCHAR(1000);
END-PR;
DCL-PI JSON00R;
ERRMSG VARCHAR(80);
METHOD VARCHAR(10);
APIA VARCHAR(10);
PARAMETER VARCHAR(1000);
END-PI;
DCL-PR RequestMethod;
ERRMSG VARCHAR(80);
METHOD VARCHAR(10);
END-PR;
DCL-PR RequestURL;
ERRMSG VARCHAR(80);
END-PR;
DCL-PR GETENV POINTER EXTPROC('getenv');
VAR POINTER VALUE OPTIONS(*STRING);
END-PR;
DCL-PR GetParameter;
ERRMSG VARCHAR(80);
PARAMETER VARCHAR(1000);
END-PR;
/COPY CPYC00R
//=====================================================================
// D E C L A R E V A R I A B L E S =
//=====================================================================
DCL-S ENV POINTER;
DCL-S POS INT(10);
DCL-S URL VARCHAR(1000);
DCL-C APIB CONST('/rest/');
DCL-S APIC VARCHAR(17);
//=====================================================================
// M A I N F L O W O F P R O G R A M =
//=====================================================================
RequestMethod(ERRMSG:METHOD);
IF ERRMSG = *BLANKS;
RequestURL(ERRMSG);
IF ERRMSG = *BLANKS;
GetParameter(ERRMSG:PARAMETER);
ENDIF;
ENDIF;
*INLR = *ON;
RETURN;
//=====================================================================
// P R O S E D U R E S =
//=====================================================================
//---------------------------------------------------------------------
//-- The first thing the RPG program needs to know is -
//-- whether GET, PUT, POST or DELETE was used. -
//-- It can retrieve that by getting the -
//-- REQUEST_METHOD environment variable. -
//-- The IBM HTTP server will always set that -
//-- variabl to let us know which method was used. -
//---------------------------------------------------------------------
DCL-PROC RequestMethod;
DCL-PI RequestMethod;
ERRMSG VARCHAR(80);
METHOD VARCHAR(10);
END-PI;
ENV = GETENV('REQUEST_METHOD');
IF ENV <> *NULL;
METHOD = %XLATE(LOWERCASE: UPPERCASE: %STR(ENV));
ELSE;
ERRMSG = 'No Request Method';
METHOD = *BLANKS;
ENDIF;
END-PROC;
//---------------------------------------------------------------------
//-- The HTTP server provides the URL in an -
//-- environment variable named REQUEST_URI that is -
//-- to be retrieved -
//---------------------------------------------------------------------
DCL-PROC RequestURL;
DCL-PI RequestURL;
ERRMSG VARCHAR(80);
END-PI;
ENV = GETENV('REQUEST_URI');
IF ENV <> *NULL;
URL = %XLATE(UPPERCASE: LOWERCASE: %STR(ENV));
ELSE;
ERRMSG = 'No URL Provided by HTTP';
ENDIF;
END-PROC;
//---------------------------------------------------------------------
//-- Retrieve the parameter -
//---------------------------------------------------------------------
DCL-PROC GetParameter;
DCL-PI GetParameter;
ERRMSG VARCHAR(80);
PARAMETERE VARCHAR(1000);
END-PI;
MONITOR;
APIC = %TRIM(APIB) + %TRIM(APIA) + '/';
POS = %SCAN(APIC:URL) + %LEN(APIC);
ON-ERROR;
ERRMSG = 'Parameter Supplied has Error';
PARAMETER = *BLANKS;
ENDMON;
MONITOR;
PARAMETER = %SUBST(URL:POS);
ON-ERROR;
PARAMETER = *BLANKS;
ENDMON;
END-PROC;
No comments:
Post a Comment