/*
 * Xailer source code:
 *
 * SQLite.prg
 * Clase TSQLiteDataSource()
 *
 * Copyright 2003, 2007 Jose F. Gimenez
 * Copyright 2003, 2007 Xailer.com
 * All rights reserved
 *
 */

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

REQUEST HB_CODEPAGE_UTF8EX

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

CLASS XSQLiteDataSource FROM TDataSource

PUBLISHED:
   PROPERTY cConnect       INIT ""  EDITOR PE_SQLiteDataSource WRITE SetConnect
   PROPERTY cPassword      INIT ""  WRITE SetPassword
   PROPERTY nTimeOut       INIT 1000
   PROPERTY lDateAsString  INIT .F.
   PROPERTY lDoubleQuotes  INIT .F.
   PROPERTY lConnected     // para forzar que vaya al final

   PROPERTY lAllowProcessMessages   INIT .T.
   PROPERTY lReadToCache            INIT .T.
   PROPERTY lUtfToAnsi              INIT .F.

PUBLIC:
   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 ) // --> cPassword
   METHOD Encrypt( cPassword ) // --> lSuccess

   METHOD Execute( cQuery, cOperation, @aData, @aTypes, lHash, lUtfToAnsi ) // --> lSuccess
   METHOD StrSql( cString ) // --> cString

   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 GetTables( cMask, lViews ) // --> aFiles
   METHOD File( cName ) // --> lResult
   METHOD CreateTable( cName, aStruct ) // --> lSuccess
   METHOD DelTable( cTable )  INLINE ::Execute( "DROP TABLE " + cTable ) // --> lSuccess

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

RESERVED:
   METHOD GetRecords( oDataSet, lForTable ) // --> oSQLiteRecords
   METHOD Prepare( cQuery )
   METHOD GetColumnNames( hQuery )
   METHOD GetColumnTypes( hQuery )
   METHOD GetColumnTables( hQuery )
   METHOD GetRows( hQuery, @aData, nRows, aRowID, nRowID, @nRecno, @aTypes, lHash, lUtfToAnsi )
   METHOD Finalize( hQuery )
   METHOD LastInsertRowId()
   METHOD LastInsertId()   EXTERN XSQLiteDataSource_LastInsertRowId()

   METHOD CheckError( cArgument )
   METHOD SetConnect( cConnect )

ENDCLASS

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

METHOD QueryValue( cCommand, uDefault ) CLASS XSQLiteDataSource

   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 XSQLiteDataSource

   LOCAL hQuery, aData

   hQuery := ::Prepare( cCommand )
   IF PCount() > 1
      aHeaders := ::GetColumnNames( hQuery )
   ENDIF
   ::GetRows( hQuery, @aData, 1,,,,,, ::lUtfToAnsi )
   ::Finalize( hQuery )

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

RETURN aDefault

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

METHOD QueryRowHash( cCommand, aHeaders, aDefault ) CLASS XSQLiteDataSource

   LOCAL hQuery, aData

   hQuery := ::Prepare( cCommand )
   IF PCount() > 1
      aHeaders := ::GetColumnNames( hQuery )
   ENDIF
   ::GetRows( hQuery, @aData, 1,,,,, .T., ::lUtfToAnsi )
   ::Finalize( hQuery )

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

RETURN aDefault

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

METHOD QueryArray( cCommand, aHeaders ) CLASS XSQLiteDataSource

   LOCAL hQuery, aData

   hQuery := ::Prepare( cCommand )
   IF PCount() > 1
      aHeaders := ::GetColumnNames( hQuery )
   ENDIF
   WHILE ::GetRows( hQuery, @aData, 1024, ,,,,,, ::lUtfToAnsi ) == SQLITE_ROW
      ProcessMessages()
   ENDDO
   ::Finalize( hQuery )

RETURN aData

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

METHOD QueryArrayHash( cCommand, aHeaders ) CLASS XSQLiteDataSource

   LOCAL hQuery, aData

   hQuery := ::Prepare( cCommand )
   IF PCount() > 1
      aHeaders := ::GetColumnNames( hQuery )
   ENDIF
   WHILE ::GetRows( hQuery, @aData, 1024,,,,, .T., ::lUtfToAnsi ) == SQLITE_ROW
      ProcessMessages()
   ENDDO
   ::Finalize( hQuery )

RETURN aData

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

METHOD Table( cCommand, cProcess ) CLASS XSQLiteDataSource

   DEFAULT cProcess TO ::cProcess

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

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

METHOD Query( cCommand, cProcess ) CLASS XSQLiteDataSource

   DEFAULT cProcess TO ::cProcess

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

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

METHOD QueryReport( cCommand, cProcess ) CLASS XSQLiteDataSource

   DEFAULT cProcess TO ::cProcess

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

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

METHOD GetRecords( oDataSet, lForTable ) CLASS XSQLiteDataSource

   IF oDataSet != Nil .AND. oDataSet:nCursorType == adOpenForwardOnly
      RETURN TSQLiteRecordsReport():Create( oDataSet, lForTable )
   ENDIF

RETURN TSQLiteRecords():Create( oDataSet, lForTable )

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

METHOD GetTables( cMask, lViews ) CLASS XSQLiteDataSource

   LOCAL aData, aFiles := {}
   LOCAL cCommand := "SELECT name FROM sqlite_master"

   DEFAULT lViews TO .T.

   IF lViews
      cCommand += " WHERE (type='table' OR type='view')"
   ELSE
      cCommand += " WHERE type='table'"
   ENDIF

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

   ::Execute( cCommand,, @aData )
   AEval( aData, {| x | AAdd( aFiles, x[ 1 ] ) } )

RETURN aFiles

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

METHOD File( cName ) CLASS xSQLiteDataSource

   IF Empty( cName )
      RETURN .F.
   ENDIF

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

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

METHOD CreateTable( cName, aStruct ) CLASS XSQLiteDataSource

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

   FOR n := 1 TO Len( aStruct )
      IF At( "*", aStruct[ n, 2 ] ) > 0
         cPK += IIf( Empty( cPK ), "", "," ) + aStruct[ n, 1 ]
      ENDIF
   NEXT

   FOR n := 1 TO Len( aStruct )
      IF n > 1
         cSql += ", "
      ENDIF
      cSql += aStruct[ n, 1 ] + " "
      cType := aStruct[ n, 2 ]
      IF At( "*", cType ) > 0
         IF !( cType == "I*" ) .OR. At( ",", cPk ) > 0
            cType := StrTran( cType, "*", "" )
         ENDIF
      ENDIF
      IF cType == "C"
         cSql += "VARCHAR(" + LTrim( Str( aStruct[ n, 3 ] ) ) + ")"
      ELSEIF cType == "M"
         cSql += "MEMOTEXT"   // NOTA: Si se usa "MEMO", las cadenas que tiene solo digitos las trata como numeros - [JFG]
      ELSEIF cType == "H"
         cSql += "JSON"
      ELSEIF cType == "I*"
         cSql += "INTEGER PRIMARY KEY AUTOINCREMENT"
         cPK := ""
      ELSEIF cType == "I"
         cSql += "INTEGER"
      ELSEIF cType == "N"
         IF aStruct[ n, 4 ] == 0
            cSql += IIF( aStruct[ n, 3 ] <= 9, "INTEGER", "INT64" )
         ELSE
            cSql += IIF( aStruct[ n, 4 ] == 2, IIF( aStruct[ n, 3 ] >= 8, "CURRENCY", "DECIMAL" ), "DOUBLE" ) + ;
                    "(" + LTrim( Str( aStruct[ n, 3 ] ) ) + ;
                    "," + LTrim( Str( aStruct[ n, 4 ] ) ) + ")"
         ENDIF
      ELSEIF cType == "D"
         cSql += "DATE"
      ELSEIF cType == "T"
         cSql += "DATETIME"
      ELSEIF cType == "L"
         cSql += "BOOLEAN"
      ELSEIF cType == "B"
         cSql += "BLOB"
      ELSE
         cSql += cType + ;
                 "(" + LTrim( Str( aStruct[ n, 3 ] ) ) + ;
                 "," + LTrim( Str( aStruct[ n, 4 ] ) ) + ")"
      ENDIF
      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" )
               IF ( nAt := At( " ", aStruct[ n, 5 ] ) ) > 0
                  cSql += Left( aStruct[ n, 5 ], nAt - 1 )
               ELSE
                  cSql += aStruct[ n, 5 ]
               ENDIF
            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 += " )"

RETURN ::Execute( cSql )

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

METHOD CheckError( cArgument ) CLASS XSQLiteDataSource

   LOCAL oErr

   IF ::nLastError > 0 .AND. ::nLastError < 100
      IF Len( cArgument ) > 4096
         cArgument := Left( cArgument, 4096 ) + "..."
      ENDIF
      ::NewError( ::cLastError, ::nLastError,, "SQLITE:" + cArgument )
   ENDIF

RETURN Nil

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

METHOD SetConnect( cConnect ) CLASS xSQLiteDataSource

   IF  ::lConnected
      ::Disconnect()
   ENDIF

   ::FcConnect := cConnect

RETURN cConnect

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

STATIC FUNCTION ValToStr( x )

   SWITCH ValType( x )
      CASE 'C'
         x := "'" + StrSqlite( x ) + "'"
         EXIT
      CASE 'N'
         x := ToString( x )
         EXIT
      CASE 'D'
         x := IIf( Day( x ) == 0, "NULL", "'" + DToSQL( x ) + "'" )
         EXIT
      CASE 'L'
         x := IIf( x, "1", "0" )
         EXIT
      OTHERWISE
         x := "NULL"
   END

RETURN x

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

#pragma BEGINDUMP

#include "xailer.h"

char * StrSql( const char * cString, const char * cChars );


HB_FUNC_STATIC( XSQLITEDATASOURCE_STRSQL )
{
   LPSTR cRet = StrSql( hb_parc( 1 ), "'" );

   hb_retc_buffer( cRet );
}

#pragma ENDDUMP

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