**FREE
//  This is a XML-based web service consumer for the web
//  service provided by the CUST001R example.
//                              Scott Klement, March 6, 2017
//
//  - Uses a green-screen display
//  - Uses XML-INTO to process XML
//  - Uses SQL XMLSERIALIZE to generate XML
//  - Uses HTTPAPI to consume the service
//
//  Before Compiling:
//   - install HTTPAPI (current version preferred)
//   - make sure HTTPAPI can be found in your *LIBL
//   - Update BASEURL constant with the correct URL for
//       your environment.
//   - Update the JOB_CCSID constant with the appropriate
//       CCSID for your environment.
//
//  To Compile:
//  *> CRTDSPF FILE(CUST002D) SRCFILE(QDDSSRC)
//  *> CRTSQLRPGI CUST003R SRCFILE(QRPGLESRC) DBGVIEW(*SOURCE)
//

ctl-opt dftactgrp(*no) actgrp(*new)
        bnddir('HTTPAPI')
        option(*srcstmt:*nodebugio:*noshowcpy);

dcl-f CUST002D workstn indds(dspf) sfile(SFL:RRN);

/include HTTPAPI_H

dcl-ds dspf qualified;
   F3     ind pos(3);
   F10    ind pos(10);
   F12    ind pos(12);
   view   ind pos(40);
   sflclr ind pos(50);
   sfldsp ind pos(51);
end-ds;

dcl-s rrn packed(4: 0);
dcl-s recsLoaded like(rrn);
dcl-c BASEURL 'http://localhost:8500/api/customers';
dcl-c JOB_CCSID 37;

dcl-s cmd varchar(200);
dcl-pr QCMDEXC extpgm;
  command char(200)     const;
  len     packed(15: 5) const;
  igc     char(3)       const options(*nopass);
end-pr;

dcl-ds cust qualified;
  success varchar(5) inz('true');
  errorMsg varchar(500) inz('');
  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-ds orig likeds(cust.data) inz(*likeds);


*inlr = *on;



http_debug(*on);
http_xproc(HTTP_POINT_ADDL_HEADER: %paddr(add_accept_header));
http_setCCSIDs(1208: JOB_CCSID);

cmd = 'CHGJOB CCSID(' + %char(JOB_CCSID) + ')';
QCMDEXC(cmd: %len(cmd));

dow '1';

   if loadSflList() = *off;
      return;
   endif;

   if showList() = *off;
      return;
   endif;

enddo;


dcl-proc clearSfl;

   dspf.sflclr = *on;
   dspf.sfldsp = *off;
   write CTL;
   dspf.sflclr = *off;
   rrn = 0;
   recsLoaded = 0;

end-proc;


dcl-proc loadSflList;

   dcl-pi *n ind;
   end-pi;

   dcl-s field varchar(50);
   dcl-s xmlData varchar(100000);
   dcl-s i int(10);
   dcl-s err int(10);

   // Retrieve the list of customers (get userid/password if needed)

   dou err <> HTTP_NDAUTH;

      monitor;
         xmlData = http_string( 'GET' : BASEURL);
         msg = *blanks;
         err = 0;
      on-error;
         msg = http_error(err);
      endmon;

      // site needs a sign-on

      if err = HTTP_NDAUTH;
         if GetPassword() = *off;
            return *off;
         endif;
      endif;

   enddo;

   // Parse XML and load it into subfile

   xml-into cust %xml(xmlData:'case=any path=cust countprefix=num_');

   clearSfl();

   for i = 1 to cust.num_data;

      custno = cust.data(i).custno;
      name   = cust.data(i).name;
      street = cust.data(i).address.street;
      city   = cust.data(i).address.city;
      state  = cust.data(i).address.state;
      postal = cust.data(i).address.postal;
      opt    = *blanks;

      RRN += 1;
      recsLoaded = RRN;
      write SFL;
      dspf.sfldsp = *on;

   endfor;

   return *on;

end-proc;



dcl-proc showList;

   dcl-pi *n ind;
   end-pi;


   dou dspf.F3;

      write ftr;
      exfmt ctl;
      msg = *blanks;

      if dspf.F3;
         iter;
      endif;

      if dspf.F10 = *on;
         newCust();
         leave;
      endif;

      for rrn = 1 to recsLoaded;

         chain rrn SFL;
         if %found and opt <> ' ';
            if modifyCust(CUSTNO) = *off;
               leave;
            endif;
            opt = ' ';
            update SFL;
         endif;

       endfor;

    enddo;

   return not dspf.F3;
end-proc;


dcl-proc loadCust;

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

   dcl-s xmlData varchar(5000);
   dcl-s err int(10);

   name   = *blanks;
   street = *blanks;
   city   = *blanks;
   state  = *blanks;
   postal = *blanks;

   monitor;
      xmlData = http_string( 'GET': BASEURL + '/' + %char(custno));
      msg = *blanks;
      err = 0;
   on-error;
      msg = http_error(err);
   endmon;

   if err = 0;

      xml-into cust %xml(xmlData:'case=any path=cust countprefix=num_');

      // If there was an error, put it on the screen
      if cust.success <> 'true';
         msg = cust.errorMsg;
      endif;

      // If no error, put the cust data on the screen.
      if cust.success = 'true';
         custno = cust.data(1).custno;
         name   = cust.data(1).name;
         street = cust.data(1).address.street;
         city   = cust.data(1).address.city;
         state  = cust.data(1).address.state;
         postal = cust.data(1).address.postal;
         eval-corr orig = cust.data(1);
      endif;

   endif;

   return *on;
end-proc;


dcl-proc modifyCust;

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

   if loadCust(custno) = *off;
      return *off;
   endif;

   exfmt MAINT;
   msg = *blanks;

   if dspf.F12 or dspf.F3;
      dspf.F12 = *off;
      return *off;
   endif;

   return updateCust(custno: *off);

end-proc;


dcl-proc newCust;

   dcl-pi *n ind;
   end-pi;

   clear orig;
   name   = *blanks;
   street = *blanks;
   city   = *blanks;
   state  = *blanks;
   postal = *blanks;
   custno = 0;

   exfmt MAINT;
   msg = *blanks;

   if dspf.F12 or dspf.F3;
      dspf.f12 = *off;
      return *off;
   endif;

   return updateCust(custno: *on);

end-proc;


dcl-proc updateCust;

   dcl-pi *n ind;
      custno packed(5: 0) value;
      isNew ind const;
   end-pi;

   dcl-s url     varchar(1000);
   dcl-s method  varchar(10);
   dcl-s sendDoc varchar(5000) inz('');
   dcl-s data    sqltype(CLOB: 5000);

   exec sql
      select
        XMLSERIALIZE(
          XMLELEMENT( name "cust",
            XMLATTRIBUTES('true' as "success",
                          ''     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';
      msg = 'SQL state ' + sqlstt + ' generating XML';
      return *off;
   endif;

   if data_len > 0;
     sendDoc = %subst(data_data:1:data_len);
   else;
     senddoc = '';
   endif;

   if isNew;
      method = 'POST';
      url = BASEURL;
   else;
      method = 'PUT';
      url = BASEURL + '/' + %char(custno);
   endif;

   monitor;
      http_string( method: url: sendDoc: 'text/xml' );
   on-error;
      msg = http_error();
      return *off;
   endmon;

   return *on;
 end-proc;

 dcl-proc GetPassword;

   dcl-pi *n ind;
   end-pi;

   dcl-s Basic ind;
   dcl-s Digest ind;
   dcl-s NTLM ind;
   dcl-s HttpRealm char(124);
   dcl-s Type char(1);

   http_getAuth( Basic: Digest: HttpRealm: NTLM );
   Realm = HttpRealm;

   exfmt SignIn;

   if dspf.F3;
      return *off;
   endif;

   // Select from the authentication types that this service allows.
   //   NTLM is the most secure so use it if available.
   //   if not, fall back to Digest.
   //   finally use Basic (unencrypted) if nothing else is available.

   select;
   when NTLM;
      type = HTTP_AUTH_NTLM;
   when Digest;
      type = HTTP_AUTH_MD5_DIGEST;
   other;
      type = HTTP_AUTH_BASIC;
   endsl;

   http_setAuth( type: UserId: Password );
   return *on;

end-proc;

dcl-proc add_accept_header;

  dcl-pi *n;
    extraHeader varchar(1024);
  end-pi;

  dcl-c CRLF x'0d25';

  extraHeader += 'Accept: text/xml' + CRLF;

end-proc;
 
