fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
15b1f94fd5ac43efbf2d108fd8b1b5dea052d822
harbour-core/harbour/contrib/hbpgsql/tests/cache.prg
Viktor Szakats 93d5b9b090 2010-03-07 20:31 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) 
* contrib/hbpgsql/tests/tstpgrdd.prg
  * contrib/hbpgsql/tests/async.prg
  * contrib/hbpgsql/tests/test.prg
  * contrib/hbpgsql/tests/cache.prg
  * contrib/hbpgsql/tests/stress.prg
  * contrib/hbpgsql/tests/dbf2pg.prg
    ! Various fixes.
    ! Formatting.
2010-03-07 19:31:54 +00:00

554 lines
12 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* This samples show how to use dbf to cache postgres records.
*/
#include "common.ch"
#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 := {}
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( 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.
DEFAULT Fetchall TO .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( "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( ":" + 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 ValType( x ) == "N"
x := hb_ntos( 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( 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
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( s_aTempDBF, cIndex)
NEXT
AAdd( s_aTempDBF, cFile )
RETURN
FUNCTION TempFile( cPath, cExt )
LOCAL cString
DEFAULT cPath TO hb_DirTemp()
DEFAULT cExt TO "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 + "'"
Reference in New Issue View Git Blame Copy Permalink