XML 1-4, p.39

BUILDING XML MIDDLEWARE USING OMNIMARK

Listing 1
;xmlmdlwr.xom
;a middleware application to access
;a product database and return
;the results in XML

;include library files
include "omdb.xin"
include "omtcp.xin"

;global variables
global counter port-number initial {5436}
global stream dsn initial {"gold"}
global stream poison-pill initial {"_die_"}
global dbDatabase db initial {dbOpenODBC dsn}
global stream request-dtd initial
{   "<!doctype request ["
 || "<!element request (product"
 || "                  |list-of-lines"
 || "                  |list-of-types"
 || "                  |products-by-type"
 || "                  |products-by-line"
 || "                  |selected-products"
 || "                  |die)>"
 || "<!element product (#PCDATA)>"
 || "<!element list-of-types EMPTY>"
 || "<!element list-of-lines EMPTY>"
 || "<!element products-by-type (#PCDATA)>"
 || "<!element products-by-line (#PCDATA)>"
 || "<!element selected-products (#PCDATA)>"
 || "<!element die (#PCDATA)>"
 || "]>"
}
;catch declarations
declare catch shut-down
declare catch record-not-found
declare catch bad-request

;function pre-definitions
define function output-products
 where value stream where-clause
 elsewhere
 
;main process rule
process
   local tcpService service
    initial {tcpServiceOpen at port-number}

   throw shut-down
    when tcpServiceIsInError service

   ;server start up sequence

   ;compile the request dtd
   do xml-parse document
    creating xml-dtds{"request"}
    scan request-dtd
      suppress
   done

   ;set db to dbOpenODBC dsn

   ;request servcice loop
   repeat
      local tcpConnection connection
       initial {TCPServiceAcceptConnection service}
      local stream reply

      open reply
       as TCPConnectionGetOutput connection
       protocol IOProtocolMultiPacket
      using output as reply
         do xml-parse instance
          with xml-dtds{"request"}
          scan tcpConnectionGetSource connection
          protocol IOProtocolMultiPacket
            output "%c"
         catch bad-request
            output '<response status="badrequest">'
         catch record-not-found
            output '<response status="notfound"/>'
         catch #program-error
            output '<response status="error"/>'
         done
      catch #program-error
   again

   ;shutdown
   catch shut-down
      output "Shutting down.%n"

;element rules for handling requests

element "request"
   output "%c"

element "product"
   local dbField rs variable
   local stream query
    initial
    {  "SELECT Product.ProductID, "
     || "Product.ProductName, "
     || "Product.ProductLineID, "
     || "ProductLine.ProductLineName, "
     || "Product.ProductTypeID, "
     || "ProductType.ProductTypeName, "
     || "Product.ProductDescription, "
     || "Product.ProductPrice "
     || "FROM (Product LEFT JOIN "
     || "ProductLine "
     || "ON Product.ProductLineID = "
     || "ProductLine.ProductLineID) "
     || "LEFT JOIN ProductType "
     || "ON Product.ProductTypeID = "
     || "ProductType.ProductTypeID "
     || "WHERE ProductID=%c"
    }
 
   dbQuery db sql query record rs
   throw record-not-found
    unless dbRecordExists rs

   output '<response status="ok">%n'
       || '<product>%n<id>'
       || dbFieldValue rs{"ProductID"}
       || '</id>%n<name>'
   submit dbFieldValue rs{"ProductName"}
   output '</name>%n<line id="'
       || dbFieldValue rs{"ProductLineID"}
       || '" name="'
   submit dbFieldValue rs{"ProductLineName"}
   output '"/>%n<type id="'
       || dbFieldValue rs{"ProductTypeID"}
       || '" name="'
   submit dbFieldValue rs{"ProductTypeName"}
   output '"/>%n'
       || dbFieldValue rs{"ProductDescription"}
       || '%n<price>'
       || dbFieldValue rs{"ProductPrice"}
       || '</price>%n</product>%n</response>'

element "list-of-lines"
   local dbField rs variable
   local stream query
    initial
    {   "SELECT ProductLineID, "
     || "ProductLineName, "
     || "ProductLineDescription "
     || "FROM ProductLine"
    }
 
   dbQuery db sql query record rs

   throw record-not-found unless dbRecordExists rs

   output '<response status="ok">%n'
       || '<list-of-lines>%n'
   repeat exit unless dbRecordExists rs
      output '<line>%n<id>'
          || dbFieldValue rs{"ProductLineID"}
          || '</id>%n<name>'
      submit dbFieldValue rs{"ProductLineName"}
      output '</name>%n'
          || dbFieldValue
             rs{"ProductLineDescription"}
          || '</line>%n'
      dbRecordMove rs
   again
   output '</list-of-lines></response>'
   suppress

element "list-of-types"
   local dbField rs variable
   local stream query initial
    {   "SELECT ProductTypeID, "
     || "ProductTypeName, "
     || "ProductTypeDescription "
     || "FROM ProductType"
    }
 
   dbQuery db sql query record rs
   throw record-not-found unless dbRecordExists rs

   output '<response status="ok">%n'
       || '<list-of-types>%n'
   repeat exit unless dbRecordExists rs
      output '<type>%n<id>'
          || dbFieldValue rs{"ProductTypeID"}
          || '</id>%n<name>'
      submit dbFieldValue rs{"ProductTypeName"}
      output '</name>%n'
          || dbFieldValue
             rs{"ProductTypeDescription"}
          || '</type>%n'
      dbRecordMove rs
   again
   output '</list-of-types></response>'
   suppress

element "products-by-type"
   local dbField rs variable
   ;capture the ID since we will need to use
   ;it twice
   local stream response-buffer
   local stream id initial {"%c"}
   local stream query initial
    {   "SELECT ProductTypeID, "
     || "ProductTypeName, "
     || "ProductTypeDescription "
     || "FROM ProductType "
     || "WHERE ProductTypeID=%g(id)"
    }
   ;buffer the response in case of error
   open response-buffer as buffer
   using output as response-buffer
   do
      output '<response status="ok">%n'
          || '<products-by-type>%n'
      ;first get information on the product line:
      dbQuery db sql query record rs
      throw record-not-found
       unless dbRecordExists rs
 
      output '<type><id>'
          || dbFieldValue rs{"ProductTypeID"}
          || '</id><name>'
      submit dbFieldValue rs {"ProductTypeName"}
      output '</name>'
          || dbFieldValue
             rs{"ProductTypeDescription"}
          || '</type>'

      ;then get information on the
      ;products of that type
      output-products where "ProductLineID=%g(id)"
      output '</products-by-type></response>'
   done
   close response-buffer
   output response-buffer

element "products-by-line"
   local dbField rs variable
   ;capture the ID since we will
   ;need to use it twice
   local stream id initial {"%c"}
   local stream response-buffer
   local stream query initial
    {   "SELECT ProductLineID, "
     || "ProductLineName, "
     || "ProductLineDescription "
     || "FROM ProductLine "
     || "WHERE ProductLineID=%g(id)"
    }
 
   ;buffer the response in case of error
   open response-buffer as buffer
   using output as response-buffer
   do
      output '<response status="ok">%n'
          || '<products-by-line>%n'
      ;first get information on the product line:
      dbQuery db sql query record rs
      throw record-not-found
       unless dbRecordExists rs
 
      output '<line><id>'
          || dbFieldValue rs{"ProductLineID"}
          || '</id><name>'
      submit dbFieldValue rs{"ProductLineName"}
      output '</name>'
          || dbFieldValue
             rs{"ProductLineDescription"}
          || '</line>'
 
      ;then get information on the
      ;products in that line
      output-products where "ProductLineID=%g(id)"
      output '</products-by-line></response>'
   done
   close response-buffer
   output response-buffer

element "selected-products"
   local dbField rs variable
   local stream query initial
    {   "SELECT ProductID, "
     || "ProductName, "
     || "ProductPrice "
     || "FROM Product "
     || "WHERE "
     || "ProductID IN (%c)"
    }
 
   dbQuery db sql query record rs
   throw record-not-found unless dbRecordExists rs

   output '<response status="ok">%n'
       || '<selected-products>%n'
   repeat exit unless dbRecordExists rs
      output '<product>%n<id>'
          || dbFieldValue rs{"ProductID"}
          || '</id>%n<name>'
      submit dbFieldValue rs{"ProductName"}
      output '</name>%n<price>'
          || dbFieldValue rs{"ProductPrice"}
          || '</price></product>%n'
      dbRecordMove rs
   again
   output '</selected-products></response>'

element "die"
   ;check that the die request has
   ;the proper poison-pill
   throw shut-down when "%c" = poison-pill
   ;otherwise just ignore the request

markup-error
   throw bad-request

;find rules for escaping text in XML documents
find "<"
    output "&lt;"

find ">"
    output "&gt;"

find "&"
    output "&amp;"

find '"'
    output "&quot;"
 
;function to output list of products
define function output-products
 where value stream where-clause
 as
   local dbField rs variable
   local stream query initial
    {   "SELECT ProductID, "
     || "ProductName, "
     || "ProductDescription, "
     || "ProductPrice "
     || "FROM Product "
     || "WHERE "
     || where-clause
    }
 
   dbQuery db sql query record rs
   throw record-not-found unless dbRecordExists rs
   repeat exit unless dbRecordExists rs
      output '<product>%n<id>'
          || dbFieldValue rs{"ProductID"}
          || '</id>%n<name>'
      submit dbFieldValue rs{"ProductName"}
      output '</name>%n'
          || dbFieldValue
             rs{"ProductDescription"}
          || '<price>'
          || dbFieldValue rs{"ProductPrice"}
          || '</price></product>%n'
      dbRecordMove rs
   again
 

Listing 2
;stub.xom
;to test the product server
include "omtcp.xin"
include "ombcd.xin"

declare catch connection-error

;globals
global stream product-server-host
 initial {"localhost"}
global counter product-server-port
 initial {5436}
global stream product-id initial {"4"}
global stream output-file-name initial {"out.htm"}
global stream dtd-file-name initial {"response.dtd"}

 
process
   local stream output-file
   local TCPConnection connection initial
    {TCPConnectionOpen
     on product-server-host
     at product-server-port
    }

   ; check the connection was made
   throw connection-error
    when TCPConnectionIsInError connection
 
   ;send the request
   set TCPConnectionGetOutput connection
    protocol IOProtocolMultiPacket
    to '<request><product>'
    || product-id
    || '</product></request>'

   ;uncomment to inspect response
   ;output TCPConnectionGetSource connection
   ; protocol IOProtocolMultiPacket
 
   ;process the response
   open output-file as file output-file-name
   using output as output-file
    do xml-parse document
    scan file dtd-file-name
      || TCPConnectionGetSource connection
         protocol IOProtocolMultiPacket
      output "%c"
    done

   catch connection-error
      output "Connection error%n"
 
;element rules
element "response"
   do scan attribute "status"
      match "ok" =|
          output "%c"
   else
      output "<H3>Server Error</H3>"
      halt
   done
 
element "product"
   output "%c"

element "id"
   suppress
 
element "name"
   output "<H3>%c</H3>%n"
 
element "line"
   output "%c<P>Product line: "
       || attribute "name"
 
element "type"
   output "%c<P>Product type: "
       || attribute "name"

element "price"
   output "<p>Price: "
       || "<$,NNZ.ZZ>" % bcd "%c"
 
element "description"
   output "%c"
 
element "p"
   output "<p>%c</p>"
 
element "prodref"
   output "<b>%c</b>"

 
Listing 3
<!DOCTYPE response [
<!element response (product*|line*)>
<!attlist response status CDATA #REQUIRED>
<!element id (#PCDATA)>
<!element product (id, name, line, type, description, price)>
<!element name (#PCDATA)>
<!element description (p+)>
<!element prodref (#PCDATA)>
<!attlist prodref id CDATA #REQUIRED>
<!element price (#PCDATA)>
<!element p (#PCDATA | prodref)*>
<!element line EMPTY>
<!attlist line id CDATA #REQUIRED
               name CDATA #REQUIRED>
<!element type EMPTY>
<!attlist type id CDATA #REQUIRED
               name CDATA #REQUIRED>
]>