/*
 * Xailer source code:
 *
 * ExStruct.prg
 * Manejo de estructuras personalizadas
 *
 * Copyright 2003, 2007 Ignacio Ortiz de Zúñiga
 * Copyright 2003, 2007 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#include "Error.ch"

#define STRUCT_NAME        1
#define STRUCT_VALUE       2
#define STRUCT_TYPE        3
#define STRUCT_SIZE        4
#define STRUCT_DEFAULT     5
#define STRUCT_JSONFORMAT  6
#define STRUCT_LEN         6

STATIC aStruc := {}

//--------------------------------------------------------------------------

CLASS XExStruct

PUBLIC:
   DATA aMembers
   DATA hMembers
   DATA lPadStrings  INIT .F.

   METHOD New() CONSTRUCTOR
   METHOD End()

   METHOD AddMember( xName, cType, xDefault, nSize, cJson ) // --> Nil
   METHOD MemberList() // --> cList
   METHOD GetKeys() // --> aKeys
   METHOD GetValues() // --> aValues
   METHOD GetDefaults() // --> aValues
   METHOD SetValues( aData ) // --> Nil
   METHOD Reset() // --> Nil
   METHOD Clone() // --> oStruct
   METHOD Len()   INLINE Len( ::aMembers ) // -->nLen

   METHOD GetMember( xMember ) // --> nOrder
   METHOD GetValue( xMember ) // --> uValue
   METHOD SetValue( xMember, xValue ) // --> Nil
   METHOD Modified( xMember ) // --> lValue
   METHOD ToJson( lType )

   METHOD GetName( nMember ) INLINE ::aMembers[ nMember, STRUCT_NAME ] // --> cName

   ERROR HANDLER OnError( uParam1 )

ENDCLASS

//--------------------------------------------------------------------------

METHOD New() CLASS XExStruct

   ::aMembers := {}
   ::hMembers := HB_Hash()

RETURN Self

//--------------------------------------------------------------------------

METHOD End() CLASS XExStruct

   ::aMembers := NIL
   ::hMembers := NIL

RETURN NIL

//--------------------------------------------------------------------------

METHOD MemberList() CLASS XExStruct

   LOCAL cStr := ""

   AEval( ::aMembers, {|v| cStr += v[ STRUCT_NAME ] + CRLF } )

RETURN cStr

//--------------------------------------------------------------------------

METHOD GetKeys() CLASS XExStruct

   LOCAL aKeys := Array( Len( ::aMembers ) )

   AEval( ::aMembers, {|v,e| aKeys[ e ] := v[ STRUCT_NAME ] } )

RETURN aKeys

//--------------------------------------------------------------------------

METHOD GetValues() CLASS XExStruct

   LOCAL aValues := Array( Len( ::aMembers ) )

   AEval( ::aMembers, {|v,e| aValues[ e ] := v[ STRUCT_VALUE ] } )

RETURN aValues

//--------------------------------------------------------------------------

METHOD GetDefaults() CLASS XExStruct

   LOCAL aValues := Array( Len( ::aMembers ) )

   AEval( ::aMembers, {|v,e| aValues[ e ] := v[ STRUCT_DEFAULT ] } )

RETURN aValues

//--------------------------------------------------------------------------

METHOD SetValues( aData ) CLASS XExStruct

   AEval( ::aMembers, {|v,e| v[ STRUCT_VALUE ] := aData[ e ] } )

RETURN Nil

//--------------------------------------------------------------------------

METHOD Reset() CLASS XExStruct

   AEval( ::aMembers, {|v| v[ STRUCT_VALUE ] := v[ STRUCT_DEFAULT ] } )

RETURN Nil

//--------------------------------------------------------------------------

METHOD Clone() CLASS XExStruct

   LOCAL oStruct

   oStruct := XExStruct():New()

   oStruct:aMembers := aClone( ::aMembers )
   oStruct:hMembers := ::hMembers

RETURN oStruct

//--------------------------------------------------------------------------

METHOD AddMember( xName, cType, xDefault, nSize, cJson ) CLASS XExStruct

   LOCAL aNames, aMember
   LOCAL nFor

   IF Valtype( xName ) == "C"
      aNames := { xName }
   ELSE
      aNames := xName
   ENDIF

   IF cType != Nil
      cType := Upper( cType )
      DO CASE
         CASE cType == "L" .OR. cType == "LOGICAL"
            DEFAULT xDefault TO .F.
            nSize := 1
            cType := "L"

         CASE cType == "N" .OR. cType == "NUMERIC" .OR. cType == "NUMBER"
            DEFAULT xDefault TO 0
            cType := "N"

         CASE cType == "D" .OR. cType == "DATE"
            DEFAULT xDefault TO CToD( "" )
            nSize := 8
            cType := "D"

         CASE cType == "T" .OR. cType == "DATETIME"
            DEFAULT xDefault TO HB_CToT("")
            nSize := 21
            cType := "T"

         CASE cType == "C" .OR. cType == "CHARACTER" .OR. cType == "STRING" .OR. cType = "M" .OR. cType = "MEMO"
            DEFAULT xDefault TO ""
            cType := "C"

         CASE cType == "B" .OR. cType == "BLOCK"
            DEFAULT xDefault TO {|| Nil }
            cType := "B"

         CASE cType == "A" .OR. cType == "ARRAY"
            DEFAULT xDefault TO {}
            cType := "A"

         CASE cType == "O" .OR. cType == "OBJECT"
            DEFAULT xDefault TO NIL
            cType := "O"
         CASE cType == "H" .OR. cType == "HASH"
            DEFAULT xDefault TO {=>}
            cType := "H"
         CASE cType == "U" .OR. cType == "UNDEFINED"
            DEFAULT xDefault TO NIL
            cType := "U"
         OTHERWISE
            WITH OBJECT ErrorNew()
               :Subsystem := "XAILER"
               :SubCode   := 0
               :Severity    := ES_ERROR
               :Description := "TExStruct: Invalid type (" + cType + ") for member: " + aNames[ 1 ]
               Eval( ErrorBlock(), :__WithObject() )
            END WITH
         ENDCASE
   ENDIF

   FOR nFor := 1 TO Len( aNames )
      AAdd( ::aMembers, Array( STRUCT_LEN ) )
      aMember := ATail( ::aMembers )
      aMember[ STRUCT_NAME ]       := Upper( aNames[ nFor ] )
      aMember[ STRUCT_VALUE ]      := xDefault
      aMember[ STRUCT_TYPE ]       := cType
      aMember[ STRUCT_SIZE ]       := nSize
      aMember[ STRUCT_DEFAULT ]    := xDefault
      aMember[ STRUCT_JSONFORMAT ] := cJson
      HB_HSet( ::hMembers, aMember[ STRUCT_NAME ], Len( ::aMembers ) )
   NEXT

RETURN Nil

//--------------------------------------------------------------------------

METHOD GetMember( xMember ) CLASS XExStruct

   LOCAL oError
   LOCAL nMember

   IF Valtype( xMember ) == "C"
      xMember := Upper( xMember )
      nMember := HB_HGet( ::hMembers, xMember )
   ELSE
      nMember := xMember
   ENDIF

   IF ( nMember <= 0 .OR. nMember > Len( ::aMembers ) )
      oError := ErrorNew()
      oError:Subsystem   := "TEXSTRUC"
      oError:Severity    := ES_ERROR
      oError:Description := "Structure Member does not exist"
      oError:Operation   := ToString( xMember )
      Eval( ErrorBlock(), oError )
   ENDIF

RETURN nMember

//--------------------------------------------------------------------------

METHOD GetValue( xMember ) CLASS XExStruct

   LOCAL nMember := ::GetMember( xMember )

RETURN IIf( Empty( nMember ), Nil, ::aMembers[ nMember ][ STRUCT_VALUE ] )

//--------------------------------------------------------------------------

METHOD SetValue( xMember, xValue ) CLASS XExStruct

   LOCAL oError
   LOCAL cType
   LOCAL nMember

   nMember := ::GetMember( xMember )

   IF Empty( nMember )
      RETURN Nil
   ENDIF

   cType := ::aMembers[ nMember ][ STRUCT_TYPE ]

   IF cType != Nil
      IF cType != Valtype( xValue )
         DO CASE
            CASE cType == "C"
               xValue := ToString( xValue, "" )
            CASE cType == "N"
               xValue := Val( xValue )
            CASE cType == "D"  .and. Valtype( xValue ) == "C"
               xValue := Ctod( xValue )
            CASE cType == "L"  .and. Valtype( xValue ) == "C"
               xValue := Upper( xValue )
               xValue := ( xValue $ "TYS" .or. xValue == ".T." )
            CASE cType == "L"  .and. Valtype( xValue ) == "N"
               xValue := ( xValue != 0 )
            OTHERWISE
               oError := ErrorNew()
               oError:Subsystem   := "TSTRUC"
               oError:Severity    := ES_ERROR
               oError:Description := "Data type error " + ;
                                     ::aMembers[ nMember ][ STRUCT_NAME ] + " (" + cType + ")"
               oError:Operation   := ToString( xValue ) +  " (" + ValType( xValue ) + ")"
               Eval( ErrorBlock(), oError )
         ENDCASE
      ENDIF
      IF cType == "C" .AND. ::aMembers[ nMember ][ STRUCT_SIZE ] != Nil
         IF Len( xValue ) > ::aMembers[ nMember ][ STRUCT_SIZE ]
            xValue := Left( xValue, ::aMembers[ nMember ][ STRUCT_SIZE ] )
         ENDIF
         IF ::lPadStrings
           xValue := PadR( xValue, ::aMembers[ nMember ][ STRUCT_SIZE ] )
         ENDIF
      ENDIF
   ENDIF

   ::aMembers[ nMember ][ STRUCT_VALUE ] := xValue

RETURN xValue

//--------------------------------------------------------------------------

METHOD Modified( xMember ) CLASS XExStruct

   LOCAL nMember := ::GetMember( xMember )

   IF !Empty( nMember )
      RETURN !( ::aMembers[ nMember ][ STRUCT_VALUE ] == ::aMembers[ nMember ][ STRUCT_DEFAULT ] )
   ENDIF

RETURN .F.

//--------------------------------------------------------------------------

METHOD ToJson( lType ) CLASS XExStruct

   LOCAL hData := Struct2Hash( Self )

RETURN HB_JsonEncode( hData, .T. )

//--------------------------------------------------------------------------

STATIC FUNCTION Struct2Hash( oSt, hash )

   LOCAL aMember, aClone
   LOCAL cName, cType, cJson
   LOCAL nFor
   LOCAL hTmp, xVal, cOld

   DEFAULT hash TO {=>}

   FOR EACH aMember IN oSt:aMembers

      cName := aMember[ STRUCT_NAME ]
      cType := aMember[ STRUCT_TYPE ]
      xVal  := aMember[ STRUCT_VALUE ]
      cJson := aMember[ STRUCT_JSONFORMAT ]

      IF Empty( cType )
         IF ValType( xVal ) == "A"
            aClone := aClone( xVal )
            FOR nFor := 1 TO Len( aClone )
               xVal := aClone[ nFor ]
               hTmp := {=>}
               IF ValType( xVal ) == "O" .AND. xVal:IsKindOf( "XExStruct" )
                  aClone[ nFor ] := Struct2Hash( xVal, hTmp )
               ENDIF
            NEXT
            HB_HSet( hash, cName , aClone )
         ENDIF
         LOOP
      ENDIF

      SWITCH cType
      CASE "L"
      CASE "N"
      CASE "C"
         HB_HSet( hash, cName, xVal )
         EXIT
      CASE "D"
         HB_HSet( hash, cName, HB_DToC( xVal, cJson ) )
         EXIT
      CASE "T"
         IF !Empty( cJson )
            HB_HSet( hash, cName,;
               HB_TToC( xVal,;
                        HB_TokenGet(cJson, 1, " " ),;
                        HB_TokenGet(cJson, 2, " " ) ) )
         ELSE
            HB_HSet( hash, cName, xVal )
         ENDIF
         EXIT
      CASE "O"
         IF xVal:IsKindOf( "XExStruct" )
            hTmp := {=>}
            HB_HSet( hash, cName , hTmp )
            Struct2Hash( xVal, hTmp )
         ENDIF
         EXIT
      END SWITCH
   NEXT

RETURN hash

//--------------------------------------------------------------------------

METHOD OnError( uParam ) CLASS XExStruct

   LOCAL cMember := __GetMessage()

   IF SubStr( cMember, 1, 1 ) == "_"                // Set
      RETURN ::SetValue( Substr( cMember, 2 ), uParam )
   ENDIF

RETURN ::GetValue ( cMember )

//--------------------------------------------------------------------------

RESERVED FUNCTION StructBegin( cStruc ) // --> oStruct

   LOCAL oStruc
   LOCAL nLen

   nLen   := Len( aStruc )
   oStruc := AAdd( aStruc, TExStruct():New() )

   IF nlen > 0 .AND. !Empty( cStruc )
      aStruc[ nLen ]:AddMember( cStruc, "OBJECT", oStruc )
   ENDIF

RETURN oStruc

//--------------------------------------------------------------------------

RESERVED FUNCTION StructEnd()  // --> Nil

   ADel( aStruc, Len( aStruc ) )
   ASize( aStruc, Len( aStruc ) - 1 )

RETURN Nil

//--------------------------------------------------------------------------

RESERVED FUNCTION StructMember( aNames, cType, xDefault, nSize, cJson )   // --> Nil

   ATail( aStruc ):AddMember( aNames, cType, xDefault, nSize, cJson )

RETURN Nil

//--------------------------------------------------------------------------