FiveTech Software tech support forums

Code: Select all

#include "common.ch"

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 ]

        aDel( aParams, 1, .T. ) // 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
           aDel( aParams, nParams, .T. )
           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. ;
           ( ISARRAY( xDefault ) .OR. ;
             ValType( xDefault ) == "H" )

           // If it is an array I will restart this function creating a linear call
           IF ISARRAY( xDefault ) .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 ISARRAY( xDefault[ 1 ] )

                 //// 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 ! ISARRAY( ValType( xDefault[ nLen ] ) )

                    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
           aIns( aParams, 1, xVal, .T. )

           // 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 := DecEmptyValue( aParams[ 1 ] )

   ENDCASE

   RETURN xRet


STATIC FUNCTION DecEmptyValue( xVal )
   LOCAL xRet
   LOCAL cType := ValType( xVal )

   SWITCH cType
   CASE "C"  // Char
   CASE "M"  // Memo
        xRet := ""
        EXIT
   CASE "D"  // Date
        xRet := hb_STOD()
        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