072b90b2be
* contrib/xhb/decode.prg
* contrib/xhb/dumpvar.prg
* contrib/xhb/hbcompat.ch
* contrib/xhb/regexrpl.prg
% using HB_IS*() functions.
* formatting
426 lines
15 KiB
Plaintext
426 lines
15 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* Dumpvar function to display var contents
|
|
*
|
|
* Copyright 2003 Francesco Saverio Giudice <info@fsgiudice.com>
|
|
* www - http://harbour-project.org
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2, or (at your option)
|
|
* any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this software; see the file COPYING. If not, write to
|
|
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
|
*
|
|
* As a special exception, the Harbour Project gives permission for
|
|
* additional uses of the text contained in its release of Harbour.
|
|
*
|
|
* The exception is that, if you link the Harbour libraries with other
|
|
* files to produce an executable, this does not by itself cause the
|
|
* resulting executable to be covered by the GNU General Public License.
|
|
* Your use of that executable is in no way restricted on account of
|
|
* linking the Harbour library code into it.
|
|
*
|
|
* This exception does not however invalidate any other reasons why
|
|
* the executable file might be covered by the GNU General Public License.
|
|
*
|
|
* This exception applies only to the code released by the Harbour
|
|
* Project under the name Harbour. If you copy code from other
|
|
* Harbour Project or Free Software Foundation releases into a copy of
|
|
* Harbour, as the General Public License permits, the exception does
|
|
* not apply to the code that you add in this way. To avoid misleading
|
|
* anyone as to the status of such modified files, you must delete
|
|
* this exception notice from them.
|
|
*
|
|
* If you write modifications of your own for Harbour, it is your choice
|
|
* whether to permit this exception to apply to your modifications.
|
|
* If you do not wish that, delete this exception notice.
|
|
*
|
|
*/
|
|
|
|
#include "hbclass.ch"
|
|
#include "common.ch"
|
|
|
|
/*
|
|
* (C) 2003 - Francesco Saverio Giudice
|
|
*
|
|
* Send to hb_OutDebug() more parameters
|
|
*
|
|
*/
|
|
|
|
PROCEDURE __OutDebug( ... )
|
|
LOCAL xVal
|
|
FOR EACH xVal IN hb_aParams()
|
|
hb_OutDebug( hb_DumpVar( xVal ) )
|
|
NEXT
|
|
RETURN
|
|
|
|
/*
|
|
* (C) 2003 - Francesco Saverio Giudice
|
|
*
|
|
* return a string containing a dump of a variable
|
|
*
|
|
*
|
|
* 24/09/2006 - FSG
|
|
* - Added recursion limit
|
|
* - Added front function with limited parameters and removed support for TAssociative Array
|
|
*/
|
|
|
|
FUNCTION HB_DumpVar( xVar, lRecursive, nMaxRecursionLevel )
|
|
LOCAL nRecursionLevel := 1
|
|
LOCAL nIndent := 0
|
|
|
|
//TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive )
|
|
|
|
DEFAULT nMaxRecursionLevel TO 0
|
|
|
|
RETURN __HB_DumpVar( xVar,, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
|
|
STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
LOCAL cType := ValType( xVar )
|
|
LOCAL cString := "", cKey
|
|
LOCAL nEolLen
|
|
|
|
DEFAULT lAssocAsObj TO .F.
|
|
DEFAULT lRecursive TO .F.
|
|
|
|
//TraceLog( "Recursion: xVar, nRecursionLevel, nMaxRecursionLevel", xVar, nRecursionLevel, nMaxRecursionLevel )
|
|
|
|
// return if there is limit in recursion
|
|
IF nMaxRecursionLevel > 0 .AND. ;
|
|
nRecursionLevel > nMaxRecursionLevel
|
|
RETURN AsString( xVar )
|
|
ENDIF
|
|
|
|
DO CASE
|
|
CASE cType == "O"
|
|
|
|
IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY"
|
|
cString += Space( nIndent ) + "Type='Associative' -> " + hb_eol()
|
|
// Keys extraction.
|
|
IF Len( xVar:Keys ) > 0
|
|
nEolLen := Len( hb_eol() )
|
|
cString += Space( nIndent ) + "{" + hb_eol()
|
|
FOR EACH cKey IN xVar:Keys
|
|
cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + hb_eol()
|
|
IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH"
|
|
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol()
|
|
cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
|
|
cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + hb_eol()
|
|
ENDIF
|
|
NEXT
|
|
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol()
|
|
cString += Space( nIndent ) + "}" + hb_eol()
|
|
ENDIF
|
|
ELSE
|
|
cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + hb_eol()
|
|
cString += Space( nIndent ) + " | " + hb_eol()
|
|
cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + hb_eol()
|
|
cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
cString += Space( nIndent ) + " +- PROTECTED:" + hb_eol()
|
|
cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + hb_eol()
|
|
cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
#ifdef __XHARBOUR__
|
|
cString += Space( nIndent ) + " +- PUBLISHED:" + hb_eol()
|
|
cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
#endif
|
|
cString += Space( nIndent ) + " +----------->" + hb_eol()
|
|
ENDIF
|
|
|
|
CASE cType == "A"
|
|
IF nRecursionLevel == 1
|
|
cString += Space( nIndent ) + "Type='A' -> { Array of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + hb_eol()
|
|
ENDIF
|
|
IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel
|
|
cString += AsString( xVar )
|
|
ELSE
|
|
cString += DShowArray( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
ENDIF
|
|
|
|
CASE cType == "H"
|
|
IF nRecursionLevel == 1
|
|
cString += Space( nIndent ) + "Type='H' -> { Hash of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + hb_eol()
|
|
ENDIF
|
|
IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel
|
|
cString += AsString( xVar )
|
|
ELSE
|
|
cString += DShowHash( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
ENDIF
|
|
|
|
OTHERWISE
|
|
cString += Space( nIndent ) + AsString( xVar ) + hb_eol()
|
|
ENDCASE
|
|
|
|
RETURN cString
|
|
|
|
STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
LOCAL xProp, aProps
|
|
LOCAL aMethods, aMth
|
|
LOCAL cString := ""
|
|
|
|
DEFAULT nIndent TO 0
|
|
|
|
IF HB_ISOBJECT( oVar )
|
|
// lOldScope := __SetClassScope( .F. )
|
|
aMethods := __objGetMsgFullList( oVar, .F., HB_MSGLISTALL, nScope )
|
|
aProps := __objGetValueFullList( oVar, NIL, nScope )
|
|
// __SetClassScope( lOldScope )
|
|
|
|
IF Len( aProps ) > 0
|
|
cString += Space( nIndent ) + " | +- >> Begin Data ------" + hb_eol()
|
|
FOR EACH xProp IN aProps
|
|
cString += Space( nIndent ) + " | +- " + PadR( xProp[ HB_OO_DATA_SYMBOL ], 20 ) + " [" + DecodeType( xProp[ HB_OO_DATA_TYPE ] ) + "] [" + DecodeScope( xProp[ HB_OO_DATA_SCOPE ] ) + "] " + ValType( xProp[ HB_OO_DATA_VALUE ] ) + " => " + AsString( xProp[ HB_OO_DATA_VALUE ] ) + hb_eol()
|
|
IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO"
|
|
cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ],, lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + hb_eol()
|
|
ENDIF
|
|
NEXT
|
|
cString += Space( nIndent ) + " | +- >> End Data ------" + hb_eol()
|
|
cString += Space( nIndent ) + " | " + hb_eol()
|
|
ENDIF
|
|
IF Len( aMethods ) > 0
|
|
cString += Space( nIndent ) + " | +- >> Begin Methods ------" + hb_eol()
|
|
FOR EACH aMth IN aMethods
|
|
cString += Space( nIndent ) + " | +- " + PadR( aMth[HB_OO_DATA_SYMBOL], 20 ) + " [" + DecodeType( aMth[HB_OO_DATA_TYPE] ) + "]" + " [" + DecodeScope( aMth[HB_OO_DATA_SCOPE] ) + "] " + hb_eol()
|
|
NEXT
|
|
cString += Space( nIndent ) + " | +- >> End Methods ------" + hb_eol()
|
|
cString += Space( nIndent ) + " | " + hb_eol()
|
|
ENDIF
|
|
ENDIF
|
|
IF Empty( cString )
|
|
cString := Space( nIndent ) + " | " + hb_eol()
|
|
ENDIF
|
|
RETURN cString
|
|
|
|
STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
LOCAL xVal, nChar, nEolLen
|
|
LOCAL cString := ""
|
|
|
|
DEFAULT nIndent TO 0
|
|
|
|
//TraceLog( "DShowArray: aVar, lRecursive", aVar, lRecursive )
|
|
|
|
IF HB_ISARRAY( aVar )
|
|
nEolLen := Len( hb_eol() )
|
|
nChar := Len( LTrim( Str( Len( aVar ) ) ) ) // return number of chars to display that value
|
|
// i.e. if Len( aVar ) == 99, then nChar := 2
|
|
cString += Space( nIndent ) + "{" + hb_eol()
|
|
FOR EACH xVal IN aVar
|
|
cString += Space( nIndent ) + " ["+ LTrim( StrZero( xVal:__EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + hb_eol()
|
|
IF lRecursive .AND. ValType( xVal ) $ "AOH"
|
|
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol()
|
|
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
|
|
cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + hb_eol()
|
|
ENDIF
|
|
NEXT
|
|
IF Len( aVar ) > 0
|
|
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol()
|
|
ENDIF
|
|
cString += Space( nIndent ) + "}" + hb_eol()
|
|
ENDIF
|
|
|
|
RETURN cString
|
|
|
|
STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
|
|
LOCAL xVal
|
|
LOCAL nEolLen
|
|
LOCAL cString := ""
|
|
|
|
DEFAULT nIndent TO 0
|
|
|
|
//TraceLog( "DShowHash: hVar, ValType( hVar ), lRecursive", hVar, ValType( hVar ), ValToPrg( hVar ), lRecursive )
|
|
|
|
IF HB_ISHASH( hVar )
|
|
nEolLen := Len( hb_eol() )
|
|
cString += Space( nIndent ) + "{" + hb_eol()
|
|
FOR EACH xVal IN hVar
|
|
cString += Space( nIndent ) + " ["+ LTrim( AsString( xVal:__enumKey() ) ) + "] => " + AsString( xVal ) + ", " + hb_eol()
|
|
IF lRecursive .AND. ValType( xVal ) $ "AOH"
|
|
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol()
|
|
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
|
|
cString := SubStr( cString, 1, Len( cString )-nEolLen ) + ", " + hb_eol()
|
|
ENDIF
|
|
NEXT
|
|
IF Len( hVar ) > 0
|
|
cString := SubStr( cString, 1, Len( cString )-2-nEolLen ) + hb_eol()
|
|
ENDIF
|
|
cString += Space( nIndent ) + "}" + hb_eol()
|
|
ENDIF
|
|
|
|
RETURN cString
|
|
|
|
STATIC FUNCTION DecodeScope( nScope AS NUMERIC )
|
|
LOCAL cString := ""
|
|
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_EXPORTED ) # 0 // 1
|
|
cString += "Ex,"
|
|
ENDIF
|
|
#ifdef __XHARBOUR__
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_PUBLISHED ) # 0 // 2
|
|
cString += "Pu,"
|
|
ENDIF
|
|
#endif
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_PROTECTED ) # 0 // 4
|
|
cString += "Pr,"
|
|
ENDIF
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_HIDDEN ) # 0 // 8
|
|
cString += "Hi,"
|
|
ENDIF
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_CTOR ) # 0 // 16
|
|
cString += "Ct,"
|
|
ENDIF
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_READONLY ) # 0 // 32
|
|
cString += "Ro,"
|
|
ENDIF
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_SHARED ) # 0 // 64
|
|
cString += "Sh,"
|
|
ENDIF
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_CLASS ) # 0 // 128
|
|
cString += "Cl,"
|
|
ENDIF
|
|
IF hb_BitAnd( nScope, HB_OO_CLSTP_SUPER ) # 0 // 256
|
|
cString += "Su,"
|
|
ENDIF
|
|
|
|
IF Right( cString, 1 ) == ","
|
|
cString := SubStr( cString, 1, Len(cString)-1 )
|
|
ENDIF
|
|
|
|
RETURN PadR( cString, 18 )
|
|
|
|
STATIC FUNCTION DecodeType( nType AS NUMERIC )
|
|
LOCAL cString := ""
|
|
|
|
DO CASE
|
|
CASE nType == HB_OO_MSG_METHOD // 0
|
|
cString += "Method"
|
|
CASE nType == HB_OO_MSG_DATA // 1
|
|
cString += "Data"
|
|
CASE nType == HB_OO_MSG_CLASSDATA // 2
|
|
cString += "Clsdata"
|
|
CASE nType == HB_OO_MSG_INLINE // 3
|
|
cString += "Inline"
|
|
CASE nType == HB_OO_MSG_VIRTUAL // 4
|
|
cString += "Virtual"
|
|
CASE nType == HB_OO_MSG_SUPER // 5
|
|
cString += "Super"
|
|
CASE nType == HB_OO_MSG_ONERROR // 6
|
|
cString += "OnError"
|
|
CASE nType == HB_OO_MSG_DESTRUCTOR // 7
|
|
cString += "Destructor"
|
|
CASE nType == HB_OO_PROPERTY // 8
|
|
cString += "Property"
|
|
CASE nType == HB_OO_MSG_PROPERTY // 9
|
|
cString += "MsgPrp"
|
|
CASE nType == HB_OO_MSG_CLASSPROPERTY // 10
|
|
cString += "ClsPrp"
|
|
CASE nType == HB_OO_MSG_REALCLASS
|
|
cString += "RealCls"
|
|
CASE nType == HB_OO_MSG_DELEGATE
|
|
cString += "Delegate"
|
|
CASE nType == HB_OO_MSG_PERFORM
|
|
cString += "Perform"
|
|
ENDCASE
|
|
|
|
RETURN PadR( cString, 7 )
|
|
|
|
STATIC FUNCTION asString( x )
|
|
LOCAL v := ValType( x )
|
|
|
|
DO CASE
|
|
CASE v == "C"
|
|
RETURN '"' + x + '"'
|
|
OTHERWISE
|
|
RETURN hb_cStr( x )
|
|
ENDCASE
|
|
|
|
RETURN x
|
|
|
|
|
|
#include "error.ch"
|
|
|
|
/*
|
|
* (C) 2003 - Francesco Saverio Giudice
|
|
*
|
|
* return all informations about classes, included type and scope
|
|
*/
|
|
STATIC FUNCTION __objGetMsgFullList( oObject, lData, nRange, nScope, nNoScope )
|
|
LOCAL aMessages
|
|
LOCAL aReturn
|
|
LOCAL nFirstProperty, aMsg
|
|
|
|
IF ! HB_ISOBJECT( oObject )
|
|
__errRT_BASE( EG_ARG, 3101, NIL, ProcName() )
|
|
ENDIF
|
|
|
|
IF ! HB_ISLOGICAL( lData )
|
|
lData := .T.
|
|
ENDIF
|
|
|
|
IF ! HB_ISNUMERIC( nNoScope )
|
|
nNoScope := 0
|
|
ENDIF
|
|
|
|
// nRange is already defaulted in ClassFullSel in classes.c
|
|
|
|
aMessages := ASort( oObject:ClassSel( nRange, nScope, .T. ),,, {|x,y| x[HB_OO_DATA_SYMBOL] < y[HB_OO_DATA_SYMBOL] } )
|
|
aReturn := {}
|
|
|
|
nFirstProperty := aScan( aMessages, {| aElement | Left( aElement[HB_OO_DATA_SYMBOL], 1 ) == '_' } )
|
|
|
|
FOR EACH aMsg IN aMessages
|
|
|
|
IF Left( aMsg[HB_OO_DATA_SYMBOL], 1 ) == '_'
|
|
LOOP
|
|
ENDIF
|
|
|
|
IF ( AScan( aMessages, {| aElement | aElement[HB_OO_DATA_SYMBOL] == "_" + aMsg[HB_OO_DATA_SYMBOL] }, nFirstProperty ) != 0 ) == lData
|
|
IF nNoScope == 0 .OR. HB_BITAND( aMsg[HB_OO_DATA_SCOPE], nNoScope ) == 0
|
|
AAdd( aReturn, aMsg )
|
|
ENDIF
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN aReturn
|
|
|
|
/*
|
|
* (C) 2003 - Francesco Saverio Giudice
|
|
*
|
|
* return all values from classes, included type and scope
|
|
*/
|
|
STATIC FUNCTION __objGetValueFullList( oObject, aExcept, nScope, nNoScope )
|
|
LOCAL aVars
|
|
LOCAL aReturn
|
|
LOCAL aVar
|
|
|
|
IF ! HB_ISOBJECT( oObject )
|
|
__errRT_BASE( EG_ARG, 3101, NIL, ProcName( 0 ) )
|
|
ENDIF
|
|
|
|
IF ! HB_ISARRAY( aExcept )
|
|
aExcept := {}
|
|
ENDIF
|
|
|
|
aVars := __objGetMsgFullList( oObject, .T., HB_MSGLISTALL, nScope, nNoScope )
|
|
aReturn := {}
|
|
FOR EACH aVar IN aVars
|
|
IF hb_aScan( aExcept, aVar[HB_OO_DATA_SYMBOL],,, .T. ) == 0
|
|
//TraceLog( "__objGetValueFullList(): aVar[HB_OO_DATA_SYMBOL]", aVar[HB_OO_DATA_SYMBOL] )
|
|
AAdd( aReturn, { aVar[HB_OO_DATA_SYMBOL], __SendRawMsg( oObject, aVar[HB_OO_DATA_SYMBOL] ), aVar[HB_OO_DATA_TYPE], aVar[HB_OO_DATA_SCOPE] } )
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN aReturn
|