From ff4bdc2bcedb4626de4f5bfcbd38b0967e71a685 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 19 Mar 2009 18:50:21 +0000 Subject: [PATCH] 2009-03-19 19:49 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * xhb/Makefile * xhb/dumpvar.prg + xhb/decode.prg + Added HB_DECODE(). * Syntax adapted for Harbour. --- harbour/ChangeLog | 7 + harbour/contrib/xhb/Makefile | 1 + harbour/contrib/xhb/decode.prg | 276 +++++++++++++++++++++ harbour/contrib/xhb/dumpvar.prg | 415 ++++++++++++++++---------------- 4 files changed, 492 insertions(+), 207 deletions(-) create mode 100644 harbour/contrib/xhb/decode.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f4311a96b2..0665656666 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,13 @@ 2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2009-03-19 19:49 UTC+0100 Viktor Szakats (harbour.01 syenar hu) + * xhb/Makefile + * xhb/dumpvar.prg + + xhb/decode.prg + + Added HB_DECODE(). + * Syntax adapted for Harbour. + 2009-03-19 19:05 UTC+0100 Viktor Szakats (harbour.01 syenar hu) * source/vm/maindll.c * source/vm/maindllp.c diff --git a/harbour/contrib/xhb/Makefile b/harbour/contrib/xhb/Makefile index 2203ba1fac..9e5ce6cb7f 100644 --- a/harbour/contrib/xhb/Makefile +++ b/harbour/contrib/xhb/Makefile @@ -40,6 +40,7 @@ PRG_SOURCES=\ arrayblk.prg \ cstruct.prg \ dbgfx.prg \ + decode.prg \ dirrec.prg \ dumpvar.prg \ hblog.prg \ diff --git a/harbour/contrib/xhb/decode.prg b/harbour/contrib/xhb/decode.prg new file mode 100644 index 0000000000..cc5ab8bc05 --- /dev/null +++ b/harbour/contrib/xhb/decode.prg @@ -0,0 +1,276 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Decode function + * + * Copyright 2006 Francesco Saverio Giudice + * www - http://www.harbour-project.org + * www - http://www.xharbour.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 "common.ch" + +/* +PROCEDURE Main() + LOCAL aArray + + ? "DECODE FUNCTION TESTS" + + // Single, return empty value + ? Decode( 10 ) + // A list + ? Decode( 3, 1, "A", 2, "B", 3, "C" ) + // A list with default + ? Decode( 4, 1, "A", 2, "B", 3, "C", "X" ) + // Using an array as list of values to check + ? Decode( 2, { 1, "A", 2, "B", 3, "C" } ) + // Using an array with default as list of values to check + ? Decode( 2, { 1, "A", 2, "B", 3, "C", "X" } ) + // Using an hash as list + ? Decode( 2, { 1 => "A", 2 => "B", 3 => "C" } ) + + // Returning a codeblock + ? cStr( Decode( 2, 1, {|| 1 }, 2, {|| 2 }, 3, {|| 3 } ) ) + + // Checking an array + aArray := { 1 } + ? Decode( aArray, aArray, "A", { 2 }, "B", { 3 }, "C" ) + + RETURN +*/ + +/****************** +* Function .......: hb_Decode( , [ ]> ) ---> +* Author .........: Francesco Saverio Giudice +* Date of creation: 25/01/1991 +* Last revision ..: 24/01/2006 1.13 - rewritten for xHarbour and renamed in hb_Decode() +* +* Decode a value from a list. +*******************/ +FUNCTION HB_Decode(...) + + LOCAL aParams, nParams, xDefault + LOCAL xVal, cKey, xRet + LOCAL aValues, aResults, n, i, nPos, nLen + + aParams := hb_aParams() + nParams := PCount() + xDefault := NIL + + DO CASE + CASE nParams > 1 // More parameters, real case + + xVal := aParams[ 1 ] + + hb_ADel( aParams, 1, TRUE ) // Resize params + nParams := Len( aParams ) + + // if I have a odd number of members, last is default + IF ( nParams % 2 <> 0 ) + xDefault := aTail( aParams ) + // Resize again deleting last + hb_ADel( aParams, nParams, TRUE ) + nParams := Len( aParams ) + ENDIF + + // Ok because I have no other value than default, I will check if it is a complex value + // like an array or an hash, so I can get it to decode values + IF xDefault <> NIL .AND. ; + ( ValType( xDefault ) == "A" .OR. ; + ValType( xDefault ) == "H" ) + + // If it is an array I will restart this function creating a linear call + IF ValType( xDefault ) == "A" .AND. Len( xDefault ) > 0 + + // I can have a linear array like { 1, "A", 2, "B", 3, "C" } + // or an array of array couples like { { 1, "A" }, { 2, "B" }, { 3, "C" } } + // first element tell me what type is + + // couples of values + IF ValType( xDefault[ 1 ] ) == "A" + + //// If i have an array as default, this contains couples of key / value + //// so I have to convert in a linear array + + nLen := Len( xDefault ) + + // Check if array has a default value, this will be last value and has a value + // different from an array + IF !( ValType( xDefault[ nLen ] ) == "A" ) + + aParams := Array( ( nLen - 1 ) * 2 ) + + n := 1 + FOR i := 1 TO nLen - 1 + aParams[ n++ ] := xDefault[ i ][ 1 ] + aParams[ n++ ] := xDefault[ i ][ 2 ] + NEXT + + aAdd( aParams, xDefault[ nLen ] ) + + ELSE + + // I haven't a default + + aParams := Array( Len( xDefault ) * 2 ) + + n := 1 + FOR i := 1 TO Len( xDefault ) + aParams[ n++ ] := xDefault[ i ][ 1 ] + aParams[ n++ ] := xDefault[ i ][ 2 ] + NEXT + + ENDIF + ELSE + // I have a linear array + + aParams := xDefault + ENDIF + + + // If it is an hash, translate it in an array + ELSEIF ValType( xDefault ) == "H" + + aParams := Array( Len( xDefault ) * 2 ) + + i := 1 + FOR EACH cKey IN xDefault:Keys + aParams[ i++ ] := cKey + aParams[ i++ ] := xDefault[ cKey ] + NEXT + + ENDIF + + // Then add Decoding value at beginning + hb_AIns( aParams, 1, xVal, TRUE ) + + // And run decode() again + xRet := hb_ExecFromArray( @hb_Decode(), aParams ) + + ELSE + + // Ok let's go ahead with real function + + // Combine in 2 lists having elements as { value } and { decode } + aValues := Array( nParams / 2 ) + aResults := Array( nParams / 2 ) + + i := 1 + FOR n := 1 TO nParams - 1 STEP 2 + aValues[ i ] := aParams[ n ] + aResults[ i ] := aParams[ n + 1 ] + i++ + NEXT + + // Check if value exists (valtype of values MUST be same of xVal, + // otherwise I will get a runtime error) + // TODO: Have I to check also between different valtypes, jumping different ? + nPos := aScan( aValues, {|e| e == xVal } ) + + IF nPos == 0 // Not Found, returning default + xRet := xDefault // it could be also nil because not present + ELSE + xRet := aResults[ nPos ] + ENDIF + ENDIF + + CASE nParams == 0 // No parameters + xRet := NIL + + CASE nParams == 1 // Only value to decode as parameter, return an empty value of itself + xRet := EmptyValue( aParams[ 1 ] ) + + ENDCASE + + RETURN xRet + +FUNCTION HB_DecodeOrEmpty(...) + LOCAL aParams := hb_aParams() + LOCAL xVal := hb_ExecFromArray( @hb_decode(), aParams ) + RETURN iif( xVal == NIL, EmptyValue( aParams[ 1 ] ), xVal ) + +STATIC FUNCTION EmptyValue( xVal ) + LOCAL xRet + LOCAL cType := ValType( xVal ) + + SWITCH cType + CASE "C" // Char + CASE "M" // Memo + xRet := "" + EXIT + CASE "D" // Date + xRet := CTOD("") + EXIT + CASE "L" // Logical + xRet := .F. + EXIT + CASE "N" // Number + xRet := 0 + EXIT + CASE "B" // code block + xRet := {|| NIL } + EXIT + CASE "A" // array + xRet := {} + EXIT + CASE "H" // hash + xRet := {=>} + EXIT + CASE "U" // undefined + xRet := NIL + EXIT + CASE "O" // Object + xRet := NIL // Or better another value ? + EXIT + + OTHERWISE + // Create a runtime error for new datatypes + xRet := "" + IF xRet == 0 // BANG! + ENDIF + ENDSWITCH + + RETURN xRet diff --git a/harbour/contrib/xhb/dumpvar.prg b/harbour/contrib/xhb/dumpvar.prg index 6b5be28066..ba6aa1c063 100644 --- a/harbour/contrib/xhb/dumpvar.prg +++ b/harbour/contrib/xhb/dumpvar.prg @@ -50,9 +50,10 @@ * */ -#include "common.ch" #include "hbclass.ch" +#include "common.ch" + #define CRLF HB_OsNewLine() /* @@ -81,257 +82,257 @@ PROCEDURE __OutDebug( ... ) */ FUNCTION HB_DumpVar( xVar, lRecursive, nMaxRecursionLevel ) - LOCAL nRecursionLevel := 1 - LOCAL nIndent := 0 + LOCAL nRecursionLevel := 1 + LOCAL nIndent := 0 - //TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive ) + //TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive ) - DEFAULT nMaxRecursionLevel TO 0 + DEFAULT nMaxRecursionLevel TO 0 -RETURN __HB_DumpVar( xVar,, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + 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 cType := ValType( xVar ) + LOCAL cString := "", cKey - DEFAULT lAssocAsObj TO FALSE - DEFAULT lRecursive TO FALSE + DEFAULT lAssocAsObj TO FALSE + DEFAULT lRecursive TO FALSE - //TraceLog( "Recursion: xVar, nRecursionLevel, nMaxRecursionLevel", xVar, nRecursionLevel, nMaxRecursionLevel ) + //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 + // return if there is limit in recursion + IF nMaxRecursionLevel > 0 .AND. ; + nRecursionLevel > nMaxRecursionLevel + RETURN AsString( xVar ) + ENDIF - DO CASE - CASE cType == "O" + DO CASE + CASE cType == "O" - IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY" - cString += Space( nIndent ) + "Type='Associative' -> " + CRLF - // Keys extraction. - IF Len( xVar:Keys ) > 0 - cString += Space( nIndent ) + "{" + CRLF - FOR EACH cKey IN xVar:Keys - cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + CRLF - IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH" - cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF - cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) - cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF - ENDIF - NEXT - cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF - cString += Space( nIndent ) + "}" + CRLF - ENDIF - ELSE - cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + CRLF - cString += Space( nIndent ) + " | " + CRLF - cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + CRLF - cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - cString += Space( nIndent ) + " +- PROTECTED:" + CRLF - cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + CRLF - cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY" + cString += Space( nIndent ) + "Type='Associative' -> " + CRLF + // Keys extraction. + IF Len( xVar:Keys ) > 0 + cString += Space( nIndent ) + "{" + CRLF + FOR EACH cKey IN xVar:Keys + cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + CRLF + IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH" + cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF + cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) + cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF + ENDIF + NEXT + cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF + cString += Space( nIndent ) + "}" + CRLF + ENDIF + ELSE + cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + CRLF + cString += Space( nIndent ) + " | " + CRLF + cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + CRLF + cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + cString += Space( nIndent ) + " +- PROTECTED:" + CRLF + cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + CRLF + cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) #ifdef __XHARBOUR__ - cString += Space( nIndent ) + " +- PUBLISHED:" + CRLF - cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) + cString += Space( nIndent ) + " +- PUBLISHED:" + CRLF + cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) #endif - cString += Space( nIndent ) + " +----------->" + CRLF - ENDIF + cString += Space( nIndent ) + " +----------->" + CRLF + ENDIF - CASE cType == "A" - IF nRecursionLevel == 1 - cString += Space( nIndent ) + "Type='A' -> { Array of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF - ENDIF - IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel - cString += AsString( xVar ) - ELSE - cString += DShowArray( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - ENDIF + CASE cType == "A" + IF nRecursionLevel == 1 + cString += Space( nIndent ) + "Type='A' -> { Array of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF + 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 }" + CRLF - ENDIF - IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel - cString += AsString( xVar ) - ELSE - cString += DShowHash( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - ENDIF + CASE cType == "H" + IF nRecursionLevel == 1 + cString += Space( nIndent ) + "Type='H' -> { Hash of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF + 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 ) + CRLF - ENDCASE + OTHERWISE + cString += Space( nIndent ) + AsString( xVar ) + CRLF + ENDCASE -RETURN cString + RETURN cString STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - LOCAL xProp, aProps - LOCAL aMethods, aMth - LOCAL lOldScope - LOCAL cString := "" + LOCAL xProp, aProps + LOCAL aMethods, aMth + LOCAL lOldScope + LOCAL cString := "" - DEFAULT nIndent TO 0 + DEFAULT nIndent TO 0 - IF ValType( oVar ) == "O" - lOldScope := __SetClassScope( .F. ) - aMethods := __objGetMsgFullList( oVar, .F., HB_MSGLISTALL, nScope ) - aProps := __objGetValueFullList( oVar, NIL, nScope ) - __SetClassScope( lOldScope ) + IF ValType( oVar ) == "O" + 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 ------" + CRLF - 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 ] ) + CRLF - IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO" - cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ],, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) + CRLF - ENDIF - NEXT - cString += Space( nIndent ) + " | +- >> End Data ------" + CRLF - cString += Space( nIndent ) + " | " + CRLF - ENDIF - IF Len( aMethods ) > 0 - cString += Space( nIndent ) + " | +- >> Begin Methods ------" + CRLF - 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] ) + "] " + CRLF - NEXT - cString += Space( nIndent ) + " | +- >> End Methods ------" + CRLF - cString += Space( nIndent ) + " | " + CRLF - ENDIF - ENDIF - IF Empty( cString ) - cString := Space( nIndent ) + " | " + CRLF - ENDIF -RETURN cString + IF Len( aProps ) > 0 + cString += Space( nIndent ) + " | +- >> Begin Data ------" + CRLF + 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 ] ) + CRLF + IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO" + cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ],, lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + CRLF + ENDIF + NEXT + cString += Space( nIndent ) + " | +- >> End Data ------" + CRLF + cString += Space( nIndent ) + " | " + CRLF + ENDIF + IF Len( aMethods ) > 0 + cString += Space( nIndent ) + " | +- >> Begin Methods ------" + CRLF + 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] ) + "] " + CRLF + NEXT + cString += Space( nIndent ) + " | +- >> End Methods ------" + CRLF + cString += Space( nIndent ) + " | " + CRLF + ENDIF + ENDIF + IF Empty( cString ) + cString := Space( nIndent ) + " | " + CRLF + ENDIF + RETURN cString STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - LOCAL xVal, nChar - LOCAL cString := "" + LOCAL xVal, nChar + LOCAL cString := "" - DEFAULT nIndent TO 0 + DEFAULT nIndent TO 0 - //TraceLog( "DShowArray: aVar, lRecursive", aVar, lRecursive ) + //TraceLog( "DShowArray: aVar, lRecursive", aVar, lRecursive ) - IF ValType( aVar ) == "A" - 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 ) + "{" + CRLF - FOR EACH xVal IN aVar - cString += Space( nIndent ) + " ["+ LTrim( StrZero( HB_EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + CRLF - IF lRecursive .AND. ValType( xVal ) $ "AOH" - cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF - cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) - cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF - ENDIF - NEXT - IF Len( aVar ) > 0 - cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF - ENDIF - cString += Space( nIndent ) + "}" + CRLF - ENDIF + IF ValType( aVar ) == "A" + 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 ) + "{" + CRLF + FOR EACH xVal IN aVar + cString += Space( nIndent ) + " ["+ LTrim( StrZero( HB_EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + CRLF + IF lRecursive .AND. ValType( xVal ) $ "AOH" + cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF + cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) + cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF + ENDIF + NEXT + IF Len( aVar ) > 0 + cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF + ENDIF + cString += Space( nIndent ) + "}" + CRLF + ENDIF -RETURN cString + RETURN cString STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel ) - LOCAL xVal, xKey, aKeys - LOCAL cString := "" + LOCAL xVal, xKey, aKeys + LOCAL cString := "" - DEFAULT nIndent TO 0 + DEFAULT nIndent TO 0 - //TraceLog( "DShowHash: hVar, ValType( hVar ), lRecursive", hVar, ValType( hVar ), ValToPrg( hVar ), lRecursive ) + //TraceLog( "DShowHash: hVar, ValType( hVar ), lRecursive", hVar, ValType( hVar ), ValToPrg( hVar ), lRecursive ) - IF ValType( hVar ) == "H" - aKeys := HGetKeys( hVar ) - cString += Space( nIndent ) + "{" + CRLF - FOR EACH xKey IN aKeys - xVal := hVar[ xKey ] - cString += Space( nIndent ) + " ["+ LTrim( AsString( xKey ) ) + "] => " + AsString( xVal ) + ", " + CRLF - IF lRecursive .AND. ValType( xVal ) $ "AOH" - cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF - cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) - cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF - ENDIF - NEXT - IF Len( aKeys ) > 0 - cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF - ENDIF - cString += Space( nIndent ) + "}" + CRLF - ENDIF + IF ValType( hVar ) == "H" + aKeys := hb_HGetKeys( hVar ) + cString += Space( nIndent ) + "{" + CRLF + FOR EACH xKey IN aKeys + xVal := hVar[ xKey ] + cString += Space( nIndent ) + " ["+ LTrim( AsString( xKey ) ) + "] => " + AsString( xVal ) + ", " + CRLF + IF lRecursive .AND. ValType( xVal ) $ "AOH" + cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF + cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) + cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF + ENDIF + NEXT + IF Len( aKeys ) > 0 + cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF + ENDIF + cString += Space( nIndent ) + "}" + CRLF + ENDIF -RETURN cString + RETURN cString STATIC FUNCTION DecodeScope( nScope AS NUMERIC ) - LOCAL cString := "" + LOCAL cString := "" - IF hb_BitAnd( nScope, HB_OO_CLSTP_EXPORTED ) # 0 // 1 - cString += "Ex," - ENDIF + 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 + 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 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 cString[-1] == "," - cString := SubStr( cString, 1, Len(cString)-1 ) - ENDIF + IF Right( cString, 1 ) == "," + cString := SubStr( cString, 1, Len(cString)-1 ) + ENDIF -RETURN PadR( cString, 18 ) + RETURN PadR( cString, 18 ) STATIC FUNCTION DecodeType( nType AS NUMERIC ) - LOCAL cString := "" + 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" - ENDCASE + 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" + ENDCASE -RETURN PadR( cString, 7 ) + RETURN PadR( cString, 7 ) STATIC FUNCTION asString( x ) - local v := ValType( x ) + LOCAL v := ValType( x ) DO CASE CASE v == "C" @@ -340,4 +341,4 @@ STATIC FUNCTION asString( x ) RETURN cStr( x ) ENDCASE -RETURN x + RETURN x