**free
// PROD001R - Web Service For Product Information App
//                                       Scott Klement, May 2017
//
// This app is used to demonstrate making an RPG web service
// with PhoneGap as part of Scott's "Mobile RPG With PhoneGap"
// presentation.
//
// As input it gets a URL like this:
//    http://your-server/webservices/prodinfo/json/list/XXXX
//
// It will return matching product(s) like this:
//
// {
//   "success": true,
//   "errMsg": "",
//   "item": [{
//      "code": "1234",
//      "name": "Product Name",
//      "price": 99.99,
//      "stock": 1234,
//      "image": "1234"
//   }]
// }
//
//
// It should be installed in Apache with a directive like
// this:
//
// ScriptAlias /webservices/prodinfo /QSYS.LIB/your-lib.LIB/PROD001R.PGM
// <Directory /QSYS.LIB/your-lib.LIB>
//    Require all granted
// </Directory>
//
//  To compile:
//   *> CRTSQLRPGI PROD001R OBJTYPE(*MODULE) SRCFILE(QRPGLESRC) -
//   *>            DBGVIEW(*SOURCE) RPGPPOPT(*LVL2)
//
//   *> CRTPGM PROD001R MODULE(*PGM) BNDSRVPGM(QHTTPSVR/QZHBCGI) -
//   *>                 ACTGRP(KLEMENT)
//
ctl-opt option(*srcstmt: *nodebugio: *noshowcpy) decedit('0.');

dcl-pr QtmhWrStout extproc(*dclcase);
   DtaVar    char(100000) const options(*varsize);
   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(%size(ignore));
   bytesAvail int(10) inz(0);
end-ds;

dcl-ds PRODP ext qualified end-ds;

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

dcl-s env pointer;
dcl-s url varchar(1000);
dcl-s pos int(10);
dcl-s code char(16);
dcl-s method varchar(20) inz('GET');
dcl-s format varchar(10) inz('JSON');
dcl-s command varchar(20);
dcl-s headers varchar(500);

exec SQL set option naming=*SYS;

headers = 'Status: 200 OK' + CRLF
        + 'Content-Type: text/plain' + CRLF
        + CRLF;
QtmhWrStout( headers: %len(headers): ignore );

// ---------------------------------------------------
//   Get the request method. This is the HTTP method
//   such as GET, POST, PUT, DELETE, etc.
// ---------------------------------------------------

monitor;
  env = getenv('REQUEST_METHOD');
  if env <> *null;
     method = %xlate(lower:UPPER:%str(env));
  endif;
on-error;
  reset method;
endmon;


// ---------------------------------------------------
//   URL will be something like:
//
//     http://whatever/prodinfo/format/command/code
//
//     where:  format = 'JSON' (or 'XML' in future?)
//            command = 'LIST' (or others in future?)
//                code = Product code to list (if any)
//
// ----------------------------------------------------

monitor;

   // get the URL (from REQUEST_URI variable)

   env = getenv('REQUEST_URI');
   if env <> *null;
      url = %str(env);
   endif;


   // Strip everything after the required part:

   pos = %scan(REQUIRED_PART: url) + %len(REQUIRED_PART);
   url = %subst(url:pos);


   // next part is the format:

   pos = %scan('/': url);
   if pos > 0;
      format = %subst(url:1:pos-1);
      format = %xlate(lower:UPPER:format);
      url = %subst(url:pos+1);
   endif;


   // next part is the command, then the product code

   pos = %scan('/': url);
   if pos = 0;
      command = %xlate(lower:UPPER:url);
   else;
      command = %subst(url:1:pos-1);
      command = %xlate(lower:UPPER:command);
      code = %subst(url:pos+1);
   endif;

on-error;
   // ignore error.
endmon;


// ---------------------------------------------------
//  run the appropriate command
//
//   currently 'LIST' is the only command, it
//   lists all products that match a given code
//   (or every product in the file if no code)
// ---------------------------------------------------

select;
when command = 'LIST';
   listItems(code);
other;
   headers = '{ +
                "success": "false", +
                "errMsg": "Invalid command string", +
                "method": "' + %trim(method) + '", +
                "format": "' + %trim(format) + '", +
                "command": "' + %trim(command) + '", +
                "code": "' + %trim(code) + '" +
              }';
   QtmhWrStout(headers: %len(headers): ignore);
endsl;

*inlr = *on;
return;


// ---------------------------------------------------
//   listItems(): List all items that match a code
//
//   code = (input) product code to match
//                   or *blanks for all
// ---------------------------------------------------

dcl-proc listItems;

   dcl-pi *n;
      code varchar(16) const options(*trim);
   end-pi;

   dcl-ds C1 qualified;
      prid   like(prodp.prid);
      pname  like(prodp.pname);
      pprice like(prodp.pprice);
      pimg   like(prodp.pimg);
      pstock like(prodp.pstock);
   end-ds;

   dcl-s firstItem ind inz(*on);
   dcl-s success varchar(10) inz('true');
   dcl-s errMsg varchar(100) inz('');
   dcl-s prodId packed(16: 0) inz(0);
   dcl-s jsonData varchar(100000);

   if code <> '';
      prodId = %dec(code:16:0);
   endif;

   exec SQL declare C1 cursor for
     select PRID, PNAME, PPRICE, PIMG, PSTOCK
       from PRODP
      where :prodId in (0, PRID)
      order by PNAME;

   exec SQL open C1;
   exec SQL fetch next from C1 into :C1;

   select;
   when %subst(sqlstt:1:2) = '00' or %subst(sqlstt:1:2) = '01';
      success = 'true';
      errMsg = '';

   when %subst(sqlstt:1:2) = '02';
      success = 'false';
      errMsg = 'Product ' + code + ' not found';

   other;
      success = 'false';
      errMsg = 'SQL State ' + SQLSTT;
   endsl;

   jsonData = '{ +
                 "success": ' + success + ', +
                 "errMsg": "' + jsonEscape(errMsg) + '", +
                 "item": [';


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

      if not firstItem;
         jsonData += ',';
      endif;

      jsonData += '{ +
                     "code": "'  + %char(c1.prid)   + '", +
                     "name": "'  + jsonEscape(c1.pname)  + '", +
                     "price": "' + %char(c1.pprice) + '", +
                     "stock": "' + %char(c1.pstock) + '", +
                     "image": "' + %char(c1.pimg)   + '" +
                   }';

      firstItem = *off;

      exec SQL fetch next from C1 into :C1;
   enddo;

   exec SQL close C1;

   jsonData += ']}';

   QtmhWrStout( jsonData: %len(jsonData): ignore );

end-proc;


dcl-proc jsonEscape;

   dcl-pi *n varchar(1000);
      data varchar(1000) const options(*trim);
   end-pi;

   dcl-s result varchar(1000);

   result = %scanrpl('"': '\"': data);
   return result;
end-proc;
