fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
ccdcecb09478a44d402f89099989124d11e75708
harbour-core/harbour/contrib/hbpgsql/tests/cache.prg
Viktor Szakats 0476405be7 2010-02-02 21:44 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) 
* contrib/hbpgsql/postgres.c
    + Added GC support for all remaining pointer types (result/cancel/FILE).
    + Added RTE when wrong pointer or wrong number of parameter is passed
      to functions.
      This means that behavior is now INCOMPATIBLE when wrong parameters
      are encountered in these functions.
    ; Destructor functions PQFREECANCEL(), PQCLOSE(), PQCLEAR() marked 
      as 'deprecated'.
      These are not needed, it's enough to assign NIL to their holder
      variables on .prg level.
    % Cleanups along the way.
    ; TODO: Fix sloppy parameter checking which only check number of
            parameters instead of enforcing expected type.
    ; Please test.

  * contrib/hbpgsql/tests/async.prg
  * contrib/hbpgsql/tests/test.prg
  * contrib/hbpgsql/tests/cache.prg
  * contrib/hbpgsql/tests/stress.prg
    % Replaced deprecated destructor functions with '<var> := NIL'.

  * utils/hbmk2/hbmk2.prg
    * Formatting.
2010-02-02 20:45:51 +00:00

633 lines
12 KiB
Plaintext
Raw Blame History

/*
* $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
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 + "'"
Reference in New Issue View Git Blame Copy Permalink