/*
 * Xailer source code:
 *
 * SqlQuery.prg
 * Clase TSqlProc()
 *
 * Copyright 2003, 2018 Ignacio Ortiz de Zúñiga
 * Copyright 2003, 2018 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#include "Dataset.ch"
#include "error.ch"

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

CLASS XSQLProc FROM TComponent

PUBLISHED:
   PROPERTY oDataSource     WRITE INLINE ::SetDataSource( Value ) ;
                            AS TDataSource EDITOR PE_Component
	PROPERTY aSQLParams      INIT {} AS TSqlParams[] EDITOR PE_SQLParams
	PROPERTY cName           INIT "" EDITOR PE_ExtendedString
   PROPERTY lDisplayErrors  INIT .T.
   PROPERTY lOpen           INIT .F. WRITE INLINE IIF( Value, ::Open(), ::Close() )

   EVENT OnCreate( oSender ) // --> Nil
   EVENT OnOpen( oSender ) // --> lResult
   EVENT OnPostOpen( oSender ) // --> Nil
   EVENT OnClose( oSender ) // --> lResult
   EVENT OnPostClose( oSender ) // --> Nil

PUBLIC:
   PROPERTY aResults        INIT {} AS TMemDataSet[]
   METHOD Open()
   METHOD Close()
   METHOD Run()             INLINE ::Open()
   METHOD AddParam( cName, nDirection, nType, nSize, Initial ) INLINE ;
          TSqlParam():Create( Self, cName, nDirection, nType, nSize, Initial )
   METHOD ParamByName( cName )
   METHOD ReturnValue( oSqlParam )
   METHOD OutputParams()

   METHOD Create( oParent, oDS, cName ) CONSTRUCTOR
   METHOD Destroy( lFree )

PROTECTED:
   PROPERTY lAbortOnErrors  INIT .F.
   METHOD SetDataSource( oDataSource )

RESERVED:
   METHOD AddDataset( aData, aHeaders )
   METHOD SetParamValues( aValues )
   METHOD NewError( cText, nError )

   ERROR HANDLER OnError( uParam )

ENDCLASS

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

METHOD Create( oParent, oDS, cName ) CLASS XSQLProc

   ::Super:Create( oParent )

   UPDATE ::oDataSource TO oDS
   UPDATE ::cName       TO cName

   ::OnCreate()

   IF ::oParent != Nil
      ::oParent:InsertComponent( Self )
   ENDIF

RETURN Self

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

METHOD Destroy( lFree ) CLASS XSQLProc

   ::Close()

   AEval( ::aSQLParams, {|v| v:End() } )

   ::aSQLParams := {}
   ::oDataSource := NIL

   IF ::oParent != Nil
      ::oParent:RemoveComponent( Self )
   ENDIF

RETURN ::Super:Destroy( lFree )

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

METHOD Close() CLASS XSQLProc

   LOCAL lCancel

   IF ::FlOpen
      lCancel := ::OnClose()
      IF Valtype( lCancel ) == "L" .AND. ! lCancel
         RETURN .F.
      ENDIF
      AEval( ::aResults, {|v| v:End() } )
      ::aResults := {}
      ::FlOpen   := .F.
      ::OnPostClose()
   ENDIF

RETURN .T.

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

METHOD SetDataSource( oDataSource ) CLASS XSqlProc

   ::Close()
   ::FoDataSource := oDataSource

RETURN Nil

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

METHOD Open() CLASS XSQLProc

   LOCAL lCancel

   IF Empty( ::oDataSource )
      ::NewError( "No DataSource, impossible to continue" )
      RETURN .F.
   ENDIF

   IF ::flOpen
      ::NewError( "TSqlProc " + LT( XA_MSG_YA_ESTA_ABIERTO ) )
      RETURN .T.
   ENDIF

   IF !::oDataSource:lConnected .and. !::oDataSource:Connect()
      ::NewError( "No connection with DataSource" )
      RETURN .F.
   ENDIF

   lCancel := ::OnOpen()

   IF Valtype( lCancel ) == "L" .AND. ! lCancel
      RETURN .F.
   ENDIF

   ::FlOpen := ::oDataSource:RunProc( Self )

   IF ::flopen
      ::OnPostOpen()
   ENDIF

RETURN ::flOpen

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

METHOD ParamByName( cName ) CLASS XSQLProc

   LOCAL nAt

   cName := Upper( cName )

   nAt := Ascan( ::aSQLParams, {|v| Upper( v:cName ) == cName } )

   IF nAt > 0
      RETURN ::aSQLParams[ nAt ]
   ENDIF

RETURN NIL

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

METHOD ReturnValue( oSqlParam ) CLASS XSQLProc

   LOCAL nAt := Ascan( ::aSQLParams, {|v| v:nDirection = adParamReturnValue } )

   IF nAt > 0
      oSqlParam := ::aSQLParams[ nAt ]
      RETURN oSqlParam:Value
   ELSEIF !Empty( ::aResults )
      WITH OBJECT ::aResults[ 1 ]
         IF :RecCount() == 1 .AND. :FieldCount() == 1
            RETURN :FieldGet( 1 )
         ELSE
            RETURN ::aResults[ 1 ]
         ENDIF
      END WITH
   ENDIF

RETURN NIL

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

METHOD OutputParams() CLASS XSqlProc

   LOCAL aParams
   LOCAL nFor

   aParams := {}

   FOR nFor := 1 TO Len( ::aSQLParams )
      IF ::aSQLParams[ nFor ]:IsOutputParam
         Aadd( aParams, ::aSQLParams[ nFor ] )
      ENDIF
   NEXT

RETURN aParams

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

METHOD AddDataset( aData, aHeaders ) CLASS XSQLProc

   LOCAL oRs AS CLASS TMemDataSet

   IF !Empty( aData )
      oRs := TMemDataSet():Create()
      oRs:Open( aData, aHeaders )
      AAdd( ::aResults, oRs )
   ENDIF

RETURN !Empty( aData )

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

METHOD SetParamValues( aValues ) CLASS XSQLProc

   LOCAL nFor, nLen

   nLen := Min( Len( aValues ), Len( ::aSQLParams ) )

   FOR nFor := 1 TO nLen
      WITH OBJECT ::aSQLParams[ nFor ]
         IF :IsInputParam()
            :Value := aValues[ nFor ]
         ENDIF
      END WITH
   NEXT

RETURN NIL

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

METHOD NewError( cText, nError ) CLASS XSqlProc

   IF ::lDisplayErrors
      MsgAlert( cText, "Xailer: TSQLProc error")
   ELSE
      LogDebug( cText )
   ENDIF

   IF ::lAbortOnErrors
      WITH OBJECT ErrorNew()
         :Subsystem   := "XAILER"
         IF ! Empty( nError )
            :SubCode  := nError
         ENDIF
         :Severity    := ES_ERROR
         :Description := cText
         Eval( ErrorBlock(), :__WithObject() )
      END WITH
   ENDIF

RETURN Nil

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

METHOD OnError( uParam ) CLASS XSqlProc

   LOCAL oParam AS CLASS TSqlParam
   LOCAL oError
   LOCAL cName
   LOCAL nError

   DEFAULT uParam TO dsAUTO

   cName := __GetMessage()

   IF Left( cName, 1 ) == "_" // SET
      oParam := ::ParamByName( SubStr( cName, 2 ) )
      IF oParam != NIL
         oParam:Value := uParam
         RETURN uParam
      ENDIF
      nError := 1005
   ELSE
      oParam := ::ParamByName( cName )
      IF oParam != NIL
         IF uParam = dsOBJECT
            RETURN oParam
         ELSE
            RETURN oParam:Value
         ENDIF
      ENDIF
      nError := 1004
   ENDIF

   oError := ErrorNew()
   oError:SubSystem   := "XAILER"
   oError:SubCode     := nError
   oError:Severity    := ES_ERROR
   oError:Description := "Message or Sql parameter object not found"
   oError:Operation   := ::ClassName() + ":" + cName
   oError:Args        := { uParam }

   Eval( ErrorBlock(), oError )

RETURN Nil

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

CLASS XSqlParam FROM TComponent

PUBLISHED:
   PROPERTY oSqlProc  AS TSqlProc
   PROPERTY cName     INIT ""
   PROPERTY nSize     INIT 0

   PROPERTY nType     INIT adEmpty ;
            VALUES adBSTR, adBigInt, adBinary, adBoolean, adChar, adCurrency,;
            adDBDate, adDBTime, adDBTimeStamp, adDate, adDecimal, adDouble,;
            adEmpty, adInteger, adLongVarBinary, adLongVarChar, adLongVarWChar,;
            adNumeric, adSingle, adSmallInt, adTinyInt, adUnsignedBigInt,;
            adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt, adVarBinary,;
            adVarChar, adVarNumeric, adVarWChar, adWChar

   PROPERTY nDirection  INIT adParamUnknown ;
            VALUES adParamUnknown, adParamInput, adParamOutput,;
            adParamInputOutput, adParamReturnValue

   PROPERTY Initial   INIT ""
   PROPERTY Value     READ INLINE IIF( ::fValue == NIL, ::Initial, ::fValue )

PUBLIC:
   METHOD Create( oSqlProc, cName, nDirection, nType, nSize, Initial ) CONSTRUCTOR
   METHOD IsInputParam() INLINE (::nDirection == adParamInput) .OR. (::nDirection = adParamInputOutput )
   METHOD IsOutputParam() INLINE (::nDirection == adParamOutput) .OR. (::nDirection = adParamInputOutput )

RESERVED:
   METHOD BasicType() // --> cType

ENDCLASS

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

METHOD Create( oSqlProc, cName, nDirection, nType, nSize, Initial ) CLASS XSqlParam

   DEFAULT nDirection TO adParamInput
   DEFAULT nType      TO adEmpty
   DEFAULT nSize      TO 0

   ::Super:Create( oSqlProc )

   ::oSqlProc     := oSqlProc
   ::cName        := cName
   ::nDirection   := nDirection
   ::nType        := nType
   ::nSize        := nSize
   ::Initial      := Initial

   IF Initial != NIL
      IF ::nType == adEmpty
         SWITCH ValType( Initial )
         CASE "L"
            ::nType := adBoolean	
            ::nSize := 1
            EXIT
         CASE "N"
            ::nType := adInteger
            ::nSize := 11
         CASE "C"
            ::nType := adChar	
            ::nSize := 250
         CASE "D"
            ::nType := adDBTimeStamp
            ::nSize := 15
         END CASE
      ENDIF
   ENDIF

   IF oSqlProc <> nil
      AAdd( ::oSqlProc:aSQLParams, Self )
   ENDIF

RETURN Self

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

METHOD BasicType() CLASS XSqlParam

   LOCAL cRet := "U"

   SWITCH ::nType
   CASE adEmpty
      cRet := "U"
      EXIT
   CASE adBoolean
      cRet := "L"
      EXIT
   CASE adInteger
   CASE adBigInt
   CASE adDecimal
   CASE adDouble
   CASE adCurrency
   CASE adNumeric
   CASE adSingle
   CASE adSmallInt
   CASE adTinyInt
   CASE adUnsignedBigInt
   CASE adUnsignedInt
   CASE adUnsignedSmallInt
   CASE adUnsignedTinyInt
   CASE adVarNumeric
      cRet := "N"
      EXIT
   CASE adBinary
   CASE adBSTR
   CASE adChar
   CASE adDBDate
   CASE adDBTime
   CASE adDBTimeStamp
   CASE adLongVarBinary
   CASE adLongVarChar
   CASE adLongVarWChar
   CASE adVarBinary
   CASE adVarChar
   CASE adVarWChar
   CASE adWChar
      cRet := "C"
      EXIT
   CASE adDate
      cRet := "D"
      EXIT
   END SWITCH

RETURN cRet