From d32355e59032008dff4599e9cf4e2f19ae1e28bb Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 3 Jun 2012 22:41:28 +0000 Subject: [PATCH] 2012-06-04 00:40 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib/hbziparc/ziparc.prg ! fixed for unicode in another location % optimization to prev unicode fix * contrib/hbtip/thtml.prg ! fixed chr() usage for unicode mode * formatted (hbformat and manual) % deleted excessive parantheses * contrib/hbtip/cgi.prg * contrib/hbtip/httpcli.prg * contrib/hbtip/client.prg * contrib/hbtip/tests/base64.prg ! fread()/fwrite() calls fixed for unicode ! fixed some more anomalies, like wrongly checkingg fwrite() for negative result, calling fread() with 4 parameters, passing buffer by reference to fwrite(), minor optimizations and formatting. * contrib/hbtip/url.prg * formatting ; build tested only --- harbour/ChangeLog | 24 + harbour/contrib/hbtip/cgi.prg | 57 +- harbour/contrib/hbtip/client.prg | 8 +- harbour/contrib/hbtip/httpcli.prg | 22 +- harbour/contrib/hbtip/tests/base64.prg | 6 +- harbour/contrib/hbtip/thtml.prg | 5578 +++++++++++++----------- harbour/contrib/hbtip/url.prg | 8 +- harbour/contrib/hbziparc/ziparc.prg | 4 +- 8 files changed, 2981 insertions(+), 2726 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 1cd6e519de..afacb4b6bc 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,30 @@ The license applies to all entries newer than 2009-04-28. */ +2012-06-04 00:40 UTC+0200 Viktor Szakats (harbour syenar.net) + * contrib/hbziparc/ziparc.prg + ! fixed for unicode in another location + % optimization to prev unicode fix + + * contrib/hbtip/thtml.prg + ! fixed chr() usage for unicode mode + * formatted (hbformat and manual) + % deleted excessive parantheses + + * contrib/hbtip/cgi.prg + * contrib/hbtip/httpcli.prg + * contrib/hbtip/client.prg + * contrib/hbtip/tests/base64.prg + ! fread()/fwrite() calls fixed for unicode + ! fixed some more anomalies, like wrongly checkingg fwrite() for + negative result, calling fread() with 4 parameters, passing + buffer by reference to fwrite(), minor optimizations and formatting. + + * contrib/hbtip/url.prg + * formatting + + ; build tested only + 2012-06-03 23:14 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib/hbqt/qtcore/hbqt.h ! deleted hbqt_par_QString() macro. It was not translating diff --git a/harbour/contrib/hbtip/cgi.prg b/harbour/contrib/hbtip/cgi.prg index 92098727f5..4bc3d2c03a 100644 --- a/harbour/contrib/hbtip/cgi.prg +++ b/harbour/contrib/hbtip/cgi.prg @@ -117,7 +117,7 @@ METHOD New() CLASS TIpCgi LOCAL nRead LOCAL cTemp - ::bSavedErrHandler := ErrorBlock( { |e| ::ErrHandler( e ) } ) + ::bSavedErrHandler := ErrorBlock( {| e | ::ErrHandler( e ) } ) ::cCgiHeader := "" ::cHtmlPage := "" @@ -126,8 +126,8 @@ METHOD New() CLASS TIpCgi IF lPost nLen := Val( GetEnv( "CONTENT_LENGTH" ) ) cTemp := Space( nLen ) - IF ( ( nRead := FRead( CGI_IN, @cTemp, nLen, 0 ) ) != nLen ) - ::ErrHandler( "post error read " + Str( nRead ) + " instead of " + Str( nLen ) ) + IF ( ( nRead := FRead( CGI_IN, @cTemp, nLen ) ) != nLen ) + ::ErrHandler( "post error read " + hb_ntos( nRead ) + " instead of " + hb_ntos( nLen ) ) ELSE ::HTTP_RAW_POST_DATA := cTemp aTemp := hb_ATokens( cTemp, "&" ) @@ -191,24 +191,20 @@ METHOD Redirect( cUrl ) CLASS TIpCgi METHOD Flush() CLASS TIpCgi - LOCAL nLen LOCAL cStream LOCAL lRet LOCAL nH LOCAL cFile - LOCAL nFileSize LOCAL cSID := ::cSID LOCAL cSession - hb_HEval( ::hCookies, { | k, v | ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } ) + hb_HEval( ::hCookies, {| k, v | ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } ) cStream := ::cCgiHeader + _CRLF + ::cHtmlPage + _CRLF - nLen := Len( cStream ) - - lRet := ( Fwrite( CGI_OUT, cStream, nLen ) == nLen ) + lRet := ( FWrite( CGI_OUT, cStream ) == hb_BLen( cStream ) ) IF ::lDumpHtml IF Empty( ::cDumpSavePath ) @@ -227,17 +223,14 @@ METHOD Flush() CLASS TIpCgi cFile := ::cSessionSavePath + "SESSIONID_" + cSID - cSession := ::SessionEncode() - - nFileSize := Len( cSession ) - IF ( nH := FCreate( cFile, FC_NORMAL ) ) != F_ERROR - IF ( FWrite( nH, @cSession, nFileSize ) ) != nFileSize - ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + cSession := ::SessionEncode() + IF FWrite( nH, cSession ) != hb_BLen( cSession ) + ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) ENDIF FClose( nH ) ELSE - ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) ENDIF ENDIF @@ -247,17 +240,13 @@ METHOD SaveHtmlPage( cFile ) CLASS TIpCgi LOCAL nFile LOCAL lSuccess - LOCAL nLen LOCAL cStream - cStream := ::cHtmlPage + _CRLF - - nLen := Len( cStream ) - nFile := FCreate( cFile ) IF nFile != F_ERROR - lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen ) + cStream := ::cHtmlPage + _CRLF + lSuccess := ( FWrite( nFile, cStream ) == hb_BLen( cStream ) ) FClose( nFile ) ELSE lSuccess := .F. @@ -299,8 +288,8 @@ METHOD StartSession( cSID ) CLASS TIpCgi nFileSize := FSeek( nH, 0, FS_END ) FSeek( nH, 0, FS_SET ) cBuffer := Space( nFileSize ) - IF ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize - ::ErrHandler( "ERROR: On reading session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + IF ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize + ::ErrHandler( "ERROR: On reading session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) ELSE ::SessionDecode( cBuffer ) ENDIF @@ -313,7 +302,7 @@ METHOD StartSession( cSID ) CLASS TIpCgi ELSE ::CreateSID() - ::hSession := {=>} + ::hSession := { => } ENDIF @@ -348,7 +337,7 @@ METHOD DestroySession( cID ) CLASS TIpCgi cFile := ::cSessionSavePath + "SESSIONID_" + cSID IF !( lRet := ( FErase( cFile ) == 0 ) ) - ::Write( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + ::Write( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) ELSE ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + TIP_DateToGMT( Date() - 1 ) ::CreateSID() @@ -455,7 +444,7 @@ STATIC FUNCTION HtmlAllTag( hTags, cSep ) DEFAULT cSep TO " " - hb_HEval( hTags, { |k| cVal += HtmlTag( hTags, k ) + cSep } ) + hb_HEval( hTags, {| k | cVal += HtmlTag( hTags, k ) + cSep } ) RETURN cVal @@ -490,7 +479,7 @@ STATIC FUNCTION HtmlAllOption( hOptions, cSep ) IF ! Empty( hOptions ) DEFAULT cSep TO " " - hb_HEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } ) + hb_HEval( hOptions, {| k | cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } ) ENDIF RETURN cVal @@ -521,7 +510,7 @@ STATIC FUNCTION HtmlAllValue( hValues, cSep ) IF ! Empty( hValues ) DEFAULT cSep TO " " - hb_HEval( hValues, { |k| cVal += HtmlValue( hValues, k ) + cSep } ) + hb_HEval( hValues, {| k | cVal += HtmlValue( hValues, k ) + cSep } ) ENDIF RETURN cVal @@ -547,7 +536,7 @@ STATIC FUNCTION HtmlScript( hVal, cKey ) ENDIF IF ISARRAY( cVal ) cTmp := "" - ascan( cVal, { | cFile | cTmp += '' + _CRLF } ) + AScan( cVal, {| cFile | cTmp += '' + _CRLF } ) cRet += cTmp ENDIF ENDIF @@ -558,7 +547,7 @@ STATIC FUNCTION HtmlScript( hVal, cKey ) ENDIF IF ISARRAY( cVal ) cTmp := "" - ascan( cVal, { | cVar | cTmp += cVar } ) + AScan( cVal, {| cVar | cTmp += cVar } ) cRet += '' + _CRLF ENDIF ENDIF @@ -590,7 +579,7 @@ STATIC FUNCTION HtmlStyle( hVal, cKey ) ENDIF IF ISARRAY( cVal ) cTmp := "" - AScan( cVal, { | cFile | cTmp += '' + _CRLF } ) + AScan( cVal, {| cFile | cTmp += '' + _CRLF } ) cRet += cTmp ENDIF ENDIF @@ -601,7 +590,7 @@ STATIC FUNCTION HtmlStyle( hVal, cKey ) ENDIF IF ISARRAY( cVal ) cTmp := "" - ascan( cVal, { |cVar| cTmp += cVar } ) + AScan( cVal, {| cVar | cTmp += cVar } ) cRet += '' + _CRLF ENDIF ENDIF @@ -633,7 +622,7 @@ STATIC FUNCTION HtmlLinkRel( hVal, cKey ) ENDIF IF ISARRAY( cVal ) cTmp := "" - AScan( cVal, { | aVal | cTmp += '' + _CRLF } ) + AScan( cVal, {| aVal | cTmp += '' + _CRLF } ) cRet += cTmp ENDIF ENDIF diff --git a/harbour/contrib/hbtip/client.prg b/harbour/contrib/hbtip/client.prg index f967037205..718cfc0eb1 100644 --- a/harbour/contrib/hbtip/client.prg +++ b/harbour/contrib/hbtip/client.prg @@ -354,8 +354,8 @@ METHOD ReadHTTPProxyResponse( /* @ */ sResponse ) CLASS tIPClient nLength := Len( sResponse ) IF nLength >= 4 - bMoreDataToRead := !( ( SubStr( sResponse, nLength - 3, 1 ) == Chr( 13 ) ) .AND. ( SubStr( sResponse, nLength - 2, 1 ) == Chr( 10 ) ) .AND. ; - ( SubStr( sResponse, nLength - 1, 1 ) == Chr( 13 ) ) .AND. ( SubStr( sResponse, nLength, 1 ) == Chr( 10 ) ) ) + bMoreDataToRead := !( SubStr( sResponse, nLength - 3, 1 ) == Chr( 13 ) .AND. SubStr( sResponse, nLength - 2, 1 ) == Chr( 10 ) .AND. ; + SubStr( sResponse, nLength - 1, 1 ) == Chr( 13 ) .AND. SubStr( sResponse, nLength , 1 ) == Chr( 10 ) ) ENDIF ENDDO @@ -483,7 +483,7 @@ METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient ENDIF ENDIF - IF FWrite( nFout, cData ) < 0 + IF FWrite( nFout, cData ) != hb_BLen( cData ) FClose( nFout ) RETURN .F. ENDIF @@ -540,7 +540,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient ENDIF nSent += nLen IF ! Empty( ::exGauge ) - hb_ExecFromArray( ::exGauge, {nSent, nSize, Self} ) + hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) ENDIF nLen := FRead( nFin, @cData, nBufSize ) ENDDO diff --git a/harbour/contrib/hbtip/httpcli.prg b/harbour/contrib/hbtip/httpcli.prg index 46fe11dc7e..86a1146e9a 100644 --- a/harbour/contrib/hbtip/httpcli.prg +++ b/harbour/contrib/hbtip/httpcli.prg @@ -125,9 +125,9 @@ METHOD Post( xPostData, cQuery ) CLASS tIPClientHTTP cData := "" y := Len( xPostData ) FOR nI := 1 TO y - cTmp := tip_URLEncode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) ) + cTmp := tip_URLEncode( AllTrim( hb_CStr( hb_HKeyAt( xPostData, nI ) ) ) ) cData += cTmp + "=" - cTmp := tip_URLEncode( hb_cStr( hb_HValueAt( xPostData, nI ) ) ) + cTmp := tip_URLEncode( hb_CStr( hb_HValueAt( xPostData, nI ) ) ) cData += cTmp IF nI != y cData += "&" @@ -137,9 +137,9 @@ METHOD Post( xPostData, cQuery ) CLASS tIPClientHTTP cData := "" y := Len( xPostData ) FOR nI := 1 TO y - cTmp := tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) ) + cTmp := tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 1 ] ) ) ) cData += cTmp + "=" - cTmp := tip_URLEncode( hb_cStr( xPostData[ nI, 2 ] ) ) + cTmp := tip_URLEncode( hb_CStr( xPostData[ nI, 2 ] ) ) cData += cTmp IF nI != y cData += "&" @@ -507,17 +507,17 @@ METHOD PostMultiPart( xPostData, cQuery ) CLASS tIPClientHTTP ELSEIF hb_isHash( xPostData ) y := Len( xPostData ) FOR nI := 1 TO y - cTmp := tip_URLEncode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) ) + cTmp := tip_URLEncode( AllTrim( hb_CStr( hb_HKeyAt( xPostData, nI ) ) ) ) cData += cBound + cCrlf + 'Content-Disposition: form-data; name="' + cTmp + '"' + cCrlf + cCrLf - cTmp := tip_URLEncode( AllTrim( hb_cStr( hb_HValueAt( xPostData, nI ) ) ) ) + cTmp := tip_URLEncode( AllTrim( hb_CStr( hb_HValueAt( xPostData, nI ) ) ) ) cData += cTmp + cCrLf NEXT ELSEIF hb_isArray( xPostData ) y := Len( xPostData ) FOR nI := 1 TO y - cTmp := tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) ) + cTmp := tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 1 ] ) ) ) cData += cBound + cCrlf + 'Content-Disposition: form-data; name="' + cTmp + '"' + cCrlf + cCrLf - cTmp := tip_URLEncode( AllTrim( hb_cStr( xPostData[ nI, 2 ] ) ) ) + cTmp := tip_URLEncode( AllTrim( hb_CStr( xPostData[ nI, 2 ] ) ) ) cData += cTmp + cCrLf NEXT @@ -551,7 +551,7 @@ METHOD PostMultiPart( xPostData, cQuery ) CLASS tIPClientHTTP DO WHILE nRead == nBuf // nRead := FRead( nFile, @cBuf, nBuf ) cBuf := FReadStr( nFile, nBuf ) - nRead := Len( cBuf ) + nRead := hb_BLen( cBuf ) /* IF nRead < nBuf cBuf := PadR( cBuf, nRead ) ENDIF @@ -590,13 +590,11 @@ METHOD WriteAll( cFile ) CLASS tIPClientHTTP LOCAL nFile LOCAL lSuccess - LOCAL nLen LOCAL cStream IF ( nFile := FCreate( cFile ) ) != F_ERROR cStream := ::ReadAll() - nLen := Len( cStream ) - lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen ) + lSuccess := ( FWrite( nFile, cStream ) == hb_BLen( cStream ) ) FClose( nFile ) ELSE lSuccess := .F. diff --git a/harbour/contrib/hbtip/tests/base64.prg b/harbour/contrib/hbtip/tests/base64.prg index 9cd6686402..a24d19eb25 100644 --- a/harbour/contrib/hbtip/tests/base64.prg +++ b/harbour/contrib/hbtip/tests/base64.prg @@ -86,13 +86,13 @@ PROCEDURE MAIN( ... ) nLen := FRead( hInput, @cBuffer, 1024 ) DO WHILE nLen > 0 IF nLen < 1024 - cData += SubStr( cBuffer, 1, nLen ) + cData += hb_BLeft( cBuffer, nLen ) ELSE cData += cBuffer ENDIF nLen := FRead( hInput, @cBuffer, 1024 ) ENDDO - IF hInput <> hSTDIN + IF hInput != hSTDIN FClose( hInput ) ENDIF @@ -105,7 +105,7 @@ PROCEDURE MAIN( ... ) /* Writing stream */ FWrite( hOutput, cData ) - IF hOutput <> hSTDOUT + IF hOutput != hSTDOUT FClose( hOutput ) ENDIF diff --git a/harbour/contrib/hbtip/thtml.prg b/harbour/contrib/hbtip/thtml.prg index 9932d9ce4c..3971101e44 100644 --- a/harbour/contrib/hbtip/thtml.prg +++ b/harbour/contrib/hbtip/thtml.prg @@ -58,54 +58,55 @@ // The current implementation of FOR EACH is not suitable for the HTML classes // Directives for a light weight html parser -#xtrans P_PARSER( ) => {,0,Len(),0} -#define P_STR 1 // the string to parse -#define P_POS 2 // current parser position -#define P_LEN 3 // length of string -#define P_END 4 // last parser position +#xtrans P_PARSER( ) => { , 0, Len( ), 0 } +#define P_STR 1 // the string to parse +#define P_POS 2 // current parser position +#define P_LEN 3 // length of string +#define P_END 4 // last parser position -#xtrans :p_str => \[P_STR] -#xtrans :p_pos => \[P_POS] -#xtrans :p_len => \[P_LEN] -#xtrans :p_end => \[P_END] +#xtrans :p_str => \[P_STR] +#xtrans :p_pos => \[P_POS] +#xtrans :p_len => \[P_LEN] +#xtrans :p_end => \[P_END] -#xtrans P_SEEK( , ) => (:p_end:=:p_pos, :p_pos:=hb_At(,:p_str,:p_end+1)) -#xtrans P_SEEKI( , ) => (:p_end:=:p_pos, :p_pos:=hb_AtI(,:p_str,:p_end+1)) -#xtrans P_PEEK( , ) => (:p_end:=:p_pos, __tip_PStrCompi( :p_str, :p_pos, )) -#xtrans P_NEXT( ) => (:p_end:=:p_pos, SubStr(:p_str,++:p_pos,1)) -#xtrans P_PREV( ) => (:p_end:=:p_pos, SubStr(:p_str,--:p_pos,1)) +#xtrans P_SEEK( , ) => (:p_end:=:p_pos, :p_pos:=hb_At(,:p_str,:p_end+1)) +#xtrans P_SEEKI( , ) => (:p_end:=:p_pos, :p_pos:=hb_AtI(,:p_str,:p_end+1)) +#xtrans P_PEEK( , ) => (:p_end:=:p_pos, __tip_PStrCompi( :p_str, :p_pos, )) +#xtrans P_NEXT( ) => (:p_end:=:p_pos, SubStr(:p_str,++:p_pos,1)) +#xtrans P_PREV( ) => (:p_end:=:p_pos, SubStr(:p_str,--:p_pos,1)) // Directives for a light weight stack -#define S_DATA 1 // array holding data elements -#define S_NUM 2 // number of occupied data elements -#define S_SIZE 3 // total size of data array -#define S_STEP 4 // number of elements for auto sizing +#define S_DATA 1 // array holding data elements +#define S_NUM 2 // number of occupied data elements +#define S_SIZE 3 // total size of data array +#define S_STEP 4 // number of elements for auto sizing -#xtrans S_STACK() => S_STACK(64) -#xtrans S_STACK( ) => {Array(),0,,Max(32,Int(/2))} -#xtrans S_GROW( ) => (iif(++\[S_NUM]>\[S_SIZE],ASize(\[S_DATA],(\[S_SIZE]+=\[S_STEP])),)) -#xtrans S_SHRINK( ) => (iif(\[S_NUM]>0 .AND. --\[S_NUM]\<\[S_SIZE]-\[S_STEP],ASize(\[S_DATA],\[S_SIZE]-=\[S_STEP]),)) -#xtrans S_COMPRESS( ) => (ASize(\[S_DATA],\[S_SIZE]:=\[S_NUM])) -#xtrans S_PUSH(,) => (S_GROW(),\[S_DATA,\[S_NUM]]:=) -#xtrans S_POP(,@) => (:=\[S_DATA,\[S_NUM]],\[S_DATA,\[S_NUM]]:=NIL,S_SHRINK()) -#xtrans S_POP() => (\[S_DATA,\[S_NUM]]:=NIL,S_SHRINK()) -#xtrans S_TOP() => (\[S_DATA,\[S_NUM]]) +#xtrans S_STACK() => S_STACK(64) +#xtrans S_STACK( ) => {Array(),0,,Max(32,Int(/2))} +#xtrans S_GROW( ) => (iif(++\[S_NUM]>\[S_SIZE],ASize(\[S_DATA],(\[S_SIZE]+=\[S_STEP])),)) +#xtrans S_SHRINK( ) => (iif(\[S_NUM]>0 .AND. --\[S_NUM]\<\[S_SIZE]-\[S_STEP],ASize(\[S_DATA],\[S_SIZE]-=\[S_STEP]),)) +#xtrans S_COMPRESS( ) => (ASize(\[S_DATA],\[S_SIZE]:=\[S_NUM])) +#xtrans S_PUSH(,) => (S_GROW(),\[S_DATA,\[S_NUM]]:=) +#xtrans S_POP(,@) => (:=\[S_DATA,\[S_NUM]],\[S_DATA,\[S_NUM]]:=NIL,S_SHRINK()) +#xtrans S_POP() => (\[S_DATA,\[S_NUM]]:=NIL,S_SHRINK()) +#xtrans S_TOP() => (\[S_DATA,\[S_NUM]]) -STATIC s_aHtmlAttr // data for HTML attributes -STATIC s_hTagTypes // data for HTML tags -STATIC s_aHtmlAnsiEntities // HTML character entities (ANSI character set) -STATIC s_lInit := .F. // initilization flag for HTML data +THREAD STATIC t_aHtmlAttr // data for HTML attributes +THREAD STATIC t_hTagTypes // data for HTML tags +THREAD STATIC t_aHtmlAnsiEntities // HTML character entities (ANSI character set) +THREAD STATIC t_lInit := .F. // initilization flag for HTML data -* #define _DEBUG_ +// #define _DEBUG_ #ifdef _DEBUG_ - #xtranslate HIDDEN: => EXPORTED: // debugger can't see HIDDEN iVars +#xtranslate HIDDEN: => EXPORTED: // debugger can't see HIDDEN iVars #endif /* * Class for handling an entire HTML document */ CREATE CLASS THtmlDocument MODULE FRIENDLY + HIDDEN: VAR oIterator VAR nodes @@ -127,20 +128,22 @@ CREATE CLASS THtmlDocument MODULE FRIENDLY METHOD findFirst( cName, cAttrib, cValue, cData ) METHOD findFirstRegex( cName, cAttrib, cValue, cData ) METHOD findNext() INLINE ::oIterator:Next() + ENDCLASS - // accepts a HTML formatted string + METHOD new( cHtmlString ) CLASS THtmlDocument + LOCAL cEmptyHtmlDoc, oNode, oSubNode, oErrNode, aHead, aBody, nMode := 0 - cEmptyHtmlDoc := '' + hb_eol() +; - '' + hb_eol() +; - ' ' + hb_eol() +; - ' ' + hb_eol() +; - ' ' + hb_eol() +; - ' ' + hb_eol() +; - '' + cEmptyHtmlDoc := '' + hb_eol() + ; + '' + hb_eol() + ; + ' ' + hb_eol() + ; + ' ' + hb_eol() + ; + ' ' + hb_eol() + ; + ' ' + hb_eol() + ; + '' IF ! ISCHARACTER( cHtmlString ) ::root := THtmlNode():new( cEmptyHtmlDoc ) @@ -190,7 +193,7 @@ METHOD new( cHtmlString ) CLASS THtmlDocument // This node is an error in the HTML string. // We gracefully add its subnodes to the tag FOR EACH oErrNode IN oSubNode:htmlContent - ::body:addNode( oErrNode ) + ::body:addNode( oErrNode ) NEXT ELSE IF oSubNode:isType( CM_HEAD ) @@ -225,21 +228,27 @@ METHOD new( cHtmlString ) CLASS THtmlDocument RETURN Self // Builds a HTML formatted string + METHOD toString() CLASS THtmlDocument + RETURN ::root:toString() // reads HTML file and parses it into tree of objects + METHOD readFile( cFileName ) CLASS THtmlDocument + IF ! hb_FileExists( cFileName ) RETURN .F. ENDIF ::changed := .T. - ::new( Memoread( cFileName ) ) + ::new( MemoRead( cFileName ) ) RETURN .T. // writes the entire tree of HTML objects into a file + METHOD writeFile( cFileName ) CLASS THtmlDocument + LOCAL cHtml := ::toString() LOCAL nFileHandle := FCreate( cFileName ) @@ -254,15 +263,20 @@ METHOD writeFile( cFileName ) CLASS THtmlDocument RETURN FError() == 0 // builds a one dimensional array of all nodes contained in the HTML document + METHOD collect() CLASS THtmlDocument + IF ::changed ::nodes := ::root:collect() ::changed := .F. ENDIF + RETURN ::nodes // returns the first tag matching the passed tag name + METHOD getNode( cTagName ) CLASS THtmlDocument + LOCAL oNode IF ::changed @@ -278,7 +292,9 @@ METHOD getNode( cTagName ) CLASS THtmlDocument RETURN NIL // returns all tags matching the passed tag name + METHOD getNodes( cTagName ) CLASS THtmlDocument + LOCAL oNode, stack := S_STACK() IF ::changed @@ -296,13 +312,19 @@ METHOD getNodes( cTagName ) CLASS THtmlDocument RETURN stack[ S_DATA ] // finds the first HTML tag matching the search criteria + METHOD findFirst( cName, cAttrib, cValue, cData ) CLASS THtmlDocument + ::oIterator := THtmlIteratorScan():New( Self ) + RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) // finds the first HTML tag matching the RegEx search criteria + METHOD findFirstRegex( cName, cAttrib, cValue, cData ) CLASS THtmlDocument + ::oIterator := THtmlIteratorRegex():New( Self ) + RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) /* @@ -310,12 +332,13 @@ METHOD findFirstRegex( cName, cAttrib, cValue, cData ) CLASS THtmlDocument * * (Adopted from TXMLIterator -> source\rtl\txml.prg) */ + CREATE CLASS THtmlIterator MODULE FRIENDLY + METHOD New( oHtml ) CONSTRUCTOR METHOD Next() METHOD Rewind() METHOD Find( cName, cAttribute, cValue, cData ) - METHOD GetNode() INLINE ::oNode METHOD SetContext() METHOD Clone() @@ -331,14 +354,18 @@ CREATE CLASS THtmlIterator MODULE FRIENDLY VAR aNodes VAR nCurrent VAR nLast + METHOD MatchCriteria() + ENDCLASS // accepts a THtmlNode or THtmlDocument object + METHOD New( oHtml ) CLASS THtmlIterator + IF oHtml:isDerivedFrom ( "THtmlDocument" ) ::oNode := oHtml:root - ::aNodes:= oHtml:nodes + ::aNodes := oHtml:nodes ELSE ::oNode := oHtml ::aNodes := ::oNode:collect() @@ -347,14 +374,18 @@ METHOD New( oHtml ) CLASS THtmlIterator ::oTop := ::oNode ::nCurrent := 1 ::nLast := Len( ::aNodes ) + RETURN Self METHOD rewind() CLASS THtmlIterator + ::oNode := ::oTop ::nCurrent := 0 + RETURN Self METHOD Clone() CLASS THtmlIterator + LOCAL oRet oRet := THtmlIterator():New( ::oTop ) @@ -369,6 +400,7 @@ METHOD Clone() CLASS THtmlIterator RETURN oRet METHOD SetContext() CLASS THtmlIterator + ::oTop := ::oNode ::aNodes := ::oNode:collect() ::nCurrent := 0 @@ -377,6 +409,7 @@ METHOD SetContext() CLASS THtmlIterator RETURN Self METHOD Find( cName, cAttribute, cValue, cData ) CLASS THtmlIterator + ::cName := cName ::cAttribute := cAttribute ::cValue := cValue @@ -394,10 +427,11 @@ METHOD Find( cName, cAttribute, cValue, cData ) CLASS THtmlIterator RETURN ::Next() METHOD Next() CLASS THtmlIterator + LOCAL oFound, lExit := .F. DO WHILE ! lExit - BEGIN SEQUENCE WITH {|oErr| Break( oErr ) } + BEGIN SEQUENCE WITH { |oErr| Break( oErr ) } oFound := ::aNodes[ ++::nCurrent ] IF ::MatchCriteria( oFound ) ::oNode := oFound @@ -409,9 +443,11 @@ METHOD Next() CLASS THtmlIterator ::nCurrent := 0 END SEQUENCE ENDDO + RETURN oFound METHOD MatchCriteria() CLASS THtmlIterator + RETURN .T. /******************************************** @@ -419,18 +455,23 @@ METHOD MatchCriteria() CLASS THtmlIterator *********************************************/ CLASS THtmlIteratorScan FROM THtmlIterator MODULE FRIENDLY + METHOD New( oNodeTop ) CONSTRUCTOR HIDDEN: METHOD MatchCriteria( oFound ) + ENDCLASS METHOD New( oNodeTop ) CLASS THtmlIteratorScan + ::Super:New( oNodeTop ) + RETURN Self METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan + LOCAL xData IF ::cName != NIL .AND. !( Lower( ::cName ) == Lower( oFound:htmlTagName ) ) @@ -443,7 +484,7 @@ METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan IF ::cValue != NIL xData := oFound:getAttributes() - IF hb_HScan( xData, {| xKey, cValue | HB_SYMBOL_UNUSED( xKey ), Lower( ::cValue ) == Lower( cValue ) } ) == 0 + IF hb_HScan( xData, { | xKey, cValue | HB_SYMBOL_UNUSED( xKey ), Lower( ::cValue ) == Lower( cValue ) } ) == 0 RETURN .F. ENDIF ENDIF @@ -463,16 +504,21 @@ METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan *********************************************/ CLASS THtmlIteratorRegex FROM THtmlIterator MODULE FRIENDLY + METHOD New( oNodeTop ) CONSTRUCTOR -HIDDEN: + HIDDEN: METHOD MatchCriteria( oFound ) + ENDCLASS METHOD New( oNodeTop ) CLASS THtmlIteratorRegex + ::Super:New( oNodeTop ) + RETURN Self METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex + LOCAL xData IF ::cName != NIL .AND. ! hb_regexLike( Lower( oFound:htmlTagName ), Lower( ::cName ) ) @@ -480,12 +526,12 @@ METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex ENDIF IF ::cAttribute != NIL .AND. ; - hb_HScan( oFound:getAttributes(), {| cKey | hb_regexLike( Lower( ::cAttribute ), cKey ) } ) == 0 + hb_HScan( oFound:getAttributes(), { | cKey | hb_regexLike( Lower( ::cAttribute ), cKey ) } ) == 0 RETURN .F. ENDIF - IF ::cValue != NIL .AND.; - hb_HScan( oFound:getAttributes(), {| xKey, cValue | HB_SYMBOL_UNUSED( xKey ), hb_regexLike( ::cValue, cValue ) } ) == 0 + IF ::cValue != NIL .AND. ; + hb_HScan( oFound:getAttributes(), { | xKey, cValue | HB_SYMBOL_UNUSED( xKey ), hb_regexLike( ::cValue, cValue ) } ) == 0 RETURN .F. ENDIF @@ -495,12 +541,14 @@ METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex RETURN .F. ENDIF ENDIF + RETURN .T. /* * Class representing a HTML node tree. * It parses a HTML formatted string */ + CREATE CLASS THtmlNode MODULE FRIENDLY HIDDEN: @@ -512,10 +560,8 @@ CREATE CLASS THtmlNode MODULE FRIENDLY METHOD parseHtml( parser ) METHOD parseHtmlFixed( parser ) - METHOD _getTextNode() METHOD _setTextNode( cText ) - METHOD keepFormatting() EXPORTED: @@ -537,11 +583,11 @@ CREATE CLASS THtmlNode MODULE FRIENDLY METHOD addNode( oTHtmlNode ) METHOD insertAfter( oTHtmlNode ) METHOD insertBefore( oTHtmlNode ) - METHOD delete() + METHOD Delete() // Messages from TXmlNode MESSAGE insertBelow METHOD addNode - MESSAGE unlink METHOD delete + MESSAGE unlink METHOD Delete METHOD firstNode( lRoot ) METHOD lastNode( lRoot ) @@ -571,11 +617,11 @@ CREATE CLASS THtmlNode MODULE FRIENDLY METHOD isAttribute( cName ) - ACCESS text INLINE ::_getTextNode() - ASSIGN text(x) INLINE ::_setTextNode( x ) + ACCESS TEXT INLINE ::_getTextNode() + ASSIGN TEXT( x ) INLINE ::_setTextNode( x ) ACCESS attr INLINE ::getAttributes() - ASSIGN attr(x) INLINE ::setAttributes( x ) + ASSIGN attr( x ) INLINE ::setAttributes( x ) METHOD pushNode OPERATOR + METHOD popNode OPERATOR - @@ -584,12 +630,14 @@ CREATE CLASS THtmlNode MODULE FRIENDLY METHOD findNodesByTagName ERROR HANDLER noMessage + METHOD noAttribute + ENDCLASS - METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode - IF ! s_lInit + + IF ! t_lInit THtmlInit( .T. ) ENDIF @@ -628,9 +676,10 @@ METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode RETURN Self METHOD isType( nType ) CLASS THtmlNode + LOCAL lRet - BEGIN SEQUENCE WITH {|oErr| Break( oErr ) } + BEGIN SEQUENCE WITH { |oErr| Break( oErr ) } lRet := hb_bitAnd( ::htmlTagType[ 2 ], nType ) > 0 RECOVER lRet := .F. @@ -639,31 +688,45 @@ METHOD isType( nType ) CLASS THtmlNode RETURN lRet // checks if this is a node that is always empty and never has HTML text, e.g. ,, + METHOD isEmpty() CLASS THtmlNode + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_EMPTY ) > 0 // checks if this is a node that may occur inline, eg. , + METHOD isInline() CLASS THtmlNode + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_INLINE ) > 0 // checks if this is a node that may appear without a closing tag, eg.

,, + METHOD isOptional() CLASS THtmlNode + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_OPT ) > 0 // checks if this is a node (leafs contain no further nodes, e.g.
,

,_text_) + METHOD isNode() CLASS THtmlNode + RETURN ISARRAY( ::htmlContent ) .AND. Len( ::htmlContent ) > 0 // checks if this is a block node that must be closed with an ending tag: eg:
,
    + METHOD isBlock() CLASS THtmlNode + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_BLOCK ) > 0 // checks if this is a node whose text line formatting must be preserved: 
    ,