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

/*
 * $Id$
 */

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

#include "common.ch"

#define CONNECTION_OK                   0
#define CONNECTION_BAD                  1
#define CONNECTION_STARTED              2
#define CONNECTION_MADE                 3
#define CONNECTION_AWAITING_RESPONSE    4
#define CONNECTION_AUTH_OK              5
#define CONNECTION_SETENV               6
#define CONNECTION_SSL_STARTUP          7
#define CONNECTION_NEEDED               8

#define PGRES_EMPTY_QUERY               0
#define PGRES_COMMAND_OK                1
#define PGRES_TUPLES_OK                 2
#define PGRES_COPY_OUT                  3
#define PGRES_COPY_IN                   4
#define PGRES_BAD_RESPONSE              5
#define PGRES_NONFATAL_ERROR            6
#define PGRES_FATAL_ERROR               7

#define PQTRANS_IDLE                    0
#define PQTRANS_ACTIVE                  1
#define PQTRANS_INTRANS                 2
#define PQTRANS_INERROR                 3
#define PQTRANS_UNKNOWN                 4


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

STATIC oServer
STATIC aTableTemp := {}
STATIC aTempDBF   := {}

Function Main( cServer, cDatabase, cUser, cPass )
    Local i
    Local cQuery

    SetMode( 25, 80 )

    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
Return SQLGarbageCollector()



/* 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(aTableTemp, {|aVal| aVal[DB_ALIAS] == cAlias})

  IF i != 0

    oQuery := 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 .not. (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(aTableTemp, {|aVal| aVal[DB_ALIAS] == cAlias})

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


Procedure SQLGarbageCollector()
  Local i
  Local oQuery

  DBCloseAll()

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

    IF oQuery != NIL
      oQuery:Destroy()
    ENDIF

  NEXT

  FOR i := 1 TO Len(aTempDBF)
    IF File(aTempDBF[i])
        FErase(aTempDBF[i])
    ENDIF

    IF File(strtran(aTempDBF[i], '.tmp', '.dbf'))
        FErase(strtran(aTempDBF[i], '.tmp', '.dbf'))
    ENDIF

    IF File(strtran(aTempDBF[i], '.tmp', '.dbt'))
        FErase(strtran(aTempDBF[i], '.tmp', '.dbt'))
    ENDIF
  NEXT

  aTableTemp := {}
  aTempDBF   := {}
Return


Function SQLFetch( fetchall )
  Local oQuery
  Local oRow
  Local cAlias := Upper(Alias())
  Local i, x, y
  Local nPos
  Local lEof := .F.

  Default Fetchall TO .f.

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

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

    oQuery := aTableTemp[i, DB_QUERY]
    nPos   := aTableTemp[i, DB_ROW] + 1

    if Fetchall
        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

        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 oServer
  Local oQuery
  Local aStrudbf
  Local lFetch

  oServer := SQLCurrentServer()
  cAlias := Upper(cAlias)

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

  IF ! Empty(x)
      oQuery := 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 := 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( aTableTemp, { cAlias,; // Table Name
                        cFile,;  // Temporary File Name
                        oQuery,; // Object Query
                        0,;      // Current Row
                        lFetch } ) // Fetch Status
  ELSE

    aTableTemp[ x, DB_QUERY ] := oQuery
    aTableTemp[ x, DB_ROW ]   := 0
    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.

  oServer := TPQServer():New(cServer, cDatabase, cUser, cPassWord, 5432, cSchema)
  if oServer:NetErr()
     Alert(oServer:ErrorMsg())
     lRetval := .f.
  endif
  oServer:lAllCols := .F.
Return lRetval


Procedure SQLDestroy()
  if oServer != NIL
    oServer:Destroy()
  endif
return


Function SQLCurrentServer
 Return oServer


Function SQLQuery( cQuery )
  Local oQuery

  oQuery := oServer:Query(cQuery)
  IF oQuery:NetErr()
    Alert(cQuery + ':' + oQuery:ErrorMsg())
  ENDIF
Return oQuery


Function SQLExecQuery( cQuery )
  Local oQuery
  Local result := .T.

  oQuery := oServer:Query(cQuery)
  IF oQuery:NetErr()
    Alert('Nao foi possível executar ' + 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( ':' + ltrim(str(i)), cQuery))
            cQuery := stuff( cQuery, x, 0, '{' )
            cQuery := stuff( cQuery, x + len(ltrim(str(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 valtype(x) == 'N'
        x := ltrim(str(x))

      elseif valtype(x) == 'D'
        x := DtoQ(x)

      elseif valtype(x) == 'L'
        x := IIF( x, "'t'", "'f'" )

      elseif valtype(x) == "C" .or. valtype(x) == 'M'
        x := StoQ(Trim(x))

      else
        x := 'null'
      endif

      cQuery := strtran(cQuery, '{:' + ltrim(str(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 )
    Local nValue
    nValue := Val(QuickQuery("SELECT nextval(" + StoQ(sequence_name) + ")" ))
Return nValue


Function SQLStartTrans()
    if PQtransactionstatus(oServer:pDB) != PQTRANS_INTRANS
        oServer:StartTransaction()
    endif
Return nil


Function SQLInTrans()
    Local result
    result := (PQtransactionstatus(oServer:pDB) == PQTRANS_INTRANS)
Return result


Function SQLCommitTrans()
    oServer:Commit()
Return nil


Function SQLRollbackTrans()
    oServer:rollback()
Return nil


/* Faz querie que retorna apenas 1 valor de coluna */
Function QuickQuery( cQuery )
   Local pQuery
   Local result := ""
   Local temp, aTemp
   Local x, y

   pQuery := PQexec( 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
   PQclear(pQuery)
Return result


Procedure MakeDBF( cAlias, aStructure, aIndex )
  Local cFile, i, cIndex, cKey

  Default aIndex TO {}

  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( aTempDBF, cIndex)
  Next

  AADD( aTempDBF, cFile )
return


Function DirTmp()
  Local xDirectory
  xDirectory := IIF(Empty(Getenv("TMP")), Getenv("TEMP"), Getenv("TMP"))

  IF Empty(xDirectory)
     xDirectory := ''
  ENDIF

  IF ';' $ xDirectory
     xDirectory := LEFT( xDirectory, AT( ';', xDirectory ) - 1 )
  ENDIF

  RETURN xDirectory + IIF( Right(xDirectory, 1) != '\' .and. ! Empty(xDirectory), '\', '' )


Function TempFile( cPath, cExt )
  Local cString

  Default cPath to DirTmp(),;
          cExt  to 'tmp'

  cString := cPath + strzero(int(hb_random(val(strtran(time(), ":", "")))), 8) + '.' + cExt

  DO WHILE File( 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 + "'"