/*
 * Xailer source code:
 *
 * MySQL.prg
 * Clase TMySQLDataSource
 *
 * Copyright 2007 Jose F. Gimenez
 * Copyright 2007 Xailer.com
 * All rights reserved
 *
 */

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


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

CLASS XMySQLDataSource FROM TDataSource

PUBLISHED:
   PROPERTY cHost       INIT ""
   PROPERTY nPort       INIT 3306
   PROPERTY cUser       INIT ""
   PROPERTY cPassword   INIT ""  WRITE SetPassword
   PROPERTY cDatabase   INIT ""  WRITE METHOD SetDatabase EDITOR PE_DataSourceCatalogs
   PROPERTY nTimeOut    INIT 1000
   PROPERTY lAutoReconnect INIT .F.
   PROPERTY lConnected  // para forzar que vaya al final

   PROPERTY lAllowProcessMessages   INIT .T.

PUBLIC:
   PROPERTY cConnect      INIT ""
   PROPERTY nLastError    INIT 0
   PROPERTY cLastError    INIT ""
   PROPERTY nAffectedRows READONLY INIT 0
   DATA Handle            READONLY INIT 0

   METHOD Connect( cConnect ) // --> lSuccess
   METHOD Disconnect() // --> Nil

   METHOD SetPassword( cPassword )  INLINE ::FcPassword := cPassword
   METHOD SetDatabase( cDatabase ) // --> lSuccess

   METHOD Execute( cQuery, cOperation, @aData, @aHeaders, lHash ) // --> lSuccess
   METHOD SQLNextResult( @aData, @aHeaders ) // --> nError

   METHOD QueryValue( cCommand, uDefault ) // --> Value
   METHOD QueryRow( cCommand, aHeaders, aDefault ) // --> aRow
   METHOD QueryRowHash( cCommand, aHeaders, aDefault ) // --> hRow
   METHOD QueryArray( cCommand, aHeaders ) // --> aData
   METHOD QueryArrayHash( cCommand, aHeaders ) // --> aData
   METHOD Table( cTableName, cProcess ) // --> oTable
   METHOD Query( cCommand, cProcess ) // --> oQuery
   METHOD QueryReport( cCommand, cProcess ) // --> oQuery
   METHOD RunProc( oProc AS CLASS TSQLProc ) EXTERN XMariaDBDataSource_RunProc() // --> lSuccess

   METHOD DToSql( dValue )       INLINE IIF( Empty( dValue ), "0000-00-00", DToSql( dValue ) )
   METHOD GetDateSql( dValue )   INLINE IIF( Empty( dValue ), "0000-00-00", ::Super:GetDateSql( dValue ) )

   METHOD GetCatalogs() // --> aCatalogs
   METHOD GetTables( cMask, lViews ) // --> aFiles
   METHOD File( cName ) // --> lResult
   METHOD CreateTable( cName, aStruct, cEngine ) // --> lSuccess
   METHOD DelTable( cTable )  INLINE ::Execute( "DROP TABLE " + cTable ) // --> lSuccess

   METHOD BeginTrans()        INLINE ::Execute( "START TRANSACTION" ) // --> lSuccess
   METHOD CommitTrans()       INLINE ::Execute( "COMMIT" ) // --> lSuccess
   METHOD RollBackTrans()     INLINE ::Execute( "ROLLBACK" ) // --> lSuccess

RESERVED:
   DATA nNextPing    INIT 0
   DATA nBlockSize   INIT 0

   METHOD GetRecords( oDataSet, lForTable )
   METHOD Execute2( cQuery, aParams )
   METHOD SQLPrepare( cQuery, cOperation )
   METHOD GetColumnNames( hQuery )
   METHOD GetTablePrimaryKey( cTable )
   METHOD SQLGetRows( hQuery, @aData, nRows )
   METHOD SQLFinalize( hQuery )
   METHOD LastInsertId()
   METHOD GetBlockSize()

   METHOD CheckError( cArgument, nStackLevel )

ENDCLASS

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

METHOD QueryValue( cCommand, uDefault ) CLASS XMySQLDataSource

   LOCAL aData

   IF ::Execute( cCommand,, @aData ) .AND. Len( aData ) > 0 .AND. Len( aData[ 1 ] ) > 0 .AND. aData[ 1, 1 ] != Nil
      RETURN aData[ 1, 1 ]
   ENDIF

RETURN uDefault

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

METHOD QueryRow( cCommand, aHeaders, aDefault ) CLASS XMySQLDataSource

   LOCAL aData

   ::Execute( cCommand,, @aData, @aHeaders )

   IF !Empty( aData )
      aDefault := aData[ 1 ]
   ELSE
      DEFAULT aDefault TO {}
   ENDIF

RETURN aDefault

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

METHOD QueryRowHash( cCommand, aHeaders, aDefault ) CLASS XMySQLDataSource

   LOCAL aData

   ::Execute( cCommand,, @aData, @aHeaders, .T. )

   IF !Empty( aData )
      aDefault := aData[ 1 ]
   ELSE
      DEFAULT aDefault TO {}
   ENDIF

RETURN aDefault

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

METHOD QueryArray( cCommand, aHeaders ) CLASS XMySQLDataSource

   LOCAL aData

   ::Execute( cCommand,, @aData, @aHeaders )

RETURN aData

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

METHOD QueryArrayHash( cCommand, aHeaders ) CLASS XMySQLDataSource

   LOCAL aData

   ::Execute( cCommand,, @aData, @aHeaders, .T. )

RETURN aData

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

METHOD Table( cCommand, cProcess ) CLASS XMySQLDataSource

   DEFAULT cProcess TO ::cProcess

RETURN TSQLTable():Create( ::oParent, Self, cCommand, Upper( cProcess ) )

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

METHOD Query( cCommand, cProcess ) CLASS XMySQLDataSource

   DEFAULT cProcess TO ::cProcess

RETURN TSQLQuery():Create( ::oParent, Self, cCommand, Upper( cProcess ) )

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

METHOD QueryReport( cCommand, cProcess ) CLASS XMySQLDataSource

   DEFAULT cProcess TO ::cProcess

//RETURN TSQLQueryReport():Create( ::oParent, Self, cCommand, Upper( cProcess ) )
RETURN TSQLQuery():Create( ::oParent, Self, cCommand, Upper( cProcess ) )

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

METHOD GetRecords( oDataSet, lForTable ) CLASS XMySQLDataSource
/*
   IF oDataSet != Nil .AND. oDataSet:nCursorType == adOpenForwardOnly
      RETURN TSQLiteRecordsReport():Create( oDataSet, lForTable )
   ENDIF
*/
RETURN TMySQLRecords():Create( oDataSet, lForTable )

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

METHOD GetCatalogs() CLASS XMySQLDataSource

   LOCAL aData, aCatalogs := {}

   ::Execute( "SHOW databases",, @aData )
   AEval( aData, {| x | AAdd( aCatalogs, x[ 1 ] ) } )

return aCatalogs

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

METHOD GetTables( cMask, lViews ) CLASS XMySQLDataSource

   LOCAL aData, aFiles := {}
   LOCAL cCommand := "SHOW FULL TABLES"

   DEFAULT lViews TO .t.

   IF cMask != Nil
      cCommand += " LIKE '" + StrTran( cMask, "*", "%" ) + "'"
   ENDIF

   ::Execute( cCommand,, @aData )
   IF lViews
      AEval( aData, {| x | AAdd( aFiles, x[ 1 ] ) } )
   ELSE
      AEval( aData, {| x | IIF( At( "VIEW", Upper( x[ 2 ] ) ) == 0, AAdd( aFiles, x[ 1 ] ), ) } )
   ENDIF

return aFiles

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

METHOD File( cName ) CLASS xMySQLDataSource

   IF Empty( cName )
      RETURN .F.
   ENDIF

RETURN Len( ::GetTables( cName, .T. ) ) > 0

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

METHOD CreateTable( cName, aStruct, cEngine ) CLASS XMySQLDataSource

   LOCAL cSql := "CREATE TABLE " + cName + "( "
   LOCAL cPK := "", cType
   LOCAL n

   FOR n := 1 TO Len( aStruct )
      IF n > 1
         cSql += ", "
      ENDIF
      cSql += aStruct[ n, 1 ] + " "
      cType := aStruct[ n, 2 ]
      IF At( "*", cType ) > 0
         cType := StrTran( cType, "*", "" )
         cPK += IIf( Empty( cPK ), "", "," ) + aStruct[ n, 1 ]
      ENDIF
      SWITCH cType
      CASE "C"
         cSql += "VARCHAR(" + LTrim( Str( aStruct[ n, 3 ] ) ) + ")"
         EXIT
      CASE "M"
         cSql += "MEDIUMTEXT"
         EXIT
      CASE "I"
         cSql += "INTEGER"
         EXIT
      CASE "N"
         IF aStruct[ n, 4 ] == 0
            cSql += IIF( aStruct[ n, 3 ] <= 9, "INTEGER", "BIGINT" )
         ELSE
            cSql += "DOUBLE" + ;
                    "(" + LTrim( Str( aStruct[ n, 3 ] ) ) + ;
                    "," + LTrim( Str( aStruct[ n, 4 ] ) ) + ")"
         ENDIF
         EXIT
      CASE "D"
         cSql += "DATE"
         EXIT
      CASE "T"
      CASE "DATETIME"
      CASE "TIMESTAMP"
         cSql += IIF( cType == "T", "DATETIME", cType )
         IF !Empty( aStruct[ n, 4 ] )
            cSql += "(" + LTrim( Str( aStruct[ n, 4 ] ) ) + ")"
         ENDIF
         EXIT
      CASE "L"
         cSql += "BOOLEAN"
         EXIT
      CASE "B"
         cSql += "MEDIUMBLOB"
         EXIT
      OTHERWISE
         cSql += cType
         IF !Empty( aStruct[ n, 3 ] ) .OR. !Empty( aStruct[ n, 4 ] )
            cSql += "(" + LTrim( Str( aStruct[ n, 3 ] ) ) + ;
                    "," + LTrim( Str( aStruct[ n, 4 ] ) ) + ")"
         ENDIF
      END
      IF Len( aStruct[ n ] ) > 4
         IF aStruct[ n, 5 ] != Nil  // DEFAULT value
            cSql += " DEFAULT "
            IF ValType( aStruct[ n, 5 ] ) = "C" .AND. ( Left( aStruct[ n, 5 ], 1 ) == "'" .OR. Upper( aStruct[ n, 5 ] ) = "CURRENT_TIME" ;
                  .OR. Upper( aStruct[ n, 5 ] ) = "CURRENT_DATE" .OR. Upper( aStruct[ n, 5 ] ) = "CURRENT_TIMESTAMP" .OR. Upper( aStruct[ n, 5 ] ) = "NULL" )
               cSql += aStruct[ n, 5 ]
            ELSE
               cSql += ValToStr( aStruct[ n, 5 ] )
            ENDIF
         ENDIF
         IF Len( aStruct[ n ] ) > 5 .AND. !Empty( aStruct[ n, 6 ] )
            cSql += " " + aStruct[ n, 6 ]
         ENDIF
      ENDIF
   NEXT

   // Primary keys
   IF ! Empty( cPK )
      cSql += ", PRIMARY KEY (" + cPK + ")"
   ENDIF
   cSql += " )"

   IF !Empty( cEngine )
      cSql += " ENGINE=" + cEngine
   ENDIF

RETURN ::Execute( cSql )

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

METHOD GetBlockSize() CLASS XMySQLDataSource

   IF Empty( ::nBlockSize )
      IF Empty( ::nBlockSize := ::QueryRow( "SHOW VARIABLES WHERE variable_name LIKE 'max_allowed_packet'",, { "", 0 } )[ 2 ] )
         ::nBlockSize := ::QueryRow( "SHOW VARIABLES WHERE variable_name LIKE 'max_long_data_size'",, { "", 0 } )[ 2 ]
      ENDIF
   ENDIF

RETURN ::nBlockSize

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

METHOD CheckError( cArgument, nStackLevel ) CLASS XMySQLDataSource

   LOCAL oErr

   IF ::nLastError != 0
      IF Len( cArgument ) > 4096
         cArgument := Left( cArgument, 4096 ) + "..."
      ENDIF
      ::NewError( ::cLastError, ::nLastError,, "MySQL:" + cArgument )
   ENDIF

RETURN Nil

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

STATIC FUNCTION ValToStr( x )

   SWITCH ValType( x )
      CASE 'C'
         x := "'" + StrMySql( x ) + "'"
         EXIT
      CASE 'N'
         x := ToString( x )
         EXIT
      CASE 'D'
         x := IIf( Day( x ) == 0, "NULL", "'" + DToSQL( x ) + "'" )
         EXIT
      CASE 'T'
         x := IIF( Empty( x ), "'0000-00-00 00:00:00'", "'" + DTToSQL( x ) + "'" )
         EXIT
      CASE 'L'
         x := IIf( x, "1", "0" )
         EXIT
      OTHERWISE
         x := "NULL"
   END

RETURN x

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