Example SQL Webservice - Receiving data from the Internet (WEB2IFSRPG)

**FREE
// -----------------------------------------------------------------

// Service - WEB2IFSRPG
// Function - This interface will be used to receive incoming connection
// for some incoming ORDER information. The incoming JSON
// payload will be written to IFS(/HOME/NICKLITTEN) for processing
// Author - Nick Litten (nick@nicklitten.com)
// -----------------------------------------------------------------
// Web Services Server Information
// { http://yoursystem:2001/HTTPAdmin/ }
//
// <*> PROJEX4I/MODLIBL JBA
//
// <*> CRTSQLRPGI OBJ(MYLIBRARY/WEB2IFSRPG) SRCFILE(MYLIBRARY/QRPGLESRC)
// <*> COMMIT(*NONE) OBJTYPE(*MODULE) DBGVIEW(*SOURCE)
//
// <*> CRTPGM PGM(MYLIBRARY/WEB2IFSRPG) MODULE(MYLIBRARY/WEB2IFSRPG)
// <*> BNDDIR(@PROJEX) ACTGRP(NICKLITTEN) OPTION(*DUPPROC)
//
// <*> DLTMOD WEB2IFSRPG

//
// -----------------------------------------------------------------
// Modification History:
// 2021-06-31 V1 Created
// -----------------------------------------------------------------
ctl-opt
  Main(process)
  pgminfo(*PCML:*MODULE:*DCLCASE)
  option(*srcstmt:*nodebugio:*noshowcpy)
  copyright('WEB2IFSRPG: Version 1.0 June 2021');

/define @YAJL
/copy projex4i/@copybook,@core

dcl-s webServiceName varchar(10);
dcl-s errmsg varchar(500) inz('');
dcl-s method varchar(10);
dcl-s payload_ifs varchar(5000);
dcl-c UPPER const('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
dcl-c LOWER const('abcdefghijklmnopqrstuvwxyz');

dcl-ds rtnCode_Template qualified template;
  success ind inz(*on);
  errorMsg varchar(500) inz('');
end-ds;

// Global Data Structure to webservice return codes
dcl-ds WEB2IFSRPG_RtnCode likeds(rtnCode_Template) inz(*likeds);


// -----------------------------------------------------------------
// PROCESS - Process the incoming webservice payload
// -----------------------------------------------------------------
Dcl-Proc process;
  Dcl-PI process;
  End-PI;

// Set SQL option, mainly to force cursor to close at endmodule
exec sql
  set option naming = *sys,
  commit = *none,
  usrprf = *user,
  dynusrprf = *user,
  datfmt = *iso,
  closqlcsr = *endmod;

// set the main JBA library list for the webservice to use
// we need the PROJEX3RD which includes the YAJL Tools
exec sql
  call qsys2.qcmdexc('projex4i/modlibl jba');

clear WEB2IFSRPG_RtnCode;

getInput( method: webServiceName: errmsg );

select;
when method = 'GET';
  WEB2IFSRPG_RtnCode.success = *off;
  WEB2IFSRPG_RtnCode.errorMsg = 'method(GET) is Invalid';
when method = 'PUT';
  WEB2IFSRPG_RtnCode.success = *off;
  WEB2IFSRPG_RtnCode.errorMsg = 'method(PUT) is invalid';
when method = 'POST';
  if loadInputJson (WEB2IFSRPG_RtnCode) = *on;
    WEB2IFSRPG_RtnCode.success = '1';
    WEB2IFSRPG_RtnCode.errorMsg = 'method(POST) success. ' +
                                  'JSON Stored in ' + payload_ifs;
  else;
    WEB2IFSRPG_RtnCode.errorMsg = 'FAIL loadInputJson: ' +
                                  %trim(WEB2IFSRPG_RtnCode.errorMsg);
  endif;
when method = 'DELETE';
  WEB2IFSRPG_RtnCode.success = *off;
  WEB2IFSRPG_RtnCode.errorMsg = 'method(DELETE) is invalid';
endsl;

sendResponse(WEB2IFSRPG_RtnCode);

End-Proc;


// -----------------------------------------------------------------
// loadInputJson() : If a PUT or POST was requested (write/update)
// load the customer record provided by the consumer
//
// my_IO = (i/o) info data structure.
//
// returns *ON if successful, *OFF otherwise
// -----------------------------------------------------------------
dcl-proc loadInputJson;

dcl-pi *n ind;
  my_IO likeds(rtnCode_Template);
end-pi;

dcl-s docNode like(yajl_val);
dcl-s node like(yajl_val);
dcl-s dataNode like(yajl_val);
dcl-s data like(yajl_val);
dcl-s addrNode like(yajl_val);
dcl-s errmsg varchar(500);
dcl-s i int(10);
dcl-s j int(10);
dcl-s field varchar(50);
dcl-s ifsdata varchar(5000);

dcl-s payload_path varchar(100) inz('/home/nicklitten/');

payload_ifs = payload_path + 'WEB2IFSRPG-new-' +
              %char(%timestamp()) + '.json';

// get the JSON document sent from the consumer and
// save to the IFS location
docNode = yajl_stdin_load_tree (*on: errmsg : payload_ifs);

if errmsg <> '';
  my_IO.errorMsg = 'json parse: ' + errmsg;
  my_IO.success = *off;
  return *off;
endif;

yajl_tree_free(docNode);
return *on;

end-proc;


// -----------------------------------------------------------------
// sendResponse() : Send the JSON response document
//
// cust = (input) customer information DS
//
// returns *ON if successful, *OFF otherwise.
// -----------------------------------------------------------------
dcl-proc sendResponse;

dcl-pi *n ind;
  cust likeds(rtnCode_Template) const;
end-pi;

dcl-s errmsg varchar(500) inz('');

yajl_genOpen(*on);
yajl_beginObj();

yajl_addBool('success': cust.success);
yajl_addChar('errorMsg': cust.errorMsg);

yajl_endObj();

if cust.success;
  yajl_writeStdout(200: errmsg);
else;
  yajl_writeStdout(500: errmsg);
endif;

yajl_genClose();

return (errmsg = '');

end-proc;


// -----------------------------------------------------------------
// getInput() : Retrieve the basic HTTP input for this call
//
// method = (output) HTTP method used (GET, POST, DELETE, PUT)
// webServiceName = (output) customer id, or 0 if none provided
// errmsg = (output) error message that occurred (if any)
//
// Returns *ON if successful, *OFF otherwise
// -----------------------------------------------------------------
dcl-proc getInput;
dcl-pi *n ind;
  method varchar(10);
  webServiceName varchar(10);
  errmsg varchar(500);
end-pi;

dcl-pr getenv pointer extproc(*dclcase);
  var pointer value options(*string);
end-pr;

dcl-s env pointer;
dcl-s url varchar(1000);

errmsg = '';
method = 'GET';
url = '';

// Retrieve the HTTP method.
// - Default to GET if not provided

env = getenv('REQUEST_METHOD');
if env <> *null;
  method = %xlate(LOWER: UPPER: %str(env));
endif;

// Retrieve the URL
// - Should always be provided!
env = getenv('REQUEST_URI');
if env = *null;
  errmsg = 'Unable to retrieve URL';
else;
  url = %xlate(UPPER: LOWER: %str(env));
endif;

return *on;

end-proc;