1) CRTRPGMOD MODULE(JSON00R) SRCFILE(QRPGLESRC) DBGVIEW(*ALL)
2) CRTPGM PGM(JSON00R)
QRPGLESRC RPGLE JSON00R JSON REST API Service
12001221107211200122094157
//=======================================================================
//= 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 MODULE(JSON00R) SRCFILE(QRPGLESRC) =
//= DBGVIEW(*ALL) =
//= CRTPGM PGM(JSON00R) =
//= Amendments: =
//= DD.MM.YYYY Name Comment with shortcode =
//= =
//=======================================================================
CTL-OPT
DATEDIT(*DMY)
DATFMT(*EUR.)
TIMFMT(*HMS:)
OPTIMIZE(*NONE)
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;
//=====================================================================
// 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 URL1 VARCHAR(1000);
DCL-S URL2 VARCHAR(1000);
DCL-C APIB CONST('/REST/');
DCL-S APIC VARCHAR(17);
DCL-C LOWERCASE const('abcdefghijklmnopqrstuvwxyz');
DCL-C UPPERCASE const('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
//=====================================================================
// 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;
URL1 = %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) + '/';
APIC = %XLATE(UPPERCASE: LOWERCASE: APIC);
URL2 = %XLATE(UPPERCASE: LOWERCASE: %STR(ENV));
POS = %SCAN(APIC:URL2) + %LEN(APIC);
ON-ERROR;
ERRMSG = 'Parameter Supplied has Error';
PARAMETER = *BLANKS;
ENDMON;
MONITOR;
PARAMETER = %SUBST(URL1:POS);
ON-ERROR;
PARAMETER = *BLANKS;
ENDMON;
END-PROC;
No comments:
Post a Comment