From 628b7e2e8d7895473b2170e0cd59b5164f03dda4 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 16 Feb 2011 09:28:01 +0000 Subject: [PATCH] 2011-02-16 10:27 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/rddads/ads.ch ! Restored deleted ADS commands. * contrib/hbtip/cgi.prg * Updated from file sent to the list by Lorenzo. I had to fix a problem which made it obvious that the file was never even compiled in Harbour SVN tree, so please review it. This change also makes this class incompatible with previous version. * doc/en/rdd.txt * doc/en/terminal.txt ! Two typos. (sent to users's list by Alain Aupeix) --- harbour/ChangeLog | 15 ++ harbour/contrib/hbtip/cgi.prg | 319 ++++++++++++++++++---------------- harbour/contrib/rddads/ads.ch | 48 +++++ harbour/doc/en/rdd.txt | 2 +- harbour/doc/en/terminal.txt | 2 +- 5 files changed, 234 insertions(+), 152 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 5a4efdfc2e..afaf374910 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,21 @@ The license applies to all entries newer than 2009-04-28. */ +2011-02-16 10:27 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * contrib/rddads/ads.ch + ! Restored deleted ADS commands. + + * contrib/hbtip/cgi.prg + * Updated from file sent to the list by Lorenzo. + I had to fix a problem which made it obvious that the + file was never even compiled in Harbour SVN tree, so + please review it. This change also makes this class + incompatible with previous version. + + * doc/en/rdd.txt + * doc/en/terminal.txt + ! Two typos. (sent to users's list by Alain Aupeix) + 2011-02-15 20:55 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbthread.h * harbour/src/vm/hvm.c diff --git a/harbour/contrib/hbtip/cgi.prg b/harbour/contrib/hbtip/cgi.prg index b8d28d5553..ff5ae9e942 100644 --- a/harbour/contrib/hbtip/cgi.prg +++ b/harbour/contrib/hbtip/cgi.prg @@ -6,7 +6,7 @@ * xHarbour Project source code: * TipCgi Class oriented cgi protocol * - * Copyright 2006 Lorenzo Fiorini + * Copyright 2006 Lorenzo Fiorini * * code from: * TIP Class oriented Internet protocol library @@ -85,18 +85,17 @@ CREATE CLASS TIpCgi VAR cSID VAR cDumpSavePath VAR lDumpHtml INIT .F. + VAR Cargo METHOD New() METHOD Header( cValue ) METHOD Redirect( cUrl ) - METHOD Print( cString ) + METHOD Write( cString ) METHOD Flush() METHOD ErrHandler( xError ) METHOD StartHtml( hOptions ) METHOD EndHtml() - METHOD StartFrameSet( hOptions ) - METHOD EndFrameSet( hOptions ) METHOD SaveHtmlPage( cFile ) METHOD StartSession( cSID ) @@ -190,12 +189,6 @@ METHOD Redirect( cUrl ) CLASS TIpCgi RETURN Self -METHOD Print( cString ) CLASS TIpCgi - - ::cHtmlPage += cString + _CRLF - - RETURN Self - METHOD Flush() CLASS TIpCgi LOCAL nLen @@ -240,122 +233,16 @@ METHOD Flush() CLASS TIpCgi IF ( nH := FCreate( cFile, FC_NORMAL ) ) != F_ERROR IF ( FWrite( nH, @cSession, nFileSize ) ) != nFileSize - ::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) ENDIF FClose( nH ) ELSE - ::Print( "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 RETURN lRet -METHOD DestroySession( cID ) CLASS TIpCgi - - LOCAL cFile - LOCAL cSID := ::cSID - LOCAL lRet - - IF ! Empty( cID ) - cSID := cID - ENDIF - - IF ! Empty( cSID ) - - ::hSession := { => } - - cFile := ::cSessionSavePath + "SESSIONID_" + cSID - - IF !( lRet := ( FErase( cFile ) == 0 ) ) - ::Print( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) - ELSE - ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + TIP_DateToGMT( Date() - 1 ) - ::CreateSID() - cSID := ::cSID - ::hCookies[ "SESSIONID" ] := cSID - ENDIF - - ENDIF - - RETURN lRet - -METHOD ErrHandler( xError ) CLASS TIpCgi - - LOCAL nCalls - - ::Print( '' ) - - ::Print( '' ) - - IF ISOBJECT( xError ) - ::Print( '' ) - ::Print( '' ) - ::Print( '' ) - ::Print( '' ) - ELSEIF ISCHARACTER( xError ) - ::Print( '' ) - ENDIF - - FOR nCalls := 2 to 6 - IF ! Empty( procname( nCalls ) ) - ::Print( '' ) - ENDIF - NEXT - - ::Print( '
SCRIPT NAME:' + GetEnv( "SCRIPT_NAME" ) + '
CRITICAL ERROR:' + xError:Description + '
OPERATION:' + xError:Operation + '
OS ERROR:' + hb_ntos( xError:OsCode ) + ' IN ' + xError:SubSystem + '/' + hb_ntos( xError:SubCode ) + '
FILENAME:' + right( xError:FileName, 40 ) + '
ERROR MESSAGE:' + xError + '
PROC/LINE:' + ProcName( nCalls ) + "/" + hb_ntos( ProcLine( nCalls ) ) + '
' ) - - ::Flush() - - RETURN NIL - -METHOD StartHtml( hOptions ) CLASS TIpCgi - - ::cHtmlPage += '' + _CRLF + ; - '' + _CRLF + ; - '' + ; - '' + ; - HtmlTag( hOptions, 'title', 'title' ) + ; - HtmlScript( hOptions ) + ; - HtmlStyle( hOptions ) + ; - '' + ; - '' - - RETURN Self - -METHOD EndHtml() CLASS TIpCgi - - ::cHtmlPage += '' - - RETURN Self - -METHOD StartFrameSet( hOptions ) CLASS TIpCgi - - ::cHtmlPage += '' + _CRLF + ; - '' + _CRLF + ; - '' + ; - '' + ; - HtmlTag( hOptions, 'title', 'title' ) + ; - HtmlScript( hOptions ) + ; - HtmlStyle( hOptions ) + ; - '' + ; - '' - - RETURN Self - -METHOD EndFrameSet( hOptions ) CLASS TIpCgi - - ::cHtmlPage += '' + ; - HtmlValue( hOptions, 'frame' ) + ; - '' - - RETURN Self - METHOD SaveHtmlPage( cFile ) CLASS TIpCgi LOCAL nFile @@ -398,7 +285,8 @@ METHOD StartSession( cSID ) CLASS TIpCgi ENDIF IF Empty( ::cSessionSavePath ) - ::cSessionSavePath := hb_DirTemp() + /* TOFIX: *nix specific default. [vszakats] */ + ::cSessionSavePath := "/tmp/" ENDIF IF ! Empty( cSID ) @@ -444,6 +332,101 @@ METHOD SessionDecode( cData ) CLASS TIpCgi RETURN hb_isHash( ::hSession ) +METHOD DestroySession( cID ) CLASS TIpCgi + + LOCAL cFile + LOCAL cSID := ::cSID + LOCAL lRet + + IF ! Empty( cID ) + cSID := cID + ENDIF + + IF ! Empty( cSID ) + + ::hSession := { => } + + cFile := ::cSessionSavePath + "SESSIONID_" + cSID + + IF !( lRet := ( FErase( cFile ) == 0 ) ) + ::Write( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + ELSE + ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + TIP_DateToGMT( Date() - 1 ) + ::CreateSID() + cSID := ::cSID + ::hCookies[ "SESSIONID" ] := cSID + ENDIF + + ENDIF + + RETURN lRet + +METHOD ErrHandler( xError ) CLASS TIpCgi + + LOCAL nCalls + LOCAL cErrMsg := "" + + cErrMsg += '' + + cErrMsg += '' + + IF ISOBJECT( xError ) + cErrMsg += '' + cErrMsg += '' + cErrMsg += '' + cErrMsg += '' + ELSEIF ISCHARACTER( xError ) + cErrMsg += '' + ENDIF + + nCalls := 1 + DO WHILE ! Empty( ProcName( nCalls ) ) + cErrMsg += '' + nCalls++ + ENDDO + + cErrMsg += '
SCRIPT NAME:' + GetEnv( "SCRIPT_NAME" ) + '
CRITICAL ERROR:' + xError:Description + '
OPERATION:' + xError:Operation + '
OS ERROR:' + hb_ntos( xError:OsCode ) + ' IN ' + xError:SubSystem + '/' + hb_ntos( xError:SubCode ) + '
FILENAME:' + right( xError:FileName, 40 ) + '
ERROR MESSAGE:' + TIP_HTMLSPECIALCHARS( xError ) + '
PROC/LINE:' + ProcName( nCalls ) + "/" + hb_ntos( ProcLine( nCalls ) ) + '
' + + ::Write( cErrMsg ) + + OutErr( cErrMsg ) + + ::Flush() + + QUIT + + RETURN NIL + +METHOD Write( cString ) CLASS TIpCgi + + ::cHtmlPage += cString + _CRLF + + RETURN Self + +METHOD StartHtml( hOptions ) CLASS TIpCgi + + ::cHtmlPage += '' + _CRLF + ; + '' + _CRLF + ; + '' + ; + '' + ; + HtmlTag( hOptions, 'title', 'title' ) + ; + HtmlScript( hOptions ) + ; + HtmlStyle( hOptions ) + ; + HtmlLinkRel( hOptions ) + ; + '' + ; + '' + + RETURN Self + +METHOD EndHtml() CLASS TIpCgi + + ::cHtmlPage += '' + + RETURN Self + STATIC FUNCTION HtmlTag( xVal, cKey, cDefault ) LOCAL cVal := "" @@ -544,84 +527,120 @@ STATIC FUNCTION HtmlAllValue( hValues, cSep ) RETURN cVal -STATIC FUNCTION HtmlScript( xVal, cKey ) +STATIC FUNCTION HtmlScript( hVal, cKey ) - LOCAL cVal := "" + LOCAL hTmp + LOCAL cRet := "" + LOCAL cVal LOCAL nPos LOCAL cTmp DEFAULT cKey TO "script" - IF ! Empty( xVal ) - IF ( nPos := hb_HPos( xVal, cKey ) ) != 0 - cVal := hb_HValueAt( xVal, nPos ) - IF hb_isHash( cVal ) - IF ( nPos := hb_HPos( cVal, "src" ) ) != 0 - cVal := hb_HValueAt( cVal, nPos ) + IF ! Empty( hVal ) + IF ( nPos := hb_HPos( hVal, cKey ) ) != 0 + hTmp := hb_HValueAt( hVal, nPos ) + IF hb_isHash( hTmp ) + IF ( nPos := hb_HPos( hTmp, "src" ) ) != 0 + cVal := hb_HValueAt( hTmp, nPos ) IF ISCHARACTER( cVal ) cVal := { cVal } ENDIF IF ISARRAY( cVal ) cTmp := "" - ascan( cVal, { | cFile | cTmp += '' + _CRLF } ) + cRet += cTmp ENDIF ENDIF - IF ( nPos := hb_HPos( cVal, "var" ) ) != 0 - cVal := hb_HValueAt( cVal, nPos ) + IF ( nPos := hb_HPos( hTmp, "var" ) ) != 0 + cVal := hb_HValueAt( hTmp, nPos ) IF ISCHARACTER( cVal ) cVal := { cVal } ENDIF IF ISARRAY( cVal ) cTmp := "" ascan( cVal, { | cVar | cTmp += cVar } ) - cVal := '' + _CRLF + cRet += '' + _CRLF ENDIF ENDIF ENDIF - hb_HDel( xVal, cKey ) + hb_HDel( hVal, cKey ) ENDIF ENDIF - RETURN cVal + RETURN cRet -STATIC FUNCTION HtmlStyle( xVal, cKey ) +STATIC FUNCTION HtmlStyle( hVal, cKey ) - LOCAL cVal := "" + LOCAL hTmp + LOCAL cRet := "" + LOCAL cVal LOCAL nPos LOCAL cTmp DEFAULT cKey TO "style" - IF ! Empty( xVal ) - IF ( nPos := hb_HPos( xVal, cKey ) ) != 0 - cVal := hb_HValueAt( xVal, nPos ) - IF hb_isHash( cVal ) - IF ( nPos := hb_HPos( cVal, "src" ) ) != 0 - cVal := hb_HValueAt( cVal, nPos ) + IF ! Empty( hVal ) + IF ( nPos := hb_HPos( hVal, cKey ) ) != 0 + hTmp := hb_HValueAt( hVal, nPos ) + IF hb_isHash( hTmp ) + IF ( nPos := hb_HPos( hTmp, "src" ) ) != 0 + cVal := hb_HValueAt( hTmp, nPos ) IF ISCHARACTER( cVal ) cVal := { cVal } ENDIF IF ISARRAY( cVal ) cTmp := "" - AScan( cVal, { | cFile | cTmp += '' + _CRLF } ) - cVal := cTmp + AScan( cVal, { | cFile | cTmp += '' + _CRLF } ) + cRet += cTmp ENDIF ENDIF - IF ( nPos := hb_HPos( cVal, "var" ) ) != 0 - cVal := hb_HValueAt( cVal, nPos ) + IF ( nPos := hb_HPos( hTmp, "var" ) ) != 0 + cVal := hb_HValueAt( hTmp, nPos ) IF ISCHARACTER( cVal ) cVal := { cVal } ENDIF IF ISARRAY( cVal ) cTmp := "" - AScan( cVal, { |cVar| cTmp += cVar } ) - cVal := '' + _CRLF + ascan( cVal, { |cVar| cTmp += cVar } ) + cRet += '' + _CRLF ENDIF ENDIF ENDIF - hb_HDel( xVal, cKey ) + hb_HDel( hVal, cKey ) ENDIF ENDIF - RETURN cVal + RETURN cRet + +STATIC FUNCTION HtmlLinkRel( hVal, cKey ) + + LOCAL hTmp + LOCAL cRet := "" + LOCAL cVal + LOCAL nPos + LOCAL cTmp + + DEFAULT cKey TO "link" + + IF ! Empty( hVal ) + IF ( nPos := hb_HPos( hVal, cKey ) ) != 0 + hTmp := hb_HValueAt( hVal, nPos ) + IF hb_isHash( hTmp ) + IF ( nPos := hb_HPos( hTmp, "rel" ) ) != 0 + cVal := hb_HValueAt( hTmp, nPos ) + IF ISCHARACTER( cVal ) + cVal := { cVal, cVal } + ENDIF + IF ISARRAY( cVal ) + cTmp := "" + AScan( cVal, { | aVal | cTmp += '' + _CRLF } ) + cRet += cTmp + ENDIF + ENDIF + ENDIF + hb_HDel( hVal, cKey ) + ENDIF + ENDIF + + RETURN cRet diff --git a/harbour/contrib/rddads/ads.ch b/harbour/contrib/rddads/ads.ch index d9e6f6e336..6cae975c7b 100644 --- a/harbour/contrib/rddads/ads.ch +++ b/harbour/contrib/rddads/ads.ch @@ -274,3 +274,51 @@ #define ADS_DD_DFV_UNKNOWN 1 #define ADS_DD_DFV_NONE 2 #define ADS_DD_DFV_VALUES_STORED 3 + +/* Commands */ + +#command SET FILETYPE TO ; + => AdsSetFileType( iif( Upper( <(x)> ) == "NTX", ADS_NTX, ; + iif( Upper( <(x)> ) == "CDX", ADS_CDX, ; + iif( Upper( <(x)> ) == "VFP", ADS_VFP, ADS_ADT ) ) ) ) + +#command SET SERVER LOCAL => AdsSetServerType( ADS_LOCAL_SERVER ) +#command SET SERVER REMOTE => AdsSetServerType( ADS_REMOTE_SERVER ) + +#command SET AXS LOCKING ; + => AdsLocking( Upper( <(x)> ) == "ON" ) + +#command SET RIGHTS CHECKING ; + => AdsRightsCheck( Upper( <(x)> ) == "ON" ) + +#command SET CHARTYPE TO ; + => AdsSetCharType( iif( Upper( <(x)> ) == "OEM", ADS_OEM, ADS_ANSI ) ) + +#command COMMIT => AdsWriteAllRecords() +#command BEGIN TRANSACTION => AdsBeginTransaction() +#command COMMIT TRANSACTION => AdsCommitTransaction() +#command ROLLBACK TRANSACTION => AdsRollback() + +#command AUTOUSE <(db)> VIA ALTERNATE ; + [ALIAS ] ; + [] ; + [] ; + [] ; + [] ; + [INDEX <(index1)> [, <(indexn)>]] ; + ; + => IF AdsIsServerLoaded( <(db)> ) > 0 ; + ; dbUseArea( ; + <.new.>, , <(db)>, <(a)>, ; + iif( <.sh.> .OR. <.ex.>, !<.ex.>, NIL ), <.ro.> ; + ) ; + [; dbSetIndex( <(index1)> )] ; + [; dbSetIndex( <(indexn)> )] ; + ; ELSE ; + ; dbUseArea( ; + <.new.>, , <(db)>, <(a)>, ; + iif( <.sh.> .OR. <.ex.>, !<.ex.>, NIL ), <.ro.> ; + ) ; + [; dbSetIndex( <(index1)> )] ; + [; dbSetIndex( <(indexn)> )] ; + ; ENDIF diff --git a/harbour/doc/en/rdd.txt b/harbour/doc/en/rdd.txt index 406da7b7c5..70ba711c7a 100644 --- a/harbour/doc/en/rdd.txt +++ b/harbour/doc/en/rdd.txt @@ -12,5 +12,5 @@ /* NOTE: I deleted all the information in this file due to copyright - vilolation! 2004-4-19 [ckedem]. + violation! 2004-4-19 [ckedem]. */ diff --git a/harbour/doc/en/terminal.txt b/harbour/doc/en/terminal.txt index fdede05e65..cb7632b9bb 100644 --- a/harbour/doc/en/terminal.txt +++ b/harbour/doc/en/terminal.txt @@ -567,7 +567,7 @@ * $COMPLIANCE$ * C52U * $PLATFORMS$ - * A + * All * $FILES$ * Library is rtl * $SEEALSO$