Wiki Home

XML Update Gram Parse


Namespace: VFP

VFP 8.0 XMLAdapter has a method to apply updategrams to whatever data source the adapter is attached to.

VFP 7 comes with the very nice XML Update Gram function. Its result can be read into SQL Server 2000 but there is no native automatic ability to read it into VFP itself to update remote tables (on a dbf-based website for example).

This is a first, rough attempt to remedy that situation by parsing the incoming updategram into a VFP cursor for later
merging into the destination DBFs

It does not use the XMLDOM Parser, relying on the native STREXTRACT() function instead for a totally VFP solution.

Please feel free to comment, criticize and improve.

-- Alex Feldstein

***********************************************************
* sample code to test creating and reading XMLUpdateGram()
* into a DBF, using the XMLUpdateGramParse() function detailed below
*
* note: in this example we do not lose any original
* sample data as we do not do a TableUpdate()
*
* note: does not deal with MEMO fields yet
*      and there is no provision for merging
*      the data into the receiving table,
*      just parsing into a temp table at this point
***********************************************************
CLEAR
SET MULTILOCKS ON
CLOSE TABLES ALL
USE HOME(2) + "data\products"
CURSORSETPROP("Buffering",5,ALIAS())

* create sample XMLUptdateGram() to file
* with some updates, inserts and deletes
REPLACE product_id WITH "9999", ;
   prod_name WITH "TEST", ;
   unit_price WITH 10, ;
   unit_cost WITH 7
INSERT INTO products ;
   (product_id, prod_name, unit_price, unit_cost) ;
   VALUES ("8888", "Test (delete)", 9, 6.5)
DELETE FOR prod_name = "Tofu  "   && yeah!

* create XMLUpdateGram
STRTOFILE(XMLUPDATEGRAM("products"), "c:\temp\produpdgram.xml")

* transfer XMLUpdateGram to a remote system

* now assume we are in the receiving system
* read in XML file and parse it/post it
lcXML = FILETOSTR("c:\temp\produpdgram.xml")
XMLUpdateGramParse(lcXML)      && Parse the XML
RETURN



*==============================================================================
* Procedure:   XMLUpdateGramParse
* Purpose:     Parse a received VFP XMLUpdateGram into a Cursor
* Author:      Alex Feldstein
* Released:    07/23/2002
* Parameters:  x as String: XML UpdateGram filemane
* Returns:     None
* Notes:       Parses a received VFP XMLUpdateGram into a Cursor
*              to be used for merging the data into the proper tables
*
* Requires VFP 7.0 or above
*
* Placed in the Public Domain. Feel free to modify to your needs.
*==============================================================================

PROCEDURE XMLUpdateGramParse(x as String) as void

LOCAL lcTagName, lcTerm, lcBeforeAfter, llNewField, lnOldMemoWidth
LOCAL lcOperation, lnLines, lcFileName, lcContents, lnRec

* create temp cursor to receive data
* we use a counter (nRec) to accept changes to multiple
* records per table.
CREATE CURSOR x (cFile C(20), nRec I, cField C(20), ;
   cBefore C(254), cAfter C(254), ;
   cOperation C(3))
INDEX ON cFile + STR(nRec) + cField TAG Main

* save setting
lnOldMemoWidth = SET("MEMOWIDTH")
SET MEMOWIDTH TO 255

llNewField = .F.
lcBeforeAfter = " "
lnRec = 0

* lcOperation can be: "INS"|"UPD"|"DEL"
lcOperation = "UPD"

* read XML into array
lnLines = ALINES(aXML,x,.T.)

* for each row, parse and put into temp cursor
FOR n = 1 TO lnLines
   lcTagName = STREXTRACT(aXML(n),"<",">")

   IF AT("xml version",lcTagName) > 0 ;
      OR AT("xmlns:updg",lcTagName) > 0 ;
      OR AT("/root",lcTagName) > 0 ;
      OR AT("updg:sync",lcTagName) > 0 ;
      OR AT("/updg:", lcTagName) > 0
      * ignore this line
      llNewField = .F.
      LOOP
   ENDIF

   DO CASE
   CASE ALLTRIM(lcTagName) == "updg:before/"
      lnRec = lnRec + 1
      lcOperation = "INS"
      llNewField = .T.
      LOOP

   CASE ALLTRIM(lcTagName) == "updg:after/"
      * we have a DELETE operation
      * go back and re-mark current set of records
      REPLACE cOperation WITH "DEL" ;
         FOR cFile = lcFileName AND nRec = lnRec
      lcOperation = "DEL"
      llNewField = .T.
      LOOP

   CASE ALLTRIM(lcTagName) == "updg:before"
      lnRec = lnRec + 1
      lcBeforeAfter = "B"

      * next line is FileName
      n = n + 1
      lcFileName = STREXTRACT(aXML(n),"<",">")

      INSERT INTO x (cFile, cOperation, nRec) ;
         VALUES (lcFileName, lcOperation, lnRec)
      LOOP

   CASE ALLTRIM(lcTagName) == "updg:after"
      lcBeforeAfter = "A"

      * next line is FileName
      n = n + 1
      lcFileName = STREXTRACT(aXML(n),"<",">")
      LOOP
   ENDCASE

   * next set of lines are fields/contents
   * until end of FileName

   IF lcTagName = "/" + lcFileName
      * we reached end of table
      LOOP
   ELSE
      IF RIGHT(lcTagName,1) = "/"   && like ""
         * empty field
         lcTagName = LEFT(lcTagName, LEN(lcTagName)-1)

         INSERT INTO x (cFile, cField, cOperation, nRec) ;
            VALUES (lcFileName, lcTagName, lcOperation, lnRec)
         llNewField = .T.
         LOOP
      ENDIF

      lcFieldName = lcTagName

      * extract field contents between field tags
      lcContents = STREXTRACT(aXML(n),"<"+lcTagName+">","")

      IF lcBeforeAfter = "B"
         IF llNewField
            INSERT INTO x (cFile, cField, cBefore, cOperation, nRec) ;
               VALUES (lcFileName, lcFieldName, lcContents, lcOperation, lnRec)
         ELSE
            REPLACE cField WITH lcFieldName, ;
               cBefore WITH lcContents
         ENDIF
         llNewField = .F.
      ELSE
         IF SEEK(lcFileName + SPACE(LEN(cFile) - LEN(lcFileName)) + ;
               STR(lnRec) + lcFieldName + SPACE(LEN(cField)- LEN(lcFieldName)))
            REPLACE cField WITH lcFieldName, ;
               cAfter WITH lcContents
         ELSE
            INSERT INTO x (cFile, cField, cAfter, cOperation, nRec) ;
               VALUES (lcFileName, lcFieldName, lcContents, lcOperation, lnRec)
         ENDIF
      ENDIF
      * done with this field
      * insert new record for next field in same table
      llNewField = .T.
   ENDIF      && end of table
NEXT

IF VARTYPE(lnOldMemoWidth) = "N" AND NOT EMPTY(lnOldMemoWidth)
   SET MEMOWIDTH TO lnOldMemoWidth
ENDIF

RETURN


Contributors: Alex Feldstein
Category Code Samples Category XML
( Topic last updated: 2002.11.20 10:21:57 AM )