**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; 
