Newbie question creating web service

[BAndrewsRTC]

I'm writing my first web service, and I need to create a DIY service rather then IWS, because the request JSON will have arrays with like 100 fields per array element - I don't think IWS can support that gracefully (Please let me know if I'm wrong there). My plan is to create a big data structure with an embedded array and use data-into to parse the request into the data structure.

I'm having a surprising amount of trouble figuring out how to get the request JSON data from the HTTP server into the variable that I'll parse with data-into. In Scott's online PDF on this topic, I see the

uri =%str(getenv('REQUEST_URI'));

but from what I can tell, that's just being used to search the query string manually.

To get the request's JSON data into a variable, do I use some modification of the above?
Thanks!

[JonBoy]

I only have a couple of minutes so if this is wrong ....

Seems a bit unusual that you are creating a web service (as opposed to calling one) where you be receiving such a large volume of data but I guess this is for bulk data entry or something.

IWS can handle this kind of scenario - IBM include an example of handling the request body (which is where your data will be) on this page https://developer.ibm.com/tutorials/...vices-server1/ search for request body and you'll find the start point. The URI is only useful in this kind of case to extract the actual request type - such as large amount of data cannot be in the URI and would have to be in the request body - hence the recommendation to read that piece.

Doing it manually (as opposed to IWS) just means that you need to get hold of the request body. That wll be one large variable which you then parse with DATA-INTO.

[BAndrewsRTC]

I only have a couple of minutes so if this is wrong ....

Seems a bit unusual that you are creating a web service (as opposed to calling one) where you be receiving such a large volume of data but I guess this is for bulk data entry or something.

IWS can handle this kind of scenario - IBM include an example of handling the request body (which is where your data will be) on this page https://developer.ibm.com/tutorials/...vices-server1/ search for request body and you'll find the start point. The URI is only useful in this kind of case to extract the actual request type - such as large amount of data cannot be in the URI and would have to be in the request body - hence the recommendation to read that piece.

Doing it manually (as opposed to IWS) just means that you need to get hold of the request body. That wll be one large variable which you then parse with DATA-INTO.

Yes, it's for bulk data entry.

Thanks for the link. It seems to imply that arrays can be sent with a wrapper. I may circle back and try that if I run into trouble with the manual approach.

From what I can tell, the request data is obtained via the QTmhRdStIn API.

[Scott Klement]

Yes, you'd receive the request body from STDIN (calling the QtmhRdStIn is one way to do that.)

Alternately, you can use YAJL which already has code to read STDIN.

data-into result %DATA( '*STDIN'
                      : 'case=convert countprefix=num_')
                 %PARSER('YAJLINTO');

That basically reads JSON input from the request body and puts it straight into a data structure (called 'result' in this example.)

Here's a somewhat "deluxe" example. It's able to read either XML or JSON data. (And send back either XML or JSON as well.) It uses YAJL with DATA-INTO and DATA-GEN for the JSON work.

**FREE
//  PROVIDER: /api/customers REST API
//            This is intended to be a full CRUD service.
//                              Scott Klement, August, 2018
//
//   NOTE: This is a rest API provider.  CUST002R & CUST003R are the
//         corresponding consumer programs.
//
//   Can get a list of customers with GET to:
//      http://example.com/api/customers
//
//    Can GET, PUT, DELETE and specific customer
//       http://example.com/api/customers/1234
//
//    Can POST to create a new customer
//       http://example.com/api/customers
//
//    The customer record is sent/received over the network
//    in JSON representation like this:
//
//    {
//       "success": true,
//       "errorMsg": "Only used if success=false",
//       "data": {
//          "custno": 496,
//          "name": "Acme Foods",
//          "address": {
//             "street": "123 Main Street",
//             "city": "Boca Raton",
//             "state": "FL",
//             "postal": "12345-6789",
//          }
//       }
//    }
//
//    In the case of a list, the "data" element above will
//    be an array.
//
//    Or equivalent XML representation.
//
//    <cust success="true" errorMsg="Only if needed">
//      <data custno="496">
//        <name>Acme Foods</name>
//        <address>
//           <street>123 Main Street</street>
//           <city>Boca Raton</city>
//           <state>FL</state>
//           <postal>12345-6789</postal>
//        </address>
//      </data>
//    </cust>
//
//    In the case of a list, the "data" element above will
//    be repeated for each customer.
//
//  Before compiling:
//    - Install YAJL, put it in your *LIBL
//    - Create the CUSTFILE file (see the CUSTFILE member)
//    - Create the NEXTCUST data area
//      CRTDTAARA DTAARA(NEXTCUST) TYPE(*DEC) LEN(5 0) VALUE(1)
//
//  To compile:
//    *> CRTSQLRPGI CUST001R SRCFILE(QRPGLESRC) DBGVIEW(*SOURCE) -
//    *>            OBJTYPE(*MODULE) RPGPPOPT(*LVL2)
//    *> CRTPGM CUST001R MODULE(*PGM) BNDSRVPGM(QHTTPSVR/QZHBCGI) -
//    *>            ACTGRP(KLEMENT)
//
//  To install in Apache, add the following directives and restart:
//
//    DefaultFsCCSID 37
//    DefaultNetCCSID 1208
//    CgiConvMode %%MIXED/MIXED%%
//
//    ScriptAlias /api/customers /qsys.lib/skwebsrv.lib/cust001r.pgm
//
//    <Directory /qsys.lib/skwebsrv.lib>
//       SetEnv QIBM_CGI_LIBRARY_LIST "QTEMP;QGPL;SKLEMENT;SKWEBSRV;YAJL"
//       require valid-user
//       AuthType basic
//       AuthName "SK REST APIs"
//       PasswdFile %%SYSTEM%%
//       UserId %%CLIENT%%
//    </Directory>
//
// NOTE: In the above directives
//    1) Replace 37 with the proper CCSID for your environment.
//        (but do NOT use 65535 -- this is not a "real" CCSID)
//    2) Replace SKWEBSRV with your own library.

ctl-opt option(*srcstmt: *nodebugio: *noshowcpy);

dcl-pr QtmhWrStout extproc(*dclcase);
   DtaVar    pointer value;
   DtaVarLen int(10) const;
   ErrorCode char(32767) options(*varsize);
end-pr;

dcl-pr QtmhRdStin extproc(*dclcase);
   DtaVar     pointer value;
   DtaVarSize int(10) const;
   DtaLen     int(10);
   ErrorCod4  char(32767) options(*varsize);
end-pr;

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

dcl-ds ignore qualified;
   bytesProv int(10) inz(0);
   bytesAvail int(10) inz(0);
end-ds;

dcl-c UPPER const('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
dcl-c lower const('abcdefghijklmnopqrstuvwxyz');
dcl-c CRLF  const(x'0d25');

dcl-s NEXTCUST packed(5: 0) dtaara;

dcl-ds CUSTFILE extname('CUSTFILE') qualified end-ds;

dcl-ds cust_t qualified template;
   success  ind             inz(*on);
   errorMsg varchar(500)    inz('');
   dcl-ds data;
      custno packed(5: 0)   inz(0);
      name varchar(30)      inz('');
      dcl-ds address;
         street varchar(30) inz('');
         city   varchar(20) inz('');
         state  char(2)     inz('  ');
         postal varchar(10) inz('');
      end-ds;
   end-ds;
end-ds;

dcl-ds cust likeds(cust_t) inz(*likeds);

dcl-s custid packed(5: 0);
dcl-s errmsg varchar(500) inz('');
dcl-s method varchar(10);
dcl-s inputType varchar(4);
dcl-s outputType varchar(4);
dcl-s httpstatus packed(3: 0) inz(200);

exec SQL
   set option naming=*sys, commit=*none;

reset cust;

if getInput( method: custid: errmsg: httpstatus ) = *off;
   cust.success = *off;
   cust.errorMsg = errmsg;
   sendResponse(cust: httpstatus);
   return;
endif;

select;
when method = 'GET' and custid = 0;

   listCustomers();

when method = 'GET';

   loadDbRecord(custid: cust);
   sendResponse(cust: httpstatus);

when method = 'PUT';

   reset cust;
   if loadDbRecord(custid: cust) = *on;
      if loadInput(cust) = *on;
         cust.data.custno = custid;
         updateDbRecord(cust);
      endif;
   endif;

   sendResponse(cust:httpstatus);

when method = 'POST';

   reset cust;
   if loadInput(cust) = *on;
      writeDbRecord(cust);
   endif;

   sendResponse(cust:httpstatus);

when method = 'DELETE';

   if loadDbRecord(custid: cust) = *on;
      deleteDbRecord(cust);
   endif;

   sendResponse(cust:httpstatus);

endsl;

return;


// ------------------------------------------------------------------------
//   getInput():  Retrieve the basic HTTP input for this call
//
//      method = (output) HTTP method used (GET, POST, DELETE, PUT)
//      custid = (output) customer id, or 0 if none provided
//      errmsg = (output) error message that occurred (if any)
//  httpstatus = (output) HTTP status code of error
//
//   Returns *ON if successful, *OFF otherwise
// ------------------------------------------------------------------------

dcl-proc getInput;

   dcl-pi *n ind;
      method varchar(10);
      custid packed(5: 0);
      errmsg varchar(500);
      httpstatus packed(3: 0);
   end-pi;

   dcl-c REQUIRED_PART const('/api/customers/');

   dcl-s env pointer;
   dcl-s pos int(10);
   dcl-s custpart varchar(50);
   dcl-s url varchar(1000);
   dcl-s tempStr varchar(256);

   errMsg = '';
   method = 'GET';
   url    = '';
   httpstatus = 200;  // success

   // ------------------------------------------------------
   // Retrieve the HTTP method.
   // ------------------------------------------------------

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

   if    method <> 'GET'
     and method <> 'PUT'
     and method <> 'POST'
     and method <> 'DELETE';
     httpstatus = 405;
     errMsg = 'Method not allowed';
     return *off;
   endif;

   // ------------------------------------------------------
   //  Retrieve the URI
   // ------------------------------------------------------

   env = getenv('REQUEST_URI');
   if env = *null;
      errMsg = 'Bad Request';
      httpstatus = 400;
      return *off;
   else;
      url = %xlate(UPPER: lower: %str(env));
   endif;

   // ------------------------------------------------------
   //  CONTENT_TYPE is the media type we receive, and
   //  HTTP_ACCEPT is the media type to send back.
   //
   //  We accept these:
   //    application/json = json document
   //    application/xml  = xml document (newer media type)
   //    text/xml         = xml document (older media type)
   // ------------------------------------------------------
   inputType = 'json';

   env = getenv('CONTENT_TYPE');
   if env <> *null and (method='PUT' or method='POST');
      tempStr = %xlate(UPPER: lower: %str(env));
      if %scan('application/json': tempStr) > 0;
        inputType = 'json';
      elseif %scan('application/xml' : tempStr) > 0
          or %scan('text/xml'        : tempStr) > 0;
        inputType = 'xml';
      else;
        httpstatus =  415;
        errMsg = 'Unsupported Media Type';
        return *off;
      endif;
   endif;

   outputType = inputType;
   env = getenv('HTTP_ACCEPT');
   if env <> *null;
      tempStr = %xlate(UPPER: lower: %str(env));
      if %scan('application/json': tempStr) > 0;
        outputType = 'json';
      elseif %scan('application/xml' : tempStr) > 0
          or %scan('text/xml'        : tempStr) > 0;
        outputType = 'xml';
      else;
        httpstatus = 406;
        errMsg = 'Unable to respond in that media type';
        return *off;
      endif;
   endif;

   // ------------------------------------------------------
   //   Extract the customer ID from the URL.
   //    - if not provided, set to 0
   //    - should always be provided for PUT/POST/DELETE
   // ------------------------------------------------------

   monitor;
      pos = %scan(REQUIRED_PART:url) + %len(REQUIRED_PART);
      custpart = %subst(url: pos);
      custid = %int(custpart);
   on-error;
      custid = 0;
   endmon;

   if custid = 0 and method <> 'GET' and method <> 'POST';
      errMsg = 'You must supply a customer ID!';
      httpstatus = 404;
      return *off;
   endif;

   return *on;

end-proc;


// ------------------------------------------------------------------------
//   loadDbRecord():  Load customer database record
//
//   custid = (input) customer number to retrieve
//     cust = (output) customer record
//
//   returns *on if record loaded, *off otherwise
// ------------------------------------------------------------------------

dcl-proc loadDbRecord;

   dcl-pi *n ind;
      custid packed(5: 0) const;
      cust   likeds(cust_t);
   end-pi;

   dcl-ds Rec extname('CUSTFILE') qualified end-ds;

   exec SQL
     select *
       into :Rec
       from CUSTFILE
      where custno = :custid;

   if %subst(sqlstt:1:2) <> '00' and %subst(sqlstt:1:2) <> '01';
      cust.success = *off;
      cust.errorMsg = 'Customer not found!';
      httpstatus = 404;
      return *off;
   endif;

   cust.data.custno = rec.custno;
   cust.data.name   = rec.name;

   cust.data.address.street = rec.street;
   cust.data.address.city   = rec.city;
   cust.data.address.state  = rec.state;
   cust.data.address.postal = rec.postal;

   return *on;

end-proc;


// ------------------------------------------------------------------------
//  updateDbRecord():  Updates an existing customer record
//
//    cust = (i/o) customer information DS
//
//  returns *ON if successful, *OFF otherwise.
// ------------------------------------------------------------------------

dcl-proc updateDbRecord;

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

   dcl-ds rec extname('CUSTFILE') qualified end-ds;

   rec.name   = cust.data.name;
   rec.custno = cust.data.custno;
   rec.street = cust.data.address.street;
   rec.city   = cust.data.address.city;
   rec.state  = cust.data.address.state;
   rec.postal = cust.data.address.postal;

   exec SQL
     update CUSTFILE
       set
          name   = :rec.Name,
          street = :rec.Street,
          city   = :rec.City,
          state  = :rec.state,
          postal = :rec.postal
       where
          custno = :rec.CustNo;

   if %subst(sqlstt:1:2)<>'00' and %subst(sqlstt:1:2)<>'01';
      cust.success = *off;
      cust.errorMsg = 'SQL State ' + sqlstt + ' updating CUSTFILE';
      httpstatus = 500;
   endif;

   return cust.success;
end-proc;


// ------------------------------------------------------------------------
//  getNextCustno(): Gets the next available customer number from
//                   the data area.
//
//  For this to work, the NEXTCUST data area must exist. If you don't have
//  it, create it with:
//
//     CRTDTAARA DTAARA(your-lib/NEXTCUST) TYPE(*DEC) LEN(5 0) VALUE(1)
//
//  returns the next custno, or 0 upon failure
// ------------------------------------------------------------------------

dcl-proc getNextCustno;

   dcl-pi *n packed(5: 0);
   end-pi;

   dcl-s newCust packed(5: 0);

   monitor;

      in *lock NEXTCUST;

      newCust = NEXTCUST;

      if NEXTCUST = *hival;
         NEXTCUST = 1;
      else;
         NEXTCUST += 1;
      endif;

      out NEXTCUST;

   on-error;
      return 0;
   endmon;

   return newCust;

end-proc;


// ------------------------------------------------------------------------
//  writeDbRecord():  Creates a new customer record
//
//    cust = (i/o) customer information DS
//
//  returns *ON if successful, *OFF otherwise.
// ------------------------------------------------------------------------

dcl-proc writeDbRecord;

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

   dcl-ds Rec extname('CUSTFILE') qualified end-ds;

   cust.data.custno = getNextCustno();
   if cust.data.custno = 0;
      cust.success = *off;
      cust.errorMsg = 'Unable to get next available customer number';
      httpstatus = 500;
      return *off;
   endif;

   eval-corr rec = cust.data;
   eval-corr rec = cust.data.address;

   exec SQL
     insert into CUSTFILE
       (custno, name, street, city, state, postal)
       values( :rec.custno, :rec.name,
               :rec.street, :rec.city,
               :rec.state,  :rec.postal );

   if %subst(sqlstt:1:2)<>'00' and %subst(sqlstt:1:2)<>'01';
      cust.success = *off;
      cust.errorMsg = 'SQL State ' + sqlstt + ' writing CUSTFILE';
      httpstatus = 500;
   endif;

   return cust.success;
end-proc;


// ------------------------------------------------------------------------
//  deleteDbRecord():  Deletes the customer record if it exists
//
//    cust = (i/o) customer information DS
//
//  returns *ON if successful, *OFF otherwise.
// ------------------------------------------------------------------------

dcl-proc deleteDbRecord;

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

   dcl-s custid packed(5: 0);

   custid = cust.data.custno;

   exec SQL
     delete from CUSTFILE
       where custno = :custid;

   if %subst(sqlstt:1:2) <> '00' and %subst(sqlstt:1:2) <> '01';
      cust.success = *off;
      cust.errorMsg = 'SQL state ' + sqlstt + ' deleting customer';
      httpstatus = 500;
   endif;

   return cust.success;

end-proc;


// ------------------------------------------------------------------------
//  loadInput():  If a PUT or POST was requested (write/update)
//                load the customer record provided by the consumer
//
//  NOTE: This routine replaces data in the structure with that provided
//        by the caller. But, if the caller does not provide a given
//        field, it is left as-is.
//
//     cust = (i/o) customer info data structure.
//
//  returns *ON if successful, *OFF otherwise
// ------------------------------------------------------------------------

dcl-proc loadInput;

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

   if inputType = 'xml';
     return loadInputXml(cust);
   else;
     return loadInputJson(cust);
   endif;

end-proc;


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

dcl-proc sendResponse;

   dcl-pi *n ind;
      cust likeds(cust_t) const;
      httpStatus packed(3: 0) value;
   end-pi;

   if outputType = 'xml';
     return sendResponseXml(cust: httpStatus);
   else;
     return sendResponseJson(cust: httpStatus);
   endif;

end-proc;


// ------------------------------------------------------------------------
//   Provide list of all customers (called when GET without any custno)
//
//   NOTE: Output is written directly to consumer
//
//   Returns *ON if successful, *OFF otherwise.
// ------------------------------------------------------------------------

dcl-proc listCustomers;

   dcl-pi *n ind;
   end-pi;

   if outputType = 'xml';
     return listCustomersXml();
   else;
     return listCustomersJson();
   endif;

end-proc;


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

dcl-proc loadInputJson;

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

   dcl-s loaded ind inz(*off);

   //--------------------------------------------------
   //  get the JSON document sent from the consumer
   //--------------------------------------------------
   monitor;
      data-into cust %DATA( '*STDIN'
                          : 'case=convert +
                             allowmissing=yes')
                     %PARSER('YAJLINTO');
      loaded = *on;
   on-error;
      httpstatus = 400;
      loaded = *off;
   endmon;

   return loaded;

end-proc;


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

dcl-proc sendResponseJson;

   dcl-pi *n ind;
      cust likeds(cust_t) const;
      httpStatus packed(3: 0) value;
   end-pi;

   dcl-s success ind inz(*on);
   dcl-s responseJson varchar(100000);

   monitor;
      data-gen cust
               %data(responseJson)
               %gen( 'YAJLDTAGEN'
                   : '{ +
                        "write to stdout": true, +
                        "http status": ' + %char(httpstatus) +
                     '}' );
   on-error;
     httpstatus = 500;
     success = *off;
   endmon;

   return success;

end-proc;


// ------------------------------------------------------------------------
//   Provide list of all customers (called when GET without any custno)
//
//   NOTE: Output is written directly to consumer
//
//   Returns *ON if successful, *OFF otherwise.
// ------------------------------------------------------------------------

dcl-proc listCustomersJson;

   dcl-pi *n ind;
   end-pi;

   dcl-ds response qualified;
     success ind;
     errorMsg varchar(500);
     num_data int(10);
     dcl-ds data dim(999);
        custno packed(5: 0)   inz(0);
        name varchar(30)      inz('');
        dcl-ds address;
           street varchar(30) inz('');
           city   varchar(20) inz('');
           state  char(2)     inz('  ');
           postal varchar(10) inz('');
        end-ds;
     end-ds;
   end-ds;

   dcl-s x int(10);
   dcl-s responseJson varchar(100000);

   dcl-ds CUSTLIST qualified;
      custno like(CUSTFILE.custno);
      name   like(CUSTFILE.name);
      street like(CUSTFILE.street);
      city   like(CUSTFILE.city);
      state  like(CUSTFILE.state);
      postal like(CUSTFILE.postal);
   end-ds;

   exec SQL declare custlist cursor for
     select custno, name, street, city, state, postal
       from custfile
      order by custno;

   exec SQL open custlist;
   exec SQL fetch next from custlist into :CUSTLIST;

   response.success   = *on;
   response.errormsg  = '';
   response.num_data = 0;
   x = 0;

   if %subst(sqlstt:1:2) <> '00' and %subst(sqlstt:1:2) <> '01';
      response.success = *off;
      response.errorMsg = 'SQL State ' + sqlstt + ' querying customer list';
      httpstatus = 500;
   endif;

   dow response.success = *on
       and (%subst(sqlstt:1:2)='00' or %subst(sqlstt:1:2)='01');

      x += 1;
      response.num_data = x;
      response.data(x).custno         = custlist.custno;
      response.data(x).name           = %trim(custlist.name);
      response.data(x).address.street = %trim(custlist.street);
      response.data(x).address.city   = %trim(custlist.city);
      response.data(x).address.state  = %trim(custlist.state);
      response.data(x).address.postal = %trim(custlist.postal);

      exec SQL fetch next from custlist into :CUSTLIST;
   enddo;

   exec SQL close custlist;

   monitor;
      data-gen response
               %data(responseJson: 'countprefix=num_')
               %gen( 'YAJLDTAGEN'
                   : '{ +
                        "write to stdout": true +
                      }' );
   on-error;
     response.success = *off;
     httpstatus = 500;
   endmon;

   return response.success;

end-proc;


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

dcl-proc loadInputXml;

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

   dcl-s myXml sqltype(CLOB: 100000);
   dcl-s success varchar(5) inz('true');
   dcl-s errMsg  varchar(500);
   dcl-s RcvLen int(10);
   dcl-c MISSING -1;
   dcl-s start  int(10);

   dcl-ds Result qualified;
     custno like(CUSTFILE.custno);
     name   like(CUSTFILE.name);
     street like(CUSTFILE.street);
     city   like(CUSTFILE.city);
     state  like(CUSTFILE.state);
     postal like(CUSTFILE.postal);
   end-ds;

   dcl-ds Status qualified inz;
     custno int(5);
     name   int(5);
     street int(5);
     city   int(5);
     state  int(5);
     postal int(5);
     NullInds int(5) dim(6) pos(1);
   end-ds;

   QtmhRdStin( %addr(myXml_data)
             : %size(myXml_data)
             : RcvLen
             : ignore );

   myXml_len = RcvLen;


   // If document starts with something like <?xml encoding="UTF-8"?>
   // then strip it.
   //
   //   reason: Apache has translated the document, so
   //           the encoding won't match and XMLPARSE will
   //           give an error.  Removing it bypasses
   //           this problem.

   if %subst(myXml_data:1:5) = '<?xml';
     start = %scan('?>': myXml_data) + %len('?>');
     myXml_data = %subst(myXml_data:start);
     myXml_len -= (start - 1);
   endif;

   exec SQL
     select ifnull(success, 'null'), ifnull(errorMsg, '')
       into :success, :errMsg
       from xmltable(
         '$doc/cust'
         passing xmlparse( DOCUMENT :myXml ) as "doc"
         columns
           success  varchar(5)   path '@success',
           errorMsg varchar(500) path '@errorMsg'
         ) as X1;

   if %subst(sqlstt:1:2) <> '00' and %subst(sqlstt:1:2) <> '01';
      cust.success = *off;
      cust.errorMsg = 'Invalid input XML document';
      httpstatus = 400;
      return *off;
   endif;

   if success = 'null';
      cust.success = *off;
      cust.errorMsg = 'Input document missing manditory "success" field.';
      httpstatus = 400;
      return *off;
   endif;

   cust.success = *on;
   if %xlate(UPPER:lower: success) <> 'true';
     cust.success = *off;
   endif;

   cust.errorMsg = errMsg;

   exec SQL
     select *
       into :Result:Status.NullInds
       from xmltable(
         '$doc/cust/data'
         passing xmlparse( DOCUMENT :myXml ) as "doc"
         columns
           custno decimal(5, 0) path '@custno',
           name   varchar(30)   path 'name',
           street varchar(30)   path 'address/street',
           city   varchar(20)   path 'address/city',
           state  char(2)       path 'address/state',
           postal varchar(10)   path 'address/postal'
         ) as X2;

   // Only load the fields that have been changed.

   if %subst(sqlstt:1:2) = '00' or %subst(sqlstt:1:2) = '01';

     if Status.CustNo <> MISSING;
       cust.data.custno = Result.Custno;
     endif;

     if Status.name <> MISSING;
       cust.data.name = Result.name;
     endif;

     if Status.street <> MISSING;
       cust.data.address.street = Result.street;
     endif;

     if Status.city <> MISSING;
       cust.data.address.city = Result.city;
     endif;

     if Status.state <> MISSING;
       cust.data.address.state = Result.state;
     endif;

     if Status.postal <> MISSING;
       cust.data.address.postal = Result.postal;
     endif;

   endif;

   return cust.success;

end-proc;


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

dcl-proc sendResponseXml;

   dcl-pi *n ind;
      cust likeds(cust_t) const;
      httpStatus packed(3: 0) value;
   end-pi;

   dcl-s hdr varchar(500);
   dcl-s data sqltype(clob: 5000);
   dcl-s utfdata varchar(10000) ccsid(*utf8);

   dcl-s errmsg varchar(500);
   dcl-s success varchar(5);
   dcl-s custno packed(5: 0);
   dcl-s name   varchar(30);
   dcl-s street varchar(30);
   dcl-s city   varchar(20);
   dcl-s state  char(2);
   dcl-s postal varchar(10);

   // Embedded SQL does not allow qualified names
   // for host variables, so make a copy into a
   // simple variable name

   success = 'true';
   if cust.success = *off;
     success = 'false';
   endif;

   errmsg  = cust.errorMsg;
   custno  = cust.data.custno;
   name    = cust.data.name;
   street  = cust.data.address.street;
   city    = cust.data.address.city;
   state   = cust.data.address.state;
   postal  = cust.data.address.postal;

   data_len = 0;

   exec sql
      select
        XMLSERIALIZE(
          XMLELEMENT( name "cust",
            XMLATTRIBUTES(:success as "success",
                          :errMsg  as "errorMsg"),
            XMLELEMENT(name "data",
              XMLATTRIBUTES(:custno as "custno"),
              XMLELEMENT(name "name", trim(:name)),
              XMLELEMENT(name "address",
                XMLELEMENT(name "street", trim(:street)),
                XMLELEMENT(name "city",   trim(:city  )),
                XMLELEMENT(name "state",  trim(:state )),
                XMLELEMENT(name "postal", trim(:postal))
              )
            )
          )
        AS CLOB(5000) CCSID 1208
        VERSION '1.0' INCLUDING XMLDECLARATION)
      into :data
      from SYSIBM/SYSDUMMY1 T1;

   if %subst(sqlstt:1:2) <> '00' and %subst(sqlstt:1:2) <> '01';
      success = 'false';
      httpStatus = 500;
      errMsg = 'SQL State ' + sqlstt + ' generating XML';
      data_len = 0;
      exec sql
         select
             XMLELEMENT( name "cust",
               XMLATTRIBUTES(:success as "success",
                             :errMsg  as "errorMsg")
             )
         into :data
         from SYSIBM/SYSDUMMY1;
   endif;

   if cust.success = *on;
      hdr = 'Status: ' + %char(httpStatus) + ' OK' + CRLF
          + 'Content-Type: application/xml; charset=UTF-8' + CRLF
          + CRLF;
   else;
      hdr = 'Status: ' + %char(httpStatus) + ' ERROR' + CRLF
          + 'Content-Type: application/xml; charset=UTF-8' + CRLF
          + CRLF;
   endif;

   if data_len = 0;
     utfdata = '';
   else;
     utfdata = %subst(data_data:1:data_len);
   endif;

   QtmhWrStout( %addr(hdr:*data): %len(hdr): ignore);
   QtmhWrStout( %addr(utfdata:*data): %len(utfdata): ignore);

   return cust.success;

end-proc;


// ------------------------------------------------------------------------
//   Provide list of all customers (called when GET without any custno)
//
//   NOTE: Output is written directly to consumer
//
//   Returns *ON if successful, *OFF otherwise.
// ------------------------------------------------------------------------

dcl-proc listCustomersXml;

   dcl-pi *n ind;
   end-pi;

   dcl-s errmsg varchar(500);
   dcl-s success varchar(5);
   dcl-s data sqltype(CLOB : 100000);
   dcl-s utfdata varchar(200000) ccsid(*utf8);
   dcl-s hdr varchar(500);


   success = 'true';
   errmsg  = '';
   data_len = 0;

   exec sql
      select
        XMLSERIALIZE(
          XMLELEMENT( name "cust",
            XMLATTRIBUTES(:success as "success",
                          :errMsg  as "errorMsg"),
            XMLAGG(
              XMLELEMENT(name "data",
                XMLATTRIBUTES(T2.custno as "custno"),
                XMLELEMENT(name "name",     trim(T2.name)),
                XMLELEMENT(name "address",
                  XMLELEMENT(name "street", trim(T2.street)),
                  XMLELEMENT(name "city",   trim(T2.city  )),
                  XMLELEMENT(name "state",  trim(T2.state )),
                  XMLELEMENT(name "postal", trim(T2.postal))
                )
              )
            )
          )
        AS CLOB(100000) CCSID 1208
        VERSION '1.0' INCLUDING XMLDECLARATION)
      into :data
      from CUSTFILE T2;

   if %subst(sqlstt:1:2) <> '00' and %subst(sqlstt:1:2) <> '01';
      success = 'false';
      errMsg = 'SQL State ' + sqlstt + ' generating XML list';
      data_len = 0;
      exec sql
         select
             XMLELEMENT( name "cust",
               XMLATTRIBUTES(:success as "success",
                             :errMsg  as "errorMsg")
             )
         into :data
         from SYSIBM/SYSDUMMY1;
   endif;

   if success = 'true';
      hdr = 'Status: 200' + CRLF
          + 'Content-type: application/xml; charset=UTF-8' + CRLF
          + CRLF;
   else;
      hdr = 'Status: 500' + CRLF
          + 'Content-type: application/xml; charset=UTF-8' + CRLF
          + CRLF;
   endif;

   if data_len = 0;
     utfdata = '';
   else;
     utfdata = %subst(data_data:1:data_len);
   endif;

   QtmhWrStout( %addr(hdr:*data): %len(hdr): ignore );
   QtmhWrStout( %addr(utfdata:*data): %len(utfdata): ignore );

   return ( success = 'true' );

end-proc;

[BAndrewsRTC]

Thanks Scott! Above and beyond as always.

[gio.cot]

Hi Scott
i saw the source above " .. // PROVIDER: /api/customers REST API // This is intended to be a full CRUD service. .." .. very interesting ..
question : we can find/download from some site the whole package (CUST002R & CUST003R programs and other.. ) ??
Thanks in advance anyway
Gio

[Scott Klement]

Gio, I think it's this:

https://www.scottklement.com/presentations/WebServiceSources.zip