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

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

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

CLASS XSQlProcs FROM TComponent

PUBLISHED:
   PROPERTY oDataSource AS TDataSource EDITOR PE_Component

   EVENT OnCreate( oSender ) // --> Nil

PUBLIC:
   PROPERTY aProcs INIT {} AS TSqlProc[]

PUBLIC:
   METHOD Create( oParent, oDS ) CONSTRUCTOR
   METHOD Destroy( lFree )
   METHOD AddProc( oProc ) INLINE Aadd( ::aProcs, oProc )
   METHOD DelProc( oProc )
   METHOD ProcByName( cProc ) // --> TSqlProc

RESERVED:
   ERROR HANDLER OnError( uParam )

PROTECTED:

ENDCLASS

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

METHOD Create( oParent, oDS ) CLASS XSqlProcs

   ::Super:Create( oParent )

   UPDATE ::oDataSource TO oDS

   ::OnCreate()

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

RETURN Self

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

METHOD Destroy( lFree ) CLASS XSQlProcs

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

   ::aProcs := {}
   ::oDataSource := NIL

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

RETURN ::Super:Destroy( lFree )

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

METHOD DelProc( oProc ) CLASS XSQlProcs

   LOCAL nAt

   nAt := AScan( ::aProcs, {|v| v == oProc } )

   IF nAt > 0
      HB_ADel(::aProcs, nAt, .t. )
   ENDIF

RETURN NIL

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

METHOD ProcByName( cProc ) CLASS XSQlProcs

   LOCAL oProc AS CLASS TSqlProc
   LOCAL nAt

   cProc := Upper( cProc )
   nAt   := AScan( ::aProcs, {|v| Upper( v:cName ) == cProc } )

   IF nAt > 0
      oProc := ::aProcs[ nAt ]
   ENDIF

RETURN oProc

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

METHOD OnError( uParam ) CLASS XSqlProcs

   LOCAL oProc AS CLASS TSqlProc
   LOCAL oError
   LOCAL cName
   LOCAL nError

   DEFAULT uParam TO dsAUTO

   cName := __GetMessage()

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

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

   Eval( ErrorBlock(), oError )

RETURN Nil