ORDSVC

**FREE

Ctl-Opt ActGrp(*New) BndDir('RXSBND') Main(ORDSVC);

Dcl-F ORDSVCHDR DISK Usage(*Input:*Output) Keyed UsrOpn Prefix('H');
Dcl-F ORDSVCDTL DISK Usage(*Input:*Output) Keyed UsrOpn Prefix('D');

/COPY QRPGLECPY,RXSCB

// This is the first of two times where we need to copy in the template member
//  for our response XML - it is copied a second time in the ResponseTemplate
//  subprocedure

/COPY QRPGLETPL,ORDTPL

// ========================================================================
// Global fields and data structures
// ========================================================================

Dcl-S gOrderNumber Packed(15:0);
Dcl-S gInvoiceTotal Packed(11:2);
Dcl-S gItemsCount Packed(3:0);


Dcl-S gRequestError Ind Inz(*Off);
Dcl-S gDuplicateOrder Ind Inz(*Off);
Dcl-S gInvalidOrder Ind Inz(*Off);

// ========================================================================
// Program main subproc ORDSVC
// ========================================================================
Dcl-Proc ORDSVC;
  // RPG-XML Suite programs used to offer web services generally
  //  don't accept parameters via a parameter list, so this is
  //  intentionally empty.
  Dcl-Pi *N;
  End-Pi;

  Dcl-S RequestXml Like(RXS_Var8Kv_t);
  Dcl-S ResponseXml Like(RXS_Var64Kv_t);

  Dcl-Ds ParseDS LikeDS(RXS_ParseDS_t);
  Dcl-Ds ComposeDS LikeDS(RXS_ComposeDS_t);
  Dcl-Ds PutStdOutDS LikeDS(RXS_PutStdOutDS_t);

  Dcl-S ExitStatus Ind Inz(*Off);

  monitor;

    exsr init;

    exsr getRequest;

    exsr parseRequest;

    if gRequestError;
      exsr composeAndReturnError;
    else;
      exsr composeAndReturnResponse;
    endif;

  on-error;
    exsr composeAndReturnResponse;
  endmon;

  return;

  begsr init;
    reset gOrderNumber;
    reset gInvoiceTotal;
    reset gItemsCount;

    reset gRequestError;
    reset gDuplicateOrder;
    reset gInvalidOrder;

    // Open necessary tables
    if not %Open(ORDSVCHDR);
      open ORDSVCHDR;
    endif;
    if not %Open(ORDSVCDTL);
      open ORDSVCDTL;
    endif;
  endsr;

  begsr getRequest;
    // Retrieve request XML from Apache/RXS Router
    reset RequestXml;
    RequestXml = RXS_GetStdIn();
  endsr;

  begsr parseRequest;
    // Parse request XML and write records to ORDSVCHDR/ORDSVCDTL assuming
    //  there are no errors
    RXS_ResetDS( ParseDS : RXS_DS_TYPE_PARSE );
    ParseDS.GlobalHandler = %Paddr( RequestHandler );
    RXS_Parse( RequestXml : ParseDS );
  endsr;

  begsr composeAndReturnResponse;
    // Compose the response XML
    RXS_ResetDS( ComposeDS : RXS_DS_TYPE_COMPOSE );
    ComposeDS.TemplateProcedure = %Paddr( ResponseTemplate );
    ComposeDS.TrimVariables = RXS_YES;
    ComposeDS.EncodeVariables = RXS_YES;
    RXS_StartComposeEngine( ComposeDS );

    // We're going to respond with pretty much the same
    //  data that we accepted and parsed from the request.

    chain gOrderNumber ORDSVCHDR;

    RXS_ComposeVariable( V.OrderNumber : %Char(HORDER) );
    RXS_ComposeVariable( V.OrderDate : %Char(HORDDAT) );
    RXS_ComposeVariable( V.OrderStatus : %Char(HORDSTS) );
    RXS_ComposeVariable( V.CustNum : HCUST );
    RXS_ComposeVariable( V.ShipVia : HSHPVIA );
    RXS_ComposeSection( S.ORDER_HEADER );

    RXS_ComposeVariable( V.InvoiceNumber : %Char(HINVNUM) );
    RXS_ComposeVariable( V.ItemCount : %Char(HTOTLIN) );
    RXS_ComposeVariable( V.Amount : %Char(HORDAMT) );
    RXS_ComposeSection( S.INVOICE_HEADER );

    setll gOrderNumber ORDSVCDTL;
    reade gOrderNumber ORDSVCDTL;
    dow not %Eof(ORDSVCDTL);
      RXS_ComposeVariable( V.ItemNumber : %Char(DPARTNO) );
      RXS_ComposeVariable( V.ItemDesc : DPARTDESC );
      RXS_ComposeVariable( V.ItemQuantity : %Char(DQTYORD) );
      RXS_ComposeVariable( V.UnitPrice : %Char(DUNITAMT) );
      RXS_ComposeVariable( V.TotalPrice : %Char(DTOTAMT) );
      RXS_ComposeSection( S.ITEM );

      reade gOrderNumber ORDSVCDTL;
    enddo;

    RXS_ComposeSection( S.INVOICE_FOOTER );

    RXS_ComposeSection( S.ORDER_FOOTER );

    ResponseXml = RXS_GetComposeBuffer();

    RXS_PutStdOut( ResponseXml );
  endsr;

  begsr composeAndReturnError;
    RXS_ResetDS( ComposeDS : RXS_DS_TYPE_COMPOSE );
    ComposeDS.TemplateProcedure = %Paddr( ResponseTemplate );
    ComposeDS.TrimVariables = RXS_YES;
    ComposeDS.EncodeVariables = RXS_YES;
    RXS_StartComposeEngine( ComposeDS );

    // Set the code and message based on the type of error
    select;
      when gDuplicateOrder;
        RXS_ComposeVariable( V.ErrorCode : 'DUPLICATE_ORDER' );
        RXS_ComposeVariable( V.ErrorMessage
                           : 'A duplicate order exists in ORDSVCHDR' );
      when gInvalidOrder;
        RXS_ComposeVariable( V.ErrorCode : 'INVALID_ORDER' );
        RXS_ComposeVariable( V.ErrorMessage
                           : 'Provided order is invalid' );
      other;
        RXS_ComposeVariable( V.ErrorCode : 'UNKNOWN' );
        RXS_ComposeVariable( V.ErrorMessage
                           : 'An unknown error occurred' );
    endsl;

    RXS_ComposeSection( S.ERROR );

    ResponseXml = RXS_GetComposeBuffer();

    // Because we're returning an error, we're going to leverage
    //  the HTTP status code to more clearly communicate that to the caller.
    //  A status code of 400 indicates a "Bad request" which is a good catch
    //  all for the types of errors we're trying to capture and report. To
    //  send a specific status code other than the default 200, we need to
    //  use the optional data structure parameter that RXS_PutStdOut supports.
    // You can read more about types of HTTP status codes here:
    //   https://developer.mozilla.org/en-US/docs/Web/HTTP/Status
    RXS_ResetDS( PutStdOutDS : RXS_DS_TYPE_PUTSTDOUT );
    PutStdOutDS.HeaderStatusCode = 400;
    PutStdOutDS.HeaderContentType = 'text/xml';
    RXS_PutStdOut( ResponseXml : PutStdOutDS );
  endsr;

On-Exit ExitStatus;
  // Close all open files
  close(E) *ALL;

End-Proc;


// Perform a check against ORDSVCHDR to see if we already have an order
//  with this order number. If we do, we're going to return an error
//  to the calling client.
Dcl-Proc IsDuplicateOrder;
  Dcl-Pi *N Ind;
    pOrderNumber Packed(15:0) Const;
  End-Pi;

  monitor;
    if not %Open(ORDSVCHDR);
      open ORDSVCHDR;
    endif;

    chain pOrderNumber ORDSVCHDR;
    if %Found(ORDSVCHDR);
      return *On;
    else;
      return *Off;
    endif;
  on-error;
    return *On;
  endmon;
End-Proc;


// ========================================================================
// Request XML parsing handler
// ========================================================================
// This subprocedure handles XML events that are detected by the parser.
// The XPath structures for the different events are:
//   '/element>' - element start
//   '/element/>' - element end
//   '/element/' - element content
//   '/element@attribute' - attribute content
Dcl-Proc RequestHandler;
  Dcl-Pi *N;
    pType Char(10) Value;
    pXPath VarChar(1024) Value;
    pData Pointer Value;
    pDataLen Int(10) Value;
  End-Pi;

  // This is checking to see if we've run into an error while parsing
  //  or validating this order, and halting parsing if we have.
  if gRequestError;
    return;
  endif;

  select;
    // This XPath ends in a ">", which means that is it an "Element Begin"
    //  parsing event. These types of events are generally a good trigger
    //  to perform initialization of records or data structures, or reset
    //  counters, etc.
    // Note that "Element Begin" events DO NOT have data.
    when pXPath = '/Order>';
      // At the start of the XML document, reset the ORDSVCHDR record and
      //  zero the invoice total field
      reset ORDHDR;
      gInvoiceTotal = 0;
      gItemsCount = 0;

    when pXPath = '/Order/Items/Item>';
      reset ORDDTL;


    // This XPath is searching for an "Attribute Content" parsing event,
    //  which is indicated by the '@' symbol before the attribute name.
    // Note that "Attribute Content" events DO have data.
    when pXPath = '/Order@Number';
      // Parsed data is retrieved with RXS_STR().
      // Because content is retrieved as character data, we need to
      //  convert the value into the appropriate data type before
      //  writing it to the table.
      monitor;
        HORDER = %Dec( RXS_STR( pData : pDataLen ) : 15 : 0 );
        gOrderNumber = HORDER;
      on-error;
        HORDER = 0;
        gOrderNumber = 0;
        gRequestError = *On;
        gInvalidOrder = *On;
        return;
      endmon;

      // Check to see if this order number already exists. If it does,
      //  stop parsing, and return an error message to the calling client.
      if IsDuplicateOrder( HORDER );
        gRequestError = *On;
        gDuplicateOrder = *On;
        return;
      endif;

    // This XPpath ends in a "/", which is an "Element Content" parsing event.
    //  These events are the main thing you test for when writing an event
    //  handler subprocedure, because this is how you parse content from an
    //  XML document.
    // Note that "Element Content" events DO have data.
    when pXPath = '/Order/Customer/';
      HCUST = RXS_STR( pData : pDataLen );

    when pXPath = '/Order/Ship/';
      HSHPVIA = RXS_STR( pData : pDataLen );

    when pXPath = '/Order/Items/Item>';
      // Safeguard before we try to parse items to confirm we found an
      //  order number in the request
      if gOrderNumber = 0;
        gRequestError = *On;
        gInvalidOrder = *On;
        return;
      endif;

    when pXPath = '/Order/Items/Item/Number/';
      monitor;
        DPARTNO = %Dec( RXS_STR( pData : pDataLen ) : 6 : 0 );
      on-error;
        DPARTNO = 0;
        gRequestError = *On;
        gInvalidOrder = *On;
        return;
      endmon;

    when pXPath = '/Order/Items/Item/Description/';
      DPARTDESC = RXS_STR( pData : pDataLen );

    when pXPath = '/Order/Items/Item/Quantity/';
      monitor;
        DQTYORD = %Dec( RXS_STR( pData : pDataLen ) : 3 : 0 );
      on-error;
        DQTYORD = 0;
        gRequestError = *On;
        gInvalidOrder = *On;
        return;
      endmon;


    when pXPath = '/Order/Items/Item/UnitPrice/';
      monitor;
        DUNITAMT = %Dec( RXS_STR( pData : pDataLen ) : 7 : 2 );
      on-error;
        DUNITAMT = 0;
        gRequestError = *On;
        gInvalidOrder = *On;
        return;
      endmon;

    // We will use this event to calculate the line item total cost
    //  and add it to the invoice total, as well as write the line item
    //  record to the table. We also increment the item count.
    when pXPath = '/Order/Items/Item/>';
      DORDER = HORDER;
      DTOTAMT = DUNITAMT * DQTYORD;
      gInvoiceTotal += DTOTAMT;
      gItemsCount += 1;
      write ORDDTL;

    // This XPath ends in a "/>", which is an "Element End" parsing event.
    //  These events are a good place to perform record write or cleanup
    //  operations.
    // Note that "Element End" events DO NOT have data.
    when pXPath = '/Order/>';
      // Check again to confirm we had a valid order number
      if gOrderNumber = 0;
        gRequestError = *On;
        gInvalidOrder = *On;
        return;
      endif;

      HORDAMT = gInvoiceTotal;
      HTOTLIN = gItemsCount;
      HORDSTS = 1;
      HORDDAT = %Dec( %Char(%Date():*ISO0) : 8 : 0 );
      HINVNUM = HORDER + 1;
      write ORDHDR;

  endsl;

  return;
End-Proc;


Dcl-Proc ResponseTemplate;
  Dcl-Pi *N;
    p Like(RXS_TEMPLATE_PARM);
  End-Pi;

  // Templates are created via a two-step process using BLDTPL and
  //  CRTRPGTPL - full walkthrough can be found at
  // https://isupport.katointegrations.com/rxs/latest/creating_an_rxs_template/

  // The RPG Template source is copied from QRPGLETPL by using
  //  /COPY once at the beginning of the program and again below.

  /COPY QRPGLETPL,ORDTPL
End-Proc;