* Program....: HtmlMerge.prg
* Version....: 1.1
* Author.....: Maurice de Beijer
* Date.......: September 1, 1999
* Notice.....: Copyright (c) 1999-2000 ABL, All Rights Reserved.
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Merge a HTML template with the current cursor
* Changes....:
* Useage.....: 
*              
*              SELECT *, ;
*                     '<A HREF="http://localhost/default.htm">' + eng_name + '</A>' AS Link ;
*                FROM (ADDBS(_SAMPLES) + 'Data\Products') ;
*               WHERE !Discontinu ;
*               ORDER BY Eng_Name ;
*                INTO CURSOR cProd NOFILTER
*              * Create the HTML merge object
*              loHTML = NewObject('HTMLMerge', 'HTMLMerge.prg')
*              * Read the first template
*              lcText = FILETOSTR('Template_1.htm')
*              * Merge it with the cursor of products
*              loHTML.ScanMerge(lcText)
*              * Save the result as Demo_1.htm
*              STRTOFILE(loHTML.cHTML, 'demo_1.htm')
*              
* Note.......: 
*
* May 17, 2000
* Add the check for NoScan atributes. 
* If a table or list containes a NoScan attribute this will be ignored when determining the table/list to scan.
* This is usefull when you use a table to format a page header and use a second table below this which 
* you want to scan. To use it just add a NoScan attribute to any table/list above the table/list you want to
* use in the scan loop.


********************************
DEFINE CLASS HTMLMerge AS Custom
********************************

* The final HTML Text
cHTML = ''


*******************************
PROCEDURE ScanMerge(tcTemplate)
*******************************
* Look for the first table or list in the template
* The first item is merged with every line in the current cursor
LOCAL lnTable, lnList, lnFirst

lnTable = THIS.GetScanTagPos('<TABLE', tcTemplate)
IF lnTable = 0
   * No table found
   lnTable = 99999999
ENDIF

lnList = THIS.GetScanTagPos('<OL', tcTemplate)
IF lnList = 0
   * No numbered list found, check for an bullet list
   lnList = THIS.GetScanTagPos('<UL', tcTemplate)
   IF lnList = 0
      * No list found at all
      lnList = 99999999
   ENDIF
ENDIF

IF lnTable < lnList
   * Table found before any list
   THIS.MergeTable(tcTemplate, lnTable)
ELSE
   * List found before any table
   THIS.MergeList(tcTemplate, lnList)
ENDIF

RETURN


********************************************
PROCEDURE MergeTable(tcTemplate, tnStartPos)
********************************************
* Merge the body of a HTML table with every record
* in the current cursor
LOCAL lcTemplate, lnAtPos, lcTable, lcText
lcTemplate = tcTemplate
IF VARTYPE(tcStartPos) = 'N'
	* Start position laready known
	lnAtPos    = tnStartPos
ELSE
	* Start position not known yet, find it
	lnAtPos    = THIS.GetScanTagPos('<TABLE', lcTemplate)
ENDIF

* Is there a table ?
IF lnAtPos > 0
   * Table found, first do the header
   lcText     = LEFT(lcTemplate, lnAtPos - 1)
   lcTemplate = SUBSTR(lcTemplate, lnAtPos)
   THIS.Merge(lcText)
   
   * Extract the whole table part stopping just
   * before the end table marker
   lnAtPos    = ATCC('</TABLE>', lcTemplate)
   lcTable    = LEFT(lcTemplate, lnAtPos - 1)
   lcTemplate = SUBSTR(lcTemplate, lnAtPos)
   
   lnAtPos = ATCC('<TR', lcTable)
   IF lnAtPos > 0
      * Take care of the starting <TABLE ... > tag
      lcText  = LEFT(lcTable, lnAtPos - 1)
      lcTable = SUBSTR(lcTable, lnAtPos)
      THIS.Merge(lcText)
   ENDIF
   
   DO WHILE ATCC('<TH', lcTable) > 0
      * Extract the headers and merger them
      lnAtPos = ATCC('</TR>', lcTable)
      lcText  = LEFT(lcTable, lnAtPos + 5)
      lcTable = SUBSTR(lcTable, lnAtPos + 5)
      THIS.Merge(lcText)
   ENDDO
   
   SCAN
      * Merge the remainig body of the table for each record
      THIS.Merge(lcTable)
   ENDSCAN
ENDIF

* Expand the remainder of the template
THIS.Merge(lcTemplate)

RETURN THIS.cHTML


*******************************************
PROCEDURE MergeList(tcTemplate, tnStartPos)
*******************************************
LOCAL lcTemplate, lnAtPos, lcTable, lcText
lcTemplate = tcTemplate
IF VARTYPE(tcStartPos) = 'N'
	* Start position laready known
	lnAtPos    = tnStartPos
ELSE
	* Start position not known yet, find it
	lnAtPos    = THIS.GetScanTagPos('<OL', lcTemplate)
	IF lnAtPos = 0
		lnAtPos    = THIS.GetScanTagPos('<UL', lcTemplate)
	ENDIF
ENDIF

* Is there a list ?
IF lnAtPos > 0
   * Table found, first do the header
   lcText     = LEFT(lcTemplate, lnAtPos - 1)
   lcTemplate = SUBSTR(lcTemplate, lnAtPos)
   THIS.Merge(lcText)
   
   * Extract the whole table part
   lnAtPos    = ATCC('</OL>', lcTemplate)
   IF lnAtPos = 0
      lnAtPos    = ATCC('</UL>', lcTemplate)
   ENDIF
   lcTable    = LEFT(lcTemplate, lnAtPos - 1)
   lcTemplate = SUBSTR(lcTemplate, lnAtPos)
   
   lnAtPos = ATCC('<LI', lcTable)
   IF lnAtPos > 0
      * Take care of the <TABLE> tag
      lcText  = LEFT(lcTable, lnAtPos - 1)
      lcTable = SUBSTR(lcTable, lnAtPos)
      THIS.Merge(lcText)
   ENDIF
  
   SCAN
      * Merge the body for each record
      THIS.Merge(lcTable)
   ENDSCAN
ENDIF

* Expand the remainder of the template
THIS.Merge(lcTemplate)

RETURN THIS.cHTML


*************************
PROCEDURE Write(tcString)
*************************
* Add a string to the output

THIS.cHTML = THIS.cHTML + TRANSFORM(tcString)

RETURN

*************************
PROCEDURE WriteLine(tcString)
*************************
* Add a string and new line to the output

* Write the line
THIS.Write(tcString)
* Write the cariage return
THIS.Write(CHR(13)+CHR(10))

RETURN


*****************
PROCEDURE Clear()
*****************
* Clear all output

THIS.cHTML = ''

RETURN


***********************
PROCEDURE Merge(tcText)
***********************
* Merge a template with the embedded Visual FoxPro expressions
LOCAL lcText, lnAtPos1, lnAtPos2, lcEval, lcValue
LOCAL loEx as exception 
lcText = tcText
lcText = STRTRAN(lcText, '&lt;%', '<%')
lcText = STRTRAN(lcText, '%&gt;', '%>')

* Loop while another expression is found
DO WHILE ATCC('<%=', lcText) > 0
   * Get the start and end position of the next expression
   lnAtPos1 = ATCC('<%=', lcText)
   lnAtPos2 = ATCC('%>', lcText)
   
   * Extract the next expression
   lcEval  = SUBSTR(lcText, lnAtPos1 + 3, lnAtPos2 - lnAtPos1 - 3)
   * Remove any cariage returns from the expression as they could be inserted by an HTML editor
   lcEval  = CHRTRAN(lcEval, CHR(13) + CHR(10), '')

   * Evaluate it
   lcValue = ''
 	TRY 
	   lcValue = TRANSFORM(EVALUATE(lcEval))
	CATCH TO loEx
		AMESSAGEBOX(ALLTRIM(STR(loEx.ErrorNo)) + ' ' + loEx.Message + CHR(13) + CHR(10) + TRANSFORM(m.lcEval),0+16, _screen.Caption)	
	ENDTRY  
   * Stuff the result back instead of the original expression
   lcText  = STUFFC(lcText, lnAtPos1, lnAtPos2 - lnAtPos1 + 2, lcValue)
ENDDO

* Add it to the current HTML
THIS.Write(lcText)

* Return the result
RETURN lcText


******************************************
PROCEDURE GetScanTagPos(tcTag, tcTemplate)
******************************************
* Find the required scan tag, ignore all tags containing a NoScan attribute
LOCAL lnResult, lnPos, lnAtPos1, lnAtPos2, lcTemp
lnResult = 0
lnPos    = 1

DO WHILE .T.
	* Find the next position
	lnAtPos1 = ATCC(tcTag, tcTemplate, lnPos)
	IF lnAtPos1 > 0
		* Found another tag to test, extract the rest of the string
		lcTemp   = SUBSTR(tcTemplate, lnAtPos1)
		* Find the end of the tag
		lnAtPos2 = ATCC('>', lcTemp)
		* And determine the complete tag
		lcTemp   = LEFT(lcTemp, lnAtPos2)
		
		* Check if we are to ignore this tag during the scan operation
		IF ATCC('NoScan', lcTemp) = 0
			* No NoScan attribute on this tag, use it
			lnResult = lnAtPos1
			EXIT
		ELSE
			* Try to find a next tag
			lnPos = lnPos + 1
		ENDIF
	ELSE
		* Didn't find the required tag, stop
		EXIT
	ENDIF
ENDDO


RETURN lnResult

ENDDEFINE