harbour-core/harbour/contrib/hbpgsql/tests/cache.prg

/*
 * $Id$
 */

/*
 * This samples show how to use dbf to cache postgres records.
 */

#require "hbpgsql"

#include "postgres.ch"

#define DB_ALIAS                        1
#define DB_FILE                         2
#define DB_QUERY                        3
#define DB_ROW                          4
#define DB_FETCH                        5

STATIC s_oServer
STATIC s_aTableTemp := {}
STATIC s_aTempDBF   := {}

PROCEDURE Main( cServer, cDatabase, cUser, cPass )

   LOCAL i
   LOCAL cQuery

   IF SQLConnect( cServer, cDatabase, cUser, cPass )
      QuickQuery( "DROP TABLE test" )

      cQuery := "CREATE TABLE test ( "
      cQuery += "  codigo integer primary key, "
      cQuery += "  descri char(50), "
      cQuery += "  email varchar(50) ) "
      SQLQuery( cQuery )

      SQLOpen( "nomes", "SELECT * FROM test" )

      FOR i := 1 TO 50
         APPEND BLANK
         REPLACE codigo WITH i
         REPLACE descri WITH "test " + Str( i )
      NEXT

      SQLApplyUpdates()

      cQuery := "SELECT * FROM test WHERE codigo >= :1 ORDER BY codigo"
      cQuery := SQLPrepare( cQuery, 1 )
      SQLOpen( "nomes", cQuery )

      DO WHILE ! Eof()
         ? RecNo(), nomes->Codigo, nomes->descri, nomes->email

         IF RecNo() == 10
            DELETE
         ENDIF

         IF RecNo() == 20
            REPLACE email WITH "teste"
         ENDIF

         SQLFetch()
      ENDDO

      SQLApplyUpdates()
   ENDIF

   SQLGarbageCollector()

   RETURN


/* Put theses functions in a library */

FUNCTION SQLApplyUpdates()

   LOCAL cAlias := Upper( Alias() )
   LOCAL i, x
   LOCAL oQuery
   LOCAL oRow
   LOCAL lUpdate
   LOCAL lError := .F.
   LOCAL cError

   i := AScan( s_aTableTemp, {| aVal | aVal[ DB_ALIAS ] == cAlias } )

   IF i != 0

      oQuery := s_aTableTemp[ i ][ 3 ]

      FOR i := 1 TO LastRec()

         dbGoto( i )

         IF i > oQuery:LastRec()

            /* Verifica se eh um registro novo */
            IF ! Deleted()

               oRow := oQuery:GetBlankRow()

               FOR x := 1 TO FCount()
                  IF oRow:FieldPos( FieldName( x ) ) != 0
                     oRow:FieldPut( FieldName( x ), FieldGet( x ) )
                  ENDIF
               NEXT

               oQuery:Append( oRow )

               cError := oQuery:ErrorMsg()

               lError := oQuery:NetErr()

            ENDIF
         ELSE

            oRow := oQuery:GetRow( i )

            lUpdate := .F.

            IF Deleted()

               oQuery:Delete( oRow )
               cError := oQuery:ErrorMsg()
               lError := oQuery:NetErr()
            ELSE

               /* Faz update, mas compara quais campos sao diferentes */

               FOR x := 1 TO FCount()

                  IF oRow:FieldPos( FieldName( x ) ) != 0

                     IF ! ( FieldGet( x ) == oRow:FieldGet( FieldName( x ) ) )
                        oRow:FieldPut( FieldName( x ), FieldGet( x ) )
                        lUpdate := .T.
                     ENDIF
                  ENDIF
               NEXT

               IF lUpdate

                  oQuery:Update( oRow )
                  cError := oQuery:ErrorMsg()
                  lError := oQuery:NetErr()

               ENDIF
            ENDIF
         ENDIF

         IF lError
            EXIT
         ENDIF
      NEXT
   ENDIF

   IF lError
      Alert( cError )
   ENDIF

   RETURN ! lError


PROCEDURE SQLCloseTemp( cAlias )

   LOCAL x

   IF ! Empty( Select( cAlias ) )
      CLOSE &calias
   ENDIF

   x := AScan( s_aTableTemp, {| aVal | aVal[ DB_ALIAS ] == cAlias } )

   IF ! Empty( x )
      ADel( s_aTableTemp, x )
      // ASize( s_aTableTemp, Len( s_aTableTemp ) - 1 )
   ENDIF

   RETURN


PROCEDURE SQLGarbageCollector()

   LOCAL i
   LOCAL oQuery

   dbCloseAll()

   FOR i := 1 TO Len( s_aTableTemp )
      /* Apaga arquivos dbfs criados */
      FErase( s_aTableTemp[ i ][ DB_FILE ] )
      oQuery := s_aTableTemp[ i ][ DB_QUERY ]

      IF oQuery != NIL
         oQuery:Destroy()
      ENDIF
   NEXT

   FOR i := 1 TO Len( s_aTempDBF )
      IF hb_FileExists( s_aTempDBF[ i ] )
         FErase( s_aTempDBF[ i ] )
      ENDIF

      IF hb_FileExists( StrTran( s_aTempDBF[ i ], ".tmp", ".dbf" ) )
         FErase( StrTran( s_aTempDBF[ i ], ".tmp", ".dbf" ) )
      ENDIF

      IF hb_FileExists( StrTran( s_aTempDBF[ i ], ".tmp", ".dbt" ) )
         FErase( StrTran( s_aTempDBF[ i ], ".tmp", ".dbt" ) )
      ENDIF
   NEXT

   s_aTableTemp := {}
   s_aTempDBF   := {}

   RETURN


FUNCTION SQLFetch( fetchall )

   LOCAL oQuery
   LOCAL oRow
   LOCAL cAlias := Upper( Alias() )
   LOCAL i, x, y
   LOCAL nPos
   LOCAL lEof := .F.

   hb_default( @Fetchall, .F. )

   /* Procura pela tabela no array */
   i := AScan( s_aTableTemp, {| aVal | aVal[ DB_ALIAS ] == cAlias } )

   IF i != 0
      /* Traz registros da base de dados */

      oQuery := s_aTableTemp[ i ][ DB_QUERY ]
      nPos   := s_aTableTemp[ i ][ DB_ROW ] + 1

      IF Fetchall
         s_aTableTemp[ i ][ DB_FETCH ] := .T.
      ENDIF

      IF oQuery:LastRec() >= nPos

         y := nPos

         DO WHILE nPos <= iif( FetchAll, oQuery:LastRec(), y )
            oRow := oQuery:GetRow( nPos )
            dbAppend()

            FOR x := 1 TO oRow:FCount()
               FieldPut( FieldPos( oRow:FieldName( x ) ), oRow:FieldGet( x ) )
            NEXT

            s_aTableTemp[ i ][ DB_ROW ] := nPos
            nPos++
         ENDDO

      ELSE
         // Posiciona registro no eof
         dbSkip()
      ENDIF

      lEof := nPos > oQuery:LastRec()
   ENDIF

   RETURN lEof


PROCEDURE SQLFetchAll()

   SQLFetch( .T. )
   dbGoTop()

   RETURN


FUNCTION SQLOpen( cAlias, cQuery, xFetch, cOrder )

   LOCAL cFile
   LOCAL Result := .T.
   LOCAL x
   LOCAL s_oServer
   LOCAL oQuery
   LOCAL aStrudbf
   LOCAL lFetch

   s_oServer := SQLCurrentServer()
   cAlias := Upper( cAlias )

   /* Procura por query na area temporaria */
   x := AScan( s_aTableTemp, {| aVal | aVal[ DB_ALIAS ] == cAlias } )

   IF ! Empty( x )
      oQuery := s_aTableTemp[ x ][ 3 ]
      oQuery:Destroy()
   ENDIF

   IF cQuery == NIL
      cQuery := "SELECT * FROM " + cAlias
      IF ! Empty( cOrder )
         cQuery += " ORDER BY " + cOrder
      ENDIF
   ENDIF

   cQuery := cQuery
   oQuery := s_oServer:Query( cQuery )

   IF oQuery:NetErr()
      Alert( oQuery:ErrorMsg() )
      RETURN .F.
   ENDIF

   IF Empty( Select( cAlias ) )
      /* Pega estrutura da base de dados */
      aStrudbf := oQuery:Struct()

      /* Cria tabela */
      cFile := TempFile()
      dbCreate( cFile, aStrudbf )

      /* Abre Tabela */
      dbUseArea( .T., NIL, cFile, cAlias, .F. )

   ELSE
      SELECT &cAlias
      ZAP
   ENDIF

   IF xFetch != NIL
      lFetch := xFetch
   ELSE
      lFetch := .F.
   ENDIF

   /* Se nao houver query na area temporaria entao adiciona, caso contrario, apenas atualiza */
   IF Empty( x )
      AAdd( s_aTableTemp, { ;
         cAlias, ;  // Table Name
         cFile, ;   // Temporary File Name
         oQuery, ;  // Object Query
         0, ;       // Current Row
         lFetch } ) // Fetch Status
   ELSE

      s_aTableTemp[ x ][ DB_QUERY ] := oQuery
      s_aTableTemp[ x ][ DB_ROW ]   := 0
      s_aTableTemp[ x ][ DB_FETCH ] := lFetch

   ENDIF

   /* Traz registros da base de dados */
   SQLFetch( lFetch )

   IF lFetch
      dbGoTop()
   ENDIF

   RETURN result


FUNCTION SQLConnect( cServer, cDatabase, cUser, cPassword, cSchema )

   LOCAL lRetval := .T.

   s_oServer := TPQServer():New( cServer, cDatabase, cUser, cPassWord, 5432, cSchema )
   IF s_oServer:NetErr()
      Alert( s_oServer:ErrorMsg() )
      lRetval := .F.
   ENDIF
   s_oServer:lAllCols := .F.

   RETURN lRetval


PROCEDURE SQLDestroy()

   IF s_oServer != NIL
      s_oServer:Destroy()
   ENDIF

   RETURN


FUNCTION SQLCurrentServer
   RETURN s_oServer


FUNCTION SQLQuery( cQuery )

   LOCAL oQuery := s_oServer:Query( cQuery )

   IF oQuery:NetErr()
      Alert( cQuery + ":" + oQuery:ErrorMsg() )
   ENDIF

   RETURN oQuery


FUNCTION SQLExecQuery( cQuery )

   LOCAL oQuery
   LOCAL result := .T.

   oQuery := s_oServer:Query( cQuery )
   IF oQuery:NetErr()
      Alert( "Cannot execute " + cQuery + ":" + oQuery:ErrorMsg() )

      result := .F.
   ELSE
      oQuery:Destroy()
   ENDIF

   RETURN result


FUNCTION SQLPrepare( cQuery, ... )

   LOCAL i, x

   IF PCount() >= 2
      /* Limpa espacos desnecessarios */
      DO WHILE At( Space( 2 ), cQuery ) != 0
         cQuery := StrTran( cQuery, Space( 2 ), Space( 1 ) )
      ENDDO

      /* Coloca {} nos parametros */
      FOR i := 1 TO PCount() - 1
         IF ! Empty( x := At( ":" + hb_ntos( i ), cQuery ) )
            cQuery := Stuff( cQuery, x, 0, "{" )
            cQuery := Stuff( cQuery, x + Len( hb_ntos( i ) ) + 2, 0, "}" )
         ENDIF
      NEXT

      /* Substitui parametros por valores passados */
      FOR i := 2 TO PCount()
         x := hb_PValue( i )

         IF x != NIL .AND. Empty( x )
            x := "null"

         ELSEIF HB_ISNUMBER( x )
            x := hb_ntos( x )

         ELSEIF HB_ISDATE( x )
            x := DToQ( x )

         ELSEIF HB_ISLOGICAL( x )
            x := iif( x, "'t'", "'f'" )

         ELSEIF HB_ISSTRING( x )
            x := SToQ( RTrim( x ) )

         ELSE
            x := "null"
         ENDIF

         cQuery := StrTran( cQuery, "{:" + hb_ntos( i - 1 ) + "}", x )
      NEXT
   ENDIF

   cQuery := StrTran( cQuery, "==", "=" )
   cQuery := StrTran( cQuery, "!=", "<>" )
   cQuery := StrTran( cQuery, ".and.", "and" )
   cQuery := StrTran( cQuery, ".or.", "or" )
   cQuery := StrTran( cQuery, ".not.", "not" )

   RETURN cQuery


/* Pega resultado de uma sequence */
FUNCTION SQLSequence( Sequence_name )
   RETURN Val( QuickQuery( "SELECT nextval(" + SToQ( sequence_name ) + ")" ) )


PROCEDURE SQLStartTrans()

   IF PQtransactionstatus( s_oServer:pDB ) != PQTRANS_INTRANS
      s_oServer:StartTransaction()
   ENDIF

   RETURN


FUNCTION SQLInTrans()
   RETURN PQtransactionstatus( s_oServer:pDB ) == PQTRANS_INTRANS


PROCEDURE SQLCommitTrans()

   s_oServer:Commit()

   RETURN


PROCEDURE SQLRollbackTrans()

   s_oServer:rollback()

   RETURN


/* Faz querie que retorna apenas 1 valor de coluna */
FUNCTION QuickQuery( cQuery )

   LOCAL pQuery
   LOCAL result := ""
   LOCAL temp, aTemp
   LOCAL x, y

   pQuery := PQexec( s_oServer:pDB, cQuery )

   IF PQresultstatus( pQuery ) == PGRES_TUPLES_OK
      IF PQLastrec( pQuery ) != 0
         IF PQFcount( pQuery ) == 1 .AND. PQLastrec( pQuery ) == 1
            temp := PQGetValue( pQuery, 1, 1 )
            result := iif( temp == NIL, "", temp )
         ELSE
            result := {}
            FOR x := 1 TO PQLastrec( pQuery )
               aTemp := {}
               FOR y := 1 TO PQfcount( pQuery )
                  temp := PQGetValue( pQuery, x, y )
                  AAdd( aTemp, iif( temp == NIL, "", temp ) )
               NEXT
               AAdd( result, aTemp )
            NEXT
         ENDIF
      ENDIF
   ENDIF

   RETURN result


PROCEDURE MakeDBF( cAlias, aStructure, aIndex )

   LOCAL cFile, i, cIndex, cKey

   hb_default( @aIndex, {} )

   cFile := TempFile()
   dbCreate( cFile, aStructure )

   /* Abre Tabela */
   dbUseArea( .T., NIL, cFile, cAlias, .F. )

   FOR i := 1 TO Len( aIndex )
      cKey := aIndex[ i ]
      cIndex := TempFile()

      INDEX ON &cKey TO &cIndex

      AAdd( s_aTempDBF, cIndex )
   NEXT

   AAdd( s_aTempDBF, cFile )

   RETURN


FUNCTION TempFile( cPath, cExt )

   LOCAL cString

   hb_default( @cPath, hb_DirTemp() )
   hb_default( @cExt, "tmp" )

   cString := cPath + StrZero( Int( hb_Random( Val( StrTran( Time(), ":" ) ) ) ), 8 ) + "." + cExt

   DO WHILE hb_FileExists( cString )
      cString := cPath + StrZero( Int( hb_Random( Val( StrTran( Time(), ":" ) ) ) ), 8 ) + "." + cExt
   ENDDO

   RETURN cString


FUNCTION DToQ( cData )
   RETURN "'" + Str( Year( cData ), 4 ) + "-" + StrZero( Month( cData ), 2 ) + "-" + StrZero( Day( cData ), 2 ) + "'"

FUNCTION SToQ( cData )
   RETURN "'" + cData + "'"