diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 595b0ee95c..32fb67a7a3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,33 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-03-23 04:05 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/bin/pack_src.sh + + harbour/contrib/pgsql/Changelog + + harbour/contrib/pgsql/Makefile + + harbour/contrib/pgsql/README + + harbour/contrib/pgsql/make_b32.bat + + harbour/contrib/pgsql/makefile.bc + + harbour/contrib/pgsql/pgrdd.prg + + harbour/contrib/pgsql/postgres.c + + harbour/contrib/pgsql/postgres.ch + + harbour/contrib/pgsql/tpostgre.prg + + harbour/contrib/pgsql/tstpgrdd.prg + + harbour/contrib/pgsql/tests/Makefile + + harbour/contrib/pgsql/tests/async.prg + + harbour/contrib/pgsql/tests/cache.prg + + harbour/contrib/pgsql/tests/dbf2pg.prg + + harbour/contrib/pgsql/tests/simple.prg + + harbour/contrib/pgsql/tests/stress.prg + + harbour/contrib/pgsql/tests/test.prg + + added Postgres SQL library - code borrowed from xHarbour + + * harbour/source/rtl/empty.c + + added support for HASH items + + * harbour/source/rtl/itemseri.c + + added SYMBOL items serialization + 2007-03-22 12:55 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/common.mak * updated for new files - please check diff --git a/harbour/bin/pack_src.sh b/harbour/bin/pack_src.sh index 8d20682f82..5d96c2a927 100644 --- a/harbour/bin/pack_src.sh +++ b/harbour/bin/pack_src.sh @@ -338,6 +338,24 @@ $hb_collect contrib/odbc/*.ch $hb_collect contrib/odbc/*.prg $hb_collect contrib/odbc/*.txt +# CONTRIB\PGSQL +$hb_collect contrib/pgsql/[mM]akefile* +$hb_collect contrib/pgsql/Changelog +$hb_collect contrib/pgsql/README +$hb_collect contrib/pgsql/*.[ch] +$hb_collect contrib/pgsql/*.ch +$hb_collect contrib/pgsql/*.prg +$hb_collect contrib/pgsql/*.txt +$hb_collect contrib/pgsql/*.bat + +# CONTRIB\MYSQL +$hb_collect contrib/mysql/[mM]akefile* +$hb_collect contrib/mysql/*.[ch] +$hb_collect contrib/mysql/*.ch +$hb_collect contrib/mysql/*.prg +$hb_collect contrib/mysql/*.txt +$hb_collect contrib/mysql/*.bat + # CONTRIB\BTREE $hb_collect contrib/btree/[mM]akefile* $hb_collect contrib/btree/*.[ch] diff --git a/harbour/contrib/pgsql/Changelog b/harbour/contrib/pgsql/Changelog new file mode 100644 index 0000000000..5a46f6a981 --- /dev/null +++ b/harbour/contrib/pgsql/Changelog @@ -0,0 +1,250 @@ +/* + * $Id$ + */ + +/* Use this format for the entry headers: + YYYY-MM-DD HH:MM UTC[-|+]hhmm Your Full Name + For example: + 2002-12-01 23:12 UTC+0100 Foo Bar +*/ + +2007-03-22 21:30 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * xharbour/contrib/pgsql/postgres.c + ! fixed code which was accessing item internals in function PQMETADATA + % optimized function PQMETADATA by eliminating repeated array resizing + +2005-10-08 12:40 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/postgres.c + ! Fixed return problem with lo_import + +2005-07-05 19:45 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/TPostgres.prg + ! Fixed problem with pg8 changes for treatment of double precision and real + +2005-06-01 20:30 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/postgres.c + ! Add control version for pg74x. + +2005-05-21 11:45 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/TPostgres.prg + + Add 3 new methods, traceOn(), TraceOff(), SetVerbosity() + * xharbour/contrib/pgsql/postgres.c + + Add New Functions: + PQcreatetrace + PQclosetrace + PQtrace + PQuntrace + PQseterrorverbosity + PQprotocolversion + PQserverversion + PQclientencoding + PQsetclientencoding + PQsetdblogin + PQdb + PQuser + PQpass + PQhost + PQport + PQtty + PQoptions + PQoidvalue + PQoidstatus + PQbinarytuples + PQftable + PQftype + PQfname + PQfmod + PQfsize + PQgetisnull + PQfnumber + PQntuples + PQnfields + PQgetcancel + PQcancel + PQfreecancel + PQsetnonblocking + PQisnonblocking + lo_Unlink + lo_Import + lo_Export + * xharbour/contrib/pgsql/tests/test.prg + * xharbour/contrib/pgsql/tests/async.prg + * xharbour/contrib/pgsql/tests/simple.prg + + Add more samples of using new functions + +2005-03-12 12:20 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/TPostgres.prg + ! Fixed bug with ValueToString, thanks to Marco Aurelio. + +2005-03-01 12:00 UTC-0300 Rodrigo Moreno + + xharbour/contrib/pgsql/postgres.c + ! Add new function to handle binary escape string/quoted strings + +2005-02-08 12:00 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/TPostgres.prg + ! Fixed bug in Append Method, regarding where clause, thanks to Marco Aurelio. + +2005-02-02 11:45 UTC-0300 Rodrigo Moreno + * xharbour/contrib/pgsql/TPostgres.prg + ! Add Destroy Methods + +2005-01-12 23:45 UTC-0300 Rodrigo Moreno + + xharbour/contrib/pgsql/postgres.c + ! Add new function to handle escape string/quoted strings + +2004-12-15 10:00 UTC-0300 Rodrigo Moreno + + xharbour/contrib/pgsql/postgres.c + ! Add new functions to handle the result of affected rows + + xharbour/contrib/pgsql/TPostgres.prg + ! Add new property, rows + +2004-10-14 10:00 UTC-0300 Rodrigo Moreno + - xharbour/contrib/pgsql/TPostgres.prg + ! Removed function removespaces. It's not necessary remove unused spaces in query. + +2004-09-29 18:30 UTC-0300 Rodrigo Moreno + + xharbour/contrib/pgsql/postgres.c + ! Add new function PQreset, This function will close the connection + to the server and attempt to reestablish a new connection to the + same server, using all the same parameters previously used. + This may be useful for error recovery if a working connection is lost. + * xharbour/contrib/pgsql/README + ! Updated + * xharbour/contrib/pgsql/makefile.bc + ! Updated + +2004-09-06 22:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * xharbour/contrib/pgsql/postgres.c + * initialize some variables which could not be uninitialized on some + errors in PG or bad user parameters and cause GPF - I only fix it + on C level - the same should be done for .prg returned values to + not confuse .prg programmers on errors (if any). + +2004-08-25 21:50 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed bugs with numeric/decimal fields when field was created with numeric() without parameters + +2004-07-13 11:30 UTC-0300 Rodrigo Moreno + * TPostgres.prg + * Improved control over error messages + ! Fixed small bugs + * tests/dbf2pg.prg + * tests/cache.prg + ! changed to handle error messages + +2004-06-22 15:40 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed bug regading primary keys, but with arrays + + tests/cache.prg + ! Sample, how to use .dbf as postgres record cache + +2004-06-18 10:45 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed bug regading primary keys + +2004-06-11 19:26 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed Date convertion bugs + +2004-05-19 11:30 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed Schema bug + +2004-05-04 19:00 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed bug select from procedures/funtion + +2004-05-03 11:15 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed bug with numeric/decimal + dbf store "." as part os field size, postgres doesn't, so, when decimal add + 1 in length + +2004-05-02 18:00 UTC-0300 Rodrigo Moreno + * postgres.c + + Add new functions for handling asynchronous/nonblocking queries + ! Fixed warnings + + tests/async.prg + + sample showing howto use the asynchronous queries + +2004-04-30 15:00 UTC-0300 Rodrigo Moreno + + postgres.ch + + Add new file with database definitions + * TPostgres.prg + * Changed fieldget parameters, fixed bug when parameter field is char + * tests/simple.prg + * tests/stress.prg + * tests/test.prg + ! Fix some bugs + * tests/dbf2pg.prg + ! Add new features and new parameter, like use transaction, commit interval, etc. + +2004-04-25 14:33 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed (INSERT, DELETE, UPDATE) result error when row is updated + +2004-04-25 14:33 UTC-0300 Rodrigo Moreno + * TPostgres.prg + ! Fixed schema bugs + +2004-04-25 16:00 UTC-0300 Rodrigo Moreno + * postgres.c + + Add new function to handle error message + * Changed pointer functions + * TPostgres.prg + + Add Schema support + ! Some fix and improve initial query + * tests/test.prg + ! Changed sample to handle connection and result messages + +2004-04-05 14:45 UTC-0300 Rodrigo Moreno + * postgres.c + + Add new functions to handle connection and result set + * Changed pointer return + + * TPostgres.prg + * Changed to handle the status of connection and querys + * Changed Fieldget, Fieldtype, Fielddec, Fieldlen, to handle char field name + +2004-03-12 14:45 UTC-0300 Rodrigo Moreno + * TPostgres.prg + * Method Fieldget, fixed problem text field with null + +2004-03-06 10:50 UTC-0300 Rodrigo Moreno + * TPostgres.prg + * Changed DataToSql, when empty date, should return null + * Contributed by Joao Fonseca + +2004-03-04 11:15 UTC-0300 Rodrigo Moreno + * TPostgres.prg + * Changed method GetBlank(), resulting nil class on previous errors + +2004-03-02 16:00 UTC-0300 Rodrigo Moreno + * TPostgres.prg + * Add new property lallCols. Used to send only changed columns or not changed + +2004-02-16 14:00 UTC-0300 Rodrigo Moreno + * Modified makefile.bc to user PG_DIR var + * Modified TPostgres.prg + * Changed ISCHAR to ISCHARACTER + * Modified samples/stress.prg + * Changed ISCHAR to ISCHARACTER + * Contributed by Eduardo Fenandez + +2004-01-07 11:20 UTC-0300 Rodrigo Moreno + * Modified make_b32.bat and makefile.bc, now it's working properly. + +2004-01-07 10:50 UTC-0300 Rodrigo Moreno + * Clean tab and spaces align + +2004-01-04 17:40 UTC-0300 Rodrigo Moreno + * Add function PQExecParams + * This will be usefull on Append/Updated TPostgres Methods to avoid scaping strings + +2004-01-04 10:10 UTC-0300 Luiz Rafael Culik + * All Files recommited (trash on source file( chr(13)) + * postgres.c Xharbour sources should only include "hbapi.h" clipper + compatible headers( extend.api and item.api) should now be used + on xharbour modules + +2004-01-02 15:05 UTC-0300 Rodrigo Moreno + * INITIAL RELEASE diff --git a/harbour/contrib/pgsql/Makefile b/harbour/contrib/pgsql/Makefile new file mode 100644 index 0000000000..80125bd9ce --- /dev/null +++ b/harbour/contrib/pgsql/Makefile @@ -0,0 +1,18 @@ + +ROOT = ../../ + +C_SOURCES=\ + postgres.c \ + +PRG_SOURCES=\ + tpostgre.prg \ + +LIBNAME=hbpg + +include $(TOP)$(ROOT)config/lib.cf + +ifeq ($(HB_COMPILER),mingw32) + CFLAGS := $(CFLAGS) -I/postgres/include +else + CFLAGS := $(CFLAGS) -I/usr/local/pgsql/include -I/usr/local/pgsql/include/libpq -I/usr/include/pgsql +endif diff --git a/harbour/contrib/pgsql/README b/harbour/contrib/pgsql/README new file mode 100644 index 0000000000..073c6550f7 --- /dev/null +++ b/harbour/contrib/pgsql/README @@ -0,0 +1,51 @@ +$Id$ + +README 23/12/2003 - Harbour Low Level api for Postgres RDBMS + +It's to be seem like Harbour TMysql routines. + + +IMPORTANT +--------- +The class TPostgres, only works with versions 7.4.x or greater, because some methods use information_schema and +New PQexecParams, which use protocol 3.0 and this protocol is only compatible with 7.4 versions. + +BORLAND BCC +----------- +Using this library with bcc, you will need import library, ex: implib libpq.lib libpq.dll or (advice this) build your own +Postgres Library. + +Go to postgres directory \postgresql-7.4.5\src\interfaces\libpq + +Edit bcc32.mak and change the default borland directory for your needs. Example: BCB=c:\Borland\Bcc55 + +change postgresql-7.4.5\src\include\pg_config.h.win32 to pg_config.h + +after this + +make -f bcc32.mak + +Now look at \postgresql-7.4.5\src\interfaces\libpq\Release, you will find the all .libs and .dlls + +If want use the dll, link in your aplication blibpqdll.lib and send blibpq.dll together with your aplication + +If you don't wanna use .dll link blibpq.lib, that's it. + +LINUX GCC +---------- +On Linux you will need link libpq or references by pq. +For full api documentation look at: +http://www.postgresql.org/docs/current/static/libpq.html + +FILES: +postgres.c - Low level api +tpostgre.prg - Class implementation, it's to be seems like TMysql. +tests\simple.prg - Simple test class +tests\stress.prg - Stress test +tests\cache.prg - Show hot to use .dbf as pg cache, like TDataset for Delphi. + +TODO: + +That's all folks and sorry my poor english + +Rodrigo Moreno - rodrigo_moreno@yahoo.com diff --git a/harbour/contrib/pgsql/make_b32.bat b/harbour/contrib/pgsql/make_b32.bat new file mode 100644 index 0000000000..9165d76fee --- /dev/null +++ b/harbour/contrib/pgsql/make_b32.bat @@ -0,0 +1,30 @@ +@echo off + +if "%1" == "clean" goto CLEAN +if "%1" == "CLEAN" goto CLEAN + +:BUILD + + make -fmakefile.bc %1 %2 %3 > make_b32.log + if errorlevel 1 goto BUILD_ERR + +:BUILD_OK + + copy ..\..\lib\b32\libhbpg.lib ..\..\lib\*.* > nul + goto EXIT + +:BUILD_ERR + + notepad make_b32.log + goto EXIT + +:CLEAN + + if exist ..\..\lib\b32\libhbpg.lib del ..\..\lib\b32\libhbpg.lib + if exist ..\..\lib\b32\libhbpg.bak del ..\..\lib\b32\libhbpg.bak + if exist ..\..\obj\b32\postgres.obj del ..\..\obj\b32\postgres.obj + if exist ..\..\obj\b32\TPostgres.c del ..\..\obj\b32\TPostgres.c + if exist ..\..\obj\b32\TPostgres.obj del ..\..\obj\b32\TPostgres.obj + goto EXIT + +:EXIT diff --git a/harbour/contrib/pgsql/makefile.bc b/harbour/contrib/pgsql/makefile.bc new file mode 100644 index 0000000000..f0d26fcf35 --- /dev/null +++ b/harbour/contrib/pgsql/makefile.bc @@ -0,0 +1,31 @@ + +# makefile for Borland C/C++ 32 bits +# Building of libhbpg.lib - Harbour API to postgres + +# Postgresql running under Cygwin/Windows, unmark the line bellow to compile. +# PG_DIR = ..\..\..\cygwin\usr\src\postgresql-7.4.5 + +PG_DIR = C:\PostgreSQL + +INCLUDE_DIR = ..\..\include +INCLUDE_PQ = $(PG_DIR)\include + +BIN_DIR = c:\xharbour\bin +OBJ_DIR = ..\..\obj\b32 +LIB_DIR = ..\..\lib\b32 + +$(LIB_DIR)\libhbpg.lib : \ + $(OBJ_DIR)\TPostgres.obj \ + $(OBJ_DIR)\postgres.obj + +$(OBJ_DIR)\TPostgres.c : TPostgres.prg +$(OBJ_DIR)\TPostgres.obj : $(OBJ_DIR)\TPostgres.c +$(OBJ_DIR)\postgres.obj : postgres.c + +.c.obj: + bcc32 $(CLIBFLAGS) -c -O2 -I$(INCLUDE_DIR) -I$(INCLUDE_PQ) -DHB_OS_WIN_32_USED -DPG_DIAG_INTERNAL_POSITION -o$@ $< + tlib $(LIB_DIR)\libhbpg.lib -+$@,, + +.prg.c: + $(BIN_DIR)\harbour.exe $< -q0 -a -w -es2 -gc0 -n -i$(INCLUDE_DIR) -o$@ + diff --git a/harbour/contrib/pgsql/pgrdd.prg b/harbour/contrib/pgsql/pgrdd.prg new file mode 100644 index 0000000000..949c101ad3 --- /dev/null +++ b/harbour/contrib/pgsql/pgrdd.prg @@ -0,0 +1,395 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * PostgreSQL RDD + * + * Copyright 2006 Lorenzo Fiorini + * www - http://www.harbour-project.org + * www - http://www.xharbour.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +/* + * This is an experimental RDD for xharbour/contrib/pgsql interface. + * It has been created to test the possibilities of usrrdd. + * It doesn't support many functions and commands and many things could be optimized. + */ + +#include "rddsys.ch" +#include "usrrdd.ch" +#include "fileio.ch" +#include "error.ch" +#include "dbstruct.ch" +#include "common.ch" + +#define AREA_QUERY 1 +#define AREA_ROW 2 +#define AREA_APPEND 3 + +#define AREA_LEN 3 + +ANNOUNCE PGRDD + +STATIC s_aConnections := {} + +FUNCTION DBPGCONNECTION( cConnString ) + + LOCAL aParams + LOCAL oServer + LOCAL nConn + + aParams := HB_ATOKENS( cConnString, ";" ) + + asize( aParams, 6 ) + + oServer := TPQServer():New( aParams[1], aParams[2], aParams[3], aParams[4], aParams[5], aParams[6] ) + + IF oServer:NetErr() + alert( oServer:ErrorMsg() ) + RETURN FAILURE + ELSE + aadd( s_aConnections, oServer ) + nConn := len( s_aConnections ) + ENDIF + +RETURN nConn + +FUNCTION DBPGCLEARCONNECTION( nConn ) + + LOCAL oServer + + oServer := s_aConnections[ nConn ] + + oServer:Close() + + s_aConnections[ nConn ] := nil + +RETURN SUCCESS + +/* + * non work area methods receive RDD ID as first parameter + * Methods INIT and EXIT does not have to execute SUPER methods - these is + * always done by low level USRRDD code + */ +STATIC FUNCTION PG_INIT( nRDD ) + + USRRDD_RDDDATA( nRDD ) + +RETURN SUCCESS + +/* + * methods: NEW and RELEASE receive pointer to work area structure + * not work area number. It's necessary because the can be executed + * before work area is allocated + * these methods does not have to execute SUPER methods - these is + * always done by low level USRRDD code + */ +STATIC FUNCTION PG_NEW( pWA ) + + USRRDD_AREADATA( pWA, array( AREA_LEN ) ) + +RETURN SUCCESS + +STATIC FUNCTION PG_OPEN( nWA, aOpenInfo ) + LOCAL aField, oError, lError, cError, nResult + LOCAL oServer, oQuery, aStruct, aFieldStruct + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + lError := .F. + + if !empty( aOpenInfo[ UR_OI_CONNECT ] ) .and. aOpenInfo[ UR_OI_CONNECT ] <= len( s_aConnections ) + oServer := s_aConnections[ aOpenInfo[ UR_OI_CONNECT ] ] + endif + + if !empty( oServer ) + oServer:lAllCols := .F. + oQuery := oServer:Query( aOpenInfo[ UR_OI_NAME ] ) + lError := oQuery:NetErr() + cError := oQuery:ErrorMsg() + else + lError := .T. + cError := "Invalid connection handle" + endif + + IF lError + oError := ErrorNew() + oError:GenCode := EG_OPEN + oError:SubCode := 1000 + oError:Description := HB_LANGERRMSG( EG_OPEN ) + ", " + cError + oError:FileName := aOpenInfo[ UR_OI_NAME ] + oError:CanDefault := .T. + UR_SUPER_ERROR( nWA, oError ) + RETURN FAILURE + ELSE + aWAData[ AREA_QUERY ] := oQuery + ENDIF + + UR_SUPER_SETFIELDEXTENT( nWA, oQuery:nFields ) + + aStruct := oQuery:Struct() + + FOR EACH aFieldStruct IN aStruct + + aField := ARRAY( UR_FI_SIZE ) + aField[ UR_FI_NAME ] := aFieldStruct[ DBS_NAME ] + aField[ UR_FI_TYPE ] := aFieldStruct[ DBS_TYPE ] + aField[ UR_FI_TYPEEXT ] := 0 + aField[ UR_FI_LEN ] := aFieldStruct[ DBS_LEN ] + aField[ UR_FI_DEC ] := aFieldStruct[ DBS_DEC ] + UR_SUPER_ADDFIELD( nWA, aField ) + + NEXT + + /* Call SUPER OPEN to finish allocating work area (f.e.: alias settings) */ + nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) + +RETURN nResult + +STATIC FUNCTION PG_CLOSE( nWA ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + aWAData[ AREA_QUERY ]:Close() + +RETURN UR_SUPER_CLOSE( nWA ) + +STATIC FUNCTION PG_GETVALUE( nWA, nField, xValue ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + if !empty( aWAData[ AREA_ROW ] ) + xValue := aWAData[ AREA_ROW ]:FieldGet( nField ) + else + xValue := aWAData[ AREA_QUERY ]:FieldGet( nField ) + endif + +RETURN SUCCESS + +STATIC FUNCTION PG_PUTVALUE( nWA, nField, xValue ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + if empty( aWAData[ AREA_ROW ] ) + aWAData[ AREA_ROW ] := aWAData[ AREA_QUERY ]:GetRow() + endif + + aWAData[ AREA_ROW ]:FieldPut( nField, xValue ) + +RETURN SUCCESS + +STATIC FUNCTION PG_SKIP( nWA, nRecords ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + if !empty( aWAData[ AREA_ROW ] ) + PG_FLUSH( nWA ) + endif + + aWAData[ AREA_QUERY ]:Skip( nRecords ) + +RETURN SUCCESS + +STATIC FUNCTION PG_GOTOP( nWA ) +RETURN PG_GOTO( nWA, 1 ) + +STATIC FUNCTION PG_GOBOTTOM( nWA ) +RETURN PG_GOTO( nWA, -1 ) + +STATIC FUNCTION PG_GOTOID( nWA, nRecord ) +RETURN PG_GOTO( nWA, nRecord ) + +STATIC FUNCTION PG_GOTO( nWA, nRecord ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + if !empty( aWAData[ AREA_ROW ] ) + PG_FLUSH( nWA ) + endif + + if nRecord < 0 + nRecord := aWAData[ AREA_QUERY ]:nLastRec + elseif nRecord == 0 + nRecord := aWAData[ AREA_QUERY ]:nRecno + endif + + aWAData[ AREA_QUERY ]:Goto( nRecord ) + +RETURN SUCCESS + +STATIC FUNCTION PG_RECCOUNT( nWA, nRecords ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + nRecords := aWAData[ AREA_QUERY ]:nLastRec + +RETURN SUCCESS + +STATIC FUNCTION PG_BOF( nWA, lBof ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + lBof := aWAData[ AREA_QUERY ]:lBof + +RETURN SUCCESS + +STATIC FUNCTION PG_EOF( nWA, lEof ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + lEof := aWAData[ AREA_QUERY ]:lEof + +RETURN SUCCESS + +STATIC FUNCTION PG_RECID( nWA, nRecNo ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + nRecno := aWAData[ AREA_QUERY ]:nRecNo + +RETURN SUCCESS + +STATIC FUNCTION PG_DELETED( nWA, lDeleted ) + lDeleted := .F. +RETURN SUCCESS + +STATIC FUNCTION PG_FLUSH( nWA ) + LOCAL oError + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL nRecno + + if aWAData[ AREA_ROW ] != nil + if !empty( aWAData[ AREA_APPEND ] ) + aWAData[ AREA_QUERY ]:Append( aWAData[ AREA_ROW ] ) + else + nRecno := aWAData[ AREA_QUERY ]:nRecNo + aWAData[ AREA_QUERY ]:Update( aWAData[ AREA_ROW ] ) + endif + + IF aWAData[ AREA_QUERY ]:lError + oError := ErrorNew() + oError:GenCode := EG_DATATYPE + oError:SubCode := 3000 + oError:Description := HB_LANGERRMSG( EG_DATATYPE ) + ", " + aWAData[ AREA_QUERY ]:ErrorMsg() + UR_SUPER_ERROR( nWA, oError ) + RETURN FAILURE + ENDIF + +/* + * The :Refresh() below costs a lot in term of performance. + * It redo the select to include inserts and updates. + * It is the only solution I've found so far to simulate dbf behaviour + */ + aWAData[ AREA_QUERY ]:Refresh( .T., .F. ) + + if !empty( aWAData[ AREA_APPEND ] ) + aWAData[ AREA_APPEND ] := .F. + nRecno := aWAData[ AREA_QUERY ]:nLastRec + endif + + aWAData[ AREA_ROW ] := nil + + PG_GOTO( nWA, nRecno ) + + endif + +RETURN SUCCESS + +STATIC FUNCTION PG_APPEND( nWA, nRecords ) + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + aWAData[ AREA_ROW ] := aWAData[ AREA_QUERY ]:GetBlankRow() + + aWAData[ AREA_APPEND ] := .T. + +RETURN SUCCESS + +STATIC FUNCTION PG_DELETE( nWA ) + LOCAL oError + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + aWAData[ AREA_ROW ] := aWAData[ AREA_QUERY ]:GetRow() + + aWAData[ AREA_QUERY ]:Delete( aWAData[ AREA_ROW ] ) + + IF aWAData[ AREA_QUERY ]:lError + oError := ErrorNew() + oError:GenCode := EG_DATATYPE + oError:SubCode := 2000 + oError:Description := HB_LANGERRMSG( EG_DATATYPE ) + ", " + aWAData[ AREA_QUERY ]:ErrorMsg() + UR_SUPER_ERROR( nWA, oError ) + RETURN FAILURE + ENDIF + + aWAData[ AREA_ROW ] := nil + +RETURN SUCCESS + +/* + * This function have to exist in all RDD and then name have to be in + * format: _GETFUNCTABLE + */ +FUNCTION PGRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) + LOCAL cSuperRDD := NIL /* NO SUPER RDD */ + LOCAL aMyFunc[ UR_METHODCOUNT ] + + aMyFunc[ UR_INIT ] := ( @PG_INIT() ) + aMyFunc[ UR_NEW ] := ( @PG_NEW() ) + aMyFunc[ UR_OPEN ] := ( @PG_OPEN() ) + aMyFunc[ UR_GETVALUE ] := ( @PG_GETVALUE() ) + aMyFunc[ UR_PUTVALUE ] := ( @PG_PUTVALUE() ) + aMyFunc[ UR_SKIP ] := ( @PG_SKIP() ) + aMyFunc[ UR_GOTO ] := ( @PG_GOTO() ) + aMyFunc[ UR_GOTOID ] := ( @PG_GOTOID() ) + aMyFunc[ UR_GOTOP ] := ( @PG_GOTOP() ) + aMyFunc[ UR_GOBOTTOM ] := ( @PG_GOBOTTOM() ) + aMyFunc[ UR_RECCOUNT ] := ( @PG_RECCOUNT() ) + aMyFunc[ UR_RECID ] := ( @PG_RECID() ) + aMyFunc[ UR_BOF ] := ( @PG_BOF() ) + aMyFunc[ UR_EOF ] := ( @PG_EOF() ) + aMyFunc[ UR_DELETED ] := ( @PG_DELETED() ) + aMyFunc[ UR_FLUSH ] := ( @PG_FLUSH() ) + aMyFunc[ UR_APPEND ] := ( @PG_APPEND() ) + aMyFunc[ UR_DELETE ] := ( @PG_DELETE() ) + aMyFunc[ UR_CLOSE ] := ( @PG_CLOSE() ) + +RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc ) + +INIT PROC PG_INIT() + rddRegister( "PGRDD", RDT_FULL ) +RETURN + + diff --git a/harbour/contrib/pgsql/postgres.c b/harbour/contrib/pgsql/postgres.c new file mode 100644 index 0000000000..baf91aaf95 --- /dev/null +++ b/harbour/contrib/pgsql/postgres.c @@ -0,0 +1,866 @@ +/* + * $Id$ + * + * xHarbour Project source code: + * PostgreSQL RDBMS low level (client api) interface code. + * + * Copyright 2003 Rodrigo Moreno rodrigo_moreno@yahoo.com + * www - http://www.xharbour.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "libpq-fe.h" + +#define _CLIPDEFS_H +#if defined(HB_OS_WIN_32_USED) + #include +#endif + +#define VARHDRSZ 4 +#define BOOLOID 16 +#define INT8OID 20 +#define INT2OID 21 +#define INT4OID 23 +#define TEXTOID 25 +#define OIDOID 26 +#define FLOAT4OID 700 +#define FLOAT8OID 701 +#define CASHOID 790 +#define BPCHAROID 1042 +#define VARCHAROID 1043 +#define DATEOID 1082 +#define TIMEOID 1083 +#define TIMESTAMPOID 1114 +#define TIMESTAMPTZOID 1184 +#define TIMETZOID 1266 +#define BITOID 1560 +#define VARBITOID 1562 +#define NUMERICOID 1700 + +#define INV_WRITE 0x00020000 +#define INV_READ 0x00040000 + +#ifndef HB_PGVERSION +# ifdef PG_DIAG_INTERNAL_POSITION +# define HB_PGVERSION 0x0800 +# else +# define HB_PGVERSION 0x0700 +# endif +#endif + +/* + * Connection handling functions + */ + +HB_FUNC( PQCONNECT ) +{ + char conninfo[128]; + PGconn *conn; + + if( hb_pcount() == 5 ) + sprintf( conninfo, "dbname = %s host = %s user = %s password = %s port = %i", + hb_parcx(1), hb_parcx(2), hb_parcx(3), hb_parcx(4), (int) hb_parni(5) ); + + conn = PQconnectdb( conninfo ); + hb_retptr( conn ); +} + +HB_FUNC( PQSETDBLOGIN ) +{ + const char *pghost; + const char *pgport; + const char *pgoptions; + const char *pgtty; + const char *dbName; + const char *login; + const char *pwd; + + pghost = hb_parcx(1); + pgport = hb_parcx(2); + pgoptions = hb_parcx(3); + pgtty = hb_parcx(4); + dbName = hb_parcx(5); + login = hb_parcx(6); + pwd = hb_parcx(8); + + if (hb_pcount() == 7) + hb_retptr( ( PGconn * ) PQsetdbLogin( pghost, pgport, pgoptions, pgtty, dbName, login, pwd) ); +} + +HB_FUNC(PQCLOSE) +{ + if (hb_parinfo(1)) + PQfinish(( PGconn * ) hb_parptr(1)); +} + +HB_FUNC(PQRESET) +{ + if (hb_parinfo(1)) + PQreset(( PGconn * ) hb_parptr(1)); +} + +HB_FUNC(PQPROTOCOLVERSION) +{ + if (hb_parinfo(1)) + hb_retni(PQprotocolVersion(( PGconn * ) hb_parptr(1))); +} + +HB_FUNC(PQCLIENTENCODING) +{ + if (hb_parinfo(1)) + hb_retni(PQclientEncoding(( PGconn * ) hb_parptr(1))); +} + +HB_FUNC(PQSETCLIENTENCODING) +{ + if (hb_pcount() == 2) + hb_retni(PQsetClientEncoding(( PGconn * ) hb_parptr(1), hb_parcx(2))); +} + +HB_FUNC(PQDB) +{ + if (hb_parinfo(1)) + hb_retc(PQdb( ( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQUSER) +{ + if (hb_parinfo(1)) + hb_retc(PQuser( ( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQPASS) +{ + if (hb_parinfo(1)) + hb_retc(PQpass( ( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQHOST) +{ + if (hb_parinfo(1)) + hb_retc(PQhost( ( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQPORT) +{ + if (hb_parinfo(1)) + hb_retc(PQport( ( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQTTY) +{ + if (hb_parinfo(1)) + hb_retc(PQtty( ( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQOPTIONS) +{ + if (hb_parinfo(1)) + hb_retc(PQoptions( ( PGconn * ) hb_parptr(1) )); +} + +/* + * Query handling functions + */ + +HB_FUNC(PQCLEAR) +{ + if (hb_parinfo(1)) + PQclear(( PGresult * ) hb_parptr(1)); +} + +HB_FUNC(PQEXEC) +{ + PGresult *res = NULL; + + if (hb_pcount() == 2) + res = PQexec(( PGconn * ) hb_parptr(1), hb_parcx(2)); + + hb_retptr( res ); +} + +HB_FUNC(PQEXECPARAMS) +{ + PGresult *res = NULL; + const char **paramvalues; + int i; + long n; + + PHB_ITEM aParam; + + if (hb_pcount() == 3) + { + aParam = hb_param(3,HB_IT_ARRAY); + + n = hb_arrayLen(aParam); + + paramvalues = (const char **) hb_xgrab( sizeof( char *) * n ); + + for (i=0;i < n;i++) + paramvalues[i] = hb_arrayGetCPtr( aParam, i + 1 ); + + res = PQexecParams(( PGconn * ) hb_parptr(1), hb_parcx(2), n, NULL, paramvalues, NULL, NULL, 1); + + hb_xfree(paramvalues); + } + hb_retptr( res ); +} + +HB_FUNC(PQFCOUNT) +{ + PGresult *res; + int nFields = 0; + + if (hb_parinfo(1)) + { + res = ( PGresult * ) hb_parptr(1); + + if (PQresultStatus(res) == PGRES_TUPLES_OK) + nFields = PQnfields(res); + } + + hb_retni(nFields); +} + +HB_FUNC(PQLASTREC) +{ + PGresult *res; + int nRows = 0; + + if (hb_parinfo(1)) + { + res = ( PGresult * ) hb_parptr(1); + + if (PQresultStatus(res) == PGRES_TUPLES_OK) + nRows = PQntuples(res); + } + hb_retni(nRows); +} + +HB_FUNC(PQGETVALUE) +{ + PGresult *res; + int nRow, nCol; + + if (hb_pcount() == 3) + { + res = ( PGresult * ) hb_parptr(1); + + if (PQresultStatus(res) == PGRES_TUPLES_OK) + { + nRow = hb_parni(2) - 1; + nCol = hb_parni(3) - 1; + + if (! PQgetisnull(res, nRow, nCol)) + hb_retc(PQgetvalue(res, nRow, nCol)); + } + } +} + +HB_FUNC(PQGETLENGTH) +{ + PGresult *res; + int nRow, nCol; + int result = 0; + + if (hb_pcount() == 3) + { + res = ( PGresult * ) hb_parptr(1); + + if (PQresultStatus(res) == PGRES_TUPLES_OK) + { + nRow = hb_parni(2) - 1; + nCol = hb_parni(3) - 1; + + result = PQgetlength(res, nRow, nCol); + } + } + hb_retni(result); +} + +HB_FUNC( PQMETADATA ) +{ + PGresult *res; + if( hb_parinfo( 1 ) ) + { + res = ( PGresult * ) hb_parptr( 1 ); + if( PQresultStatus( res ) == PGRES_TUPLES_OK ) + { + int nFields = PQnfields( res ), i; + PHB_ITEM pResult = hb_itemArrayNew( nFields ), pField; + + for( i = 0; i < nFields; i++ ) + { + char buf[256]; + Oid type_oid = PQftype( res, i ); + int typemod = PQfmod( res, i ); + int length = 0; + int decimal = 0; + + switch( type_oid ) + { + case BITOID: + if( typemod >= 0 ) + length = ( int ) typemod; + strcpy( buf, "bit" ); + break; + + case BOOLOID: + length = 1; + strcpy( buf, "boolean" ); + break; + + case BPCHAROID: + if( typemod >= 0 ) + length = ( int ) ( typemod - VARHDRSZ ); + strcpy( buf, "character" ); + break; + + case FLOAT4OID: + strcpy( buf, "real" ); + break; + + case FLOAT8OID: + strcpy( buf, "double precision" ); + break; + + case INT2OID: + strcpy( buf, "smallint" ); + break; + + case INT4OID: + strcpy( buf, "integer" ); + break; + + case OIDOID: + strcpy( buf, "bigint" ); + break; + + case INT8OID: + strcpy( buf, "bigint" ); + break; + + case NUMERICOID: + length = ( ( typemod - VARHDRSZ ) >> 16 ) & 0xffff; + decimal = ( typemod - VARHDRSZ ) & 0xffff; + strcpy( buf, "numeric" ); + break; + + case DATEOID: + strcpy( buf, "date" ); + break; + + case TIMEOID: + case TIMETZOID: + strcpy( buf, "timezone" ); + break; + + case TIMESTAMPOID: + case TIMESTAMPTZOID: + strcpy( buf, "timestamp" ); + break; + + case VARBITOID: + if( typemod >= 0 ) + length = (int) typemod; + strcpy( buf, "bit varying" ); + break; + + case VARCHAROID: + if( typemod >= 0 ) + length = ( int ) ( typemod - VARHDRSZ ); + strcpy( buf, "character varying" ); + break; + + case TEXTOID: + strcpy(buf, "text"); + break; + + case CASHOID: + strcpy( buf, "money" ); + break; + + default: + strcpy( buf, "not supported" ); + break; + } + + pField = hb_arrayGetItemPtr( pResult, i + 1 ); + hb_arrayNew ( pField, 6 ); + hb_itemPutC ( hb_arrayGetItemPtr( pField, 1 ), PQfname( res, i ) ); + hb_itemPutC ( hb_arrayGetItemPtr( pField, 2 ), buf ); + hb_itemPutNI( hb_arrayGetItemPtr( pField, 3 ), length ); + hb_itemPutNI( hb_arrayGetItemPtr( pField, 4 ), decimal ); + hb_itemPutNL( hb_arrayGetItemPtr( pField, 5 ), PQftable( res, i ) ); + hb_itemPutNI( hb_arrayGetItemPtr( pField, 6 ), PQftablecol( res, i ) ); + } + hb_itemRelease( hb_itemReturnForward( pResult ) ); + } + } +} + +HB_FUNC(PQTRANSACTIONSTATUS) +{ + if (hb_parinfo(1)) + hb_retni(PQtransactionStatus(( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQERRORMESSAGE) +{ + if (hb_parinfo(1)) + hb_retc(PQerrorMessage(( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQSTATUS) +{ + if (hb_parinfo(1)) + hb_retni(PQstatus(( PGconn * ) hb_parptr(1) )); +} + +HB_FUNC(PQRESULTERRORMESSAGE) +{ + if (hb_parinfo(1)) + hb_retc(PQresultErrorMessage(( PGresult * ) hb_parptr(1))); +} + +HB_FUNC(PQRESULTSTATUS) +{ + if (hb_parinfo(1)) + hb_retni(PQresultStatus(( PGresult * ) hb_parptr(1) )); +} + + +HB_FUNC(PQCMDSTATUS) +{ + if (hb_parinfo(1)) + hb_retc(PQcmdStatus( (PGresult *) hb_parptr(1) )); +} + + +HB_FUNC(PQCMDTUPLES) +{ + if (hb_parinfo(1)) + hb_retc(PQcmdTuples( (PGresult *) hb_parptr(1) )); +} + + +HB_FUNC(PQESCAPESTRING) +{ + char *source; + char *dest; + size_t size; + + source = hb_parcx(1); + dest = (char *) hb_xgrab( strlen(source) * 2 + 1); + size = strlen(source); + + PQescapeString(dest, source, size); + + hb_retc(dest); + hb_xfree( (char *) dest); +} + + +HB_FUNC(PQESCAPEBYTEA) +{ + char *from; + char *to; + size_t from_length; + size_t to_length; + + from = hb_parcx(1); + from_length = strlen(from); + to_length = strlen(from) * 5 + 1; + + to = PQescapeBytea(from, from_length, &to_length); + hb_retc(to); + PQfreemem(to); +} + + +HB_FUNC(PQUNESCAPEBYTEA) +{ + char *from; + size_t to_length; + + from = PQunescapeBytea(hb_parcx(1), &to_length); + hb_retclen(from, to_length); + PQfreemem(from); +} + + +HB_FUNC(PQOIDVALUE) +{ + if (hb_parinfo(1)) + hb_retnl( ( Oid ) PQoidValue(( PGresult * ) hb_parptr(1) )); +} + +HB_FUNC(PQOIDSTATUS) +{ + if (hb_parinfo(1)) + hb_retc( PQoidStatus(( PGresult * ) hb_parptr(1) )); +} + +HB_FUNC(PQBINARYTUPLES) +{ + if (hb_parinfo(1)) + hb_retl( PQbinaryTuples(( PGresult * ) hb_parptr(1) )); +} + +HB_FUNC(PQFTABLE) +{ + if (hb_pcount() == 2) + hb_retnl( ( Oid ) PQftable(( PGresult * ) hb_parptr(1), hb_parni(2) - 1 )); +} + +HB_FUNC(PQFTYPE) +{ + if (hb_pcount() == 2) + hb_retnl( ( Oid ) PQftype(( PGresult * ) hb_parptr(1), hb_parni(2) - 1 )); +} + +HB_FUNC(PQFNAME) +{ + if (hb_pcount() == 2) + hb_retc( PQfname(( PGresult * ) hb_parptr(1), hb_parni(2) - 1 )); +} + +HB_FUNC(PQFMOD) +{ + if (hb_pcount() == 2) + hb_retni( PQfmod(( PGresult * ) hb_parptr(1), hb_parni(2) - 1 )); +} + +HB_FUNC(PQFSIZE) +{ + if (hb_pcount() == 2) + hb_retni( PQfsize(( PGresult * ) hb_parptr(1), hb_parni(2) - 1 )); +} + +HB_FUNC(PQGETISNULL) +{ + if (hb_pcount() == 3) + hb_retl( PQgetisnull(( PGresult * ) hb_parptr(1), hb_parni(2) - 1 , hb_parni(3) - 1)); +} + +HB_FUNC(PQFNUMBER) +{ + if (hb_pcount() == 2) + hb_retni( PQfnumber(( PGresult * ) hb_parptr(1), hb_parcx(2) ) + 1); +} + +HB_FUNC(PQNTUPLES) +{ + if (hb_parinfo(1)) + hb_retnl( PQntuples(( PGresult * ) hb_parptr(1) )); +} + +HB_FUNC(PQNFIELDS) +{ + if (hb_parinfo(1)) + hb_retnl( PQnfields(( PGresult * ) hb_parptr(1) )); +} + +/* + * Asynchronous functions + */ + +HB_FUNC(PQSENDQUERY) +{ + int res = 0; + + if (hb_pcount() == 2) + res = PQsendQuery(( PGconn * ) hb_parptr(1), hb_parcx(2)); + + hb_retl( res ); +} + +HB_FUNC(PQGETRESULT) +{ + PGresult *res = NULL; + + if (hb_parinfo(1)) + res = PQgetResult(( PGconn * ) hb_parptr(1)); + + /* when null, no more result to catch */ + if (res) + hb_retptr( res ); +} + +HB_FUNC(PQCONSUMEINPUT) +{ + int res = 0; + + if (hb_parinfo(1)) + res = PQconsumeInput(( PGconn * ) hb_parptr(1)); + + hb_retl( res ); +} + +HB_FUNC(PQISBUSY) +{ + int res = 0; + + if (hb_parinfo(1)) + res = PQisBusy(( PGconn * ) hb_parptr(1)); + + hb_retl( res ); +} + +HB_FUNC(PQREQUESTCANCEL) /* deprecated */ +{ + int res = 0; + + if (hb_parinfo(1)) + res = PQrequestCancel(( PGconn * ) hb_parptr(1)); + + hb_retl( res ); +} + + +HB_FUNC(PQFLUSH) +{ + if (hb_parinfo(1)) + hb_retni( PQflush(( PGconn * ) hb_parptr(1)) ); +} + + +HB_FUNC(PQSETNONBLOCKING) +{ + if (hb_pcount() == 2) + hb_retl( PQsetnonblocking( ( PGconn * ) hb_parptr(1), hb_parl(2) ) ); +} + +HB_FUNC(PQISNONBLOCKING) +{ + if (hb_parinfo(1)) + hb_retl( PQisnonblocking( ( PGconn * ) hb_parptr(1) ) ); +} + +/* + * Trace Connection handling functions + */ + +HB_FUNC(PQCREATETRACE) +{ + FILE * pFile; + + if (hb_parinfo(1)) + { + pFile = fopen( hb_parcx(1), "w+b"); + + if (pFile != NULL) + hb_retptr( ( FILE * ) pFile ); + } +} + +HB_FUNC(PQCLOSETRACE) +{ + if (hb_parinfo(1)) + fclose( ( FILE * ) hb_parptr(1) ); +} + +HB_FUNC(PQTRACE) +{ + if (hb_pcount() == 2) + PQtrace( ( PGconn * ) hb_parptr(1), ( FILE * ) hb_parptr(2) ); +} + +HB_FUNC(PQUNTRACE) +{ + if (hb_parinfo(1)) + PQuntrace( ( PGconn * ) hb_parptr(1) ); +} + +HB_FUNC(PQSETERRORVERBOSITY) +{ + /* PQERRORS_TERSE 0 + PQERRORS_DEFAULT 1 + PQERRORS_VERBOSE 2 + */ + + if (hb_pcount() == 2) + hb_retni( ( PGVerbosity ) PQsetErrorVerbosity( ( PGconn * ) hb_parptr(1), ( PGVerbosity ) hb_parni(2) ) ); +} + + +/* + * Large Object functions + */ + + +HB_FUNC(LO_IMPORT) +{ + int ret = 0; + + if (hb_pcount() == 2) + ret = lo_import( ( PGconn * ) hb_parptr(1), hb_parcx(2) ); + + hb_retni(ret); +} + +HB_FUNC(LO_EXPORT) +{ + int ret = 0; + + if (hb_pcount() == 3) + { + ret = lo_export( ( PGconn * ) hb_parptr(1), ( Oid ) hb_parnl(2), hb_parcx(3) ); + + if (ret != 1) + ret = 0; + } + + hb_retl(ret); +} + +HB_FUNC(LO_UNLINK) +{ + int ret = 0; + + if (hb_pcount() == 2) + { + ret = lo_unlink( ( PGconn * ) hb_parptr(1), ( Oid ) hb_parnl(2) ); + + if (ret != 1) + ret = 0; + } + + hb_retl(ret); +} + + + +#if HB_PGVERSION >= 0x0800 + +HB_FUNC(PQSERVERVERSION) +{ + if (hb_parinfo(1)) + hb_retni(PQserverVersion(( PGconn * ) hb_parptr(1))); +} + +HB_FUNC(PQGETCANCEL) +{ + if (hb_parinfo(1)) + hb_retptr( ( PGcancel * ) PQgetCancel( ( PGconn * ) hb_parptr(1) ) ); +} + +HB_FUNC(PQCANCEL) +{ + char errbuf[256]; + int ret = 0; + + if (hb_parinfo(1)) + if (PQcancel( ( PGcancel * ) hb_parptr(1), errbuf, 255) == 1) + { + ret = 1; + hb_storc( errbuf, 2 ); + } + + hb_retl(ret); +} + +HB_FUNC(PQFREECANCEL) +{ + if (hb_parinfo(1)) + PQfreeCancel( ( PGcancel * ) hb_parptr(1) ) ; +} + +#endif + + +/* + +TODO: Implement Full Large Objects Support +TODO: Implement Prepared Query handling + +extern int lo_open(PGconn *conn, Oid lobjId, int mode); +extern int lo_close(PGconn *conn, int fd); +extern int lo_read(PGconn *conn, int fd, char *buf, size_t len); +extern int lo_write(PGconn *conn, int fd, char *buf, size_t len); +extern int lo_lseek(PGconn *conn, int fd, int offset, int whence); +extern Oid lo_creat(PGconn *conn, int mode); +extern int lo_tell(PGconn *conn, int fd); + +PGresult *PQprepare(PGconn *conn, + const char *stmtName, + const char *query, + int nParams, + const Oid *paramTypes); + + +PGresult *PQexecPrepared(PGconn *conn, + const char *stmtName, + int nParams, + const char * const *paramValues, + const int *paramLengths, + const int *paramFormats, + int resultFormat); + +int PQsendQueryParams(PGconn *conn, + const char *command, + int nParams, + const Oid *paramTypes, + const char * const *paramValues, + const int *paramLengths, + const int *paramFormats, + int resultFormat); + +int PQsendPrepare(PGconn *conn, + const char *stmtName, + const char *query, + int nParams, + const Oid *paramTypes); + +int PQsendQueryPrepared(PGconn *conn, + const char *stmtName, + int nParams, + const char * const *paramValues, + const int *paramLengths, + const int *paramFormats, + int resultFormat); + +*/ diff --git a/harbour/contrib/pgsql/postgres.ch b/harbour/contrib/pgsql/postgres.ch new file mode 100644 index 0000000000..ece46b51b1 --- /dev/null +++ b/harbour/contrib/pgsql/postgres.ch @@ -0,0 +1,28 @@ +/* + * $Id$ + */ + +#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 diff --git a/harbour/contrib/pgsql/tests/Makefile b/harbour/contrib/pgsql/tests/Makefile new file mode 100644 index 0000000000..eb4ccea781 --- /dev/null +++ b/harbour/contrib/pgsql/tests/Makefile @@ -0,0 +1,32 @@ +# +# $Id$ +# + +ifeq ($(HB_MAIN),) + HB_MAIN = std +endif + +ROOT = ../../../ + +CONTRIBS=\ + postgres \ + +PRG_SOURCES=\ + test.prg \ + +PRG_MAIN=\ + test.prg + +LIBS=\ + debug \ + vm \ + rtl \ + lang \ + rdd \ + rtl \ + vm \ + macro \ + common \ + pq \ + +include $(TOP)$(ROOT)config/bin.cf diff --git a/harbour/contrib/pgsql/tests/async.prg b/harbour/contrib/pgsql/tests/async.prg new file mode 100644 index 0000000000..60d61880a3 --- /dev/null +++ b/harbour/contrib/pgsql/tests/async.prg @@ -0,0 +1,72 @@ +/* + * $Id$ + * + * This sample show howto use asynchronous/nonblocking queries + * + */ + +Function main() + Local conn + + CLEAR SCREEN + + ? "Connect", conn := PQConnect('test', 'localhost', 'user', 'pass', 5432) + + ? "Conection status", PQerrorMessage(conn), PQstatus(conn) + + Query( conn, 'SELECT codigo, descri FROM client limit 100', .f. ) + Query( conn, 'SELECT codigo, descri FROM fornec limit 100', .f. ) + Query( conn, 'SELECT pedido, vlrped FROM pedido', .t. ) + + PQclose(conn) + + return nil + +Procedure Query( conn, cQuery, lCancel ) + Local pCancel, cErrMsg := space(30) + Local res, aTemp, i, x, y, xTime + + ? "PQSendQuery", PQsendQuery(conn, cQuery) + + xTime := time() + CLEAR TYPEAHEAD + + do while inkey() != 27 + DevPos(Row(), 20) + DevOut("Processing: " + Elaptime(xtime, time())) + + inkey(1) + + if lCancel + if .t. + pCancel := PQgetCancel(conn) + ? "Canceled: ", PQcancel( pCancel, @cErrMsg ), cErrMsg + PQfreeCancel(pCancel) + + else + ? PQrequestCancel(conn) // Deprecated + endif + endif + + if PQconsumeInput(conn) + if ! PQisBusy(conn) + exit + endif + endif + enddo + + if inkey() != 27 + ? "PQgetResult", valtoprg(res := PQgetResult(conn)) + + for x := 1 to PQlastrec(res) + ? + for y := 1 to PQfcount(res) + ?? PQgetvalue(res, x, y), " " + next + next + + PQclear(res) + else + ? "Canceling Query", PQrequestCancel(conn) + endif +Return \ No newline at end of file diff --git a/harbour/contrib/pgsql/tests/cache.prg b/harbour/contrib/pgsql/tests/cache.prg new file mode 100644 index 0000000000..fa8b9b8d55 --- /dev/null +++ b/harbour/contrib/pgsql/tests/cache.prg @@ -0,0 +1,648 @@ +/* + * $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() + Local i + Local cQuery + Local conn, res + + SetMode( 25, 80 ) + + if SQLConnect( '127.0.0.1', 'test', 'sysadm', 'masterkey' ) + 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 aField := {} + 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:Error() + + lError := oQuery:NetErr() + + endif + + ELSE + + + + oRow := oQuery:GetRow(i) + + lUpdate := .F. + + + + IF Deleted() + + oQuery:Delete(oRow) + + cError := oQuery:Error() + + 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:Error() + + lError := oQuery:NetErr() + + END + + END + + END + + + + if lError + + exit + + end + + NEXT + + END + + + IF lError + Alert(cError) + END + +Return ! lError + + +Procedure SQLCloseTemp( cAlias ) + Local x + + IF ! Empty(Select(cAlias)) + CLOSE &calias + END + + x := ASCAN(aTableTemp, {|aVal| aVal[DB_ALIAS] == cAlias}) + + IF ! Empty(x) + ADel( aTableTemp, x ) + //ASize( aTableTemp, Len(aTableTemp) - 1 ) + END +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 ! ISNIL(oQuery) + oQuery:Destroy() + END + + NEXT + + FOR i := 1 TO Len(aTempDBF) + IF File(aTempDBF[i]) + FErase(aTempDBF[i]) + END + + IF File(strtran(aTempDBF[i], '.tmp', '.dbf')) + FErase(strtran(aTempDBF[i], '.tmp', '.dbf')) + END + + IF File(strtran(aTempDBF[i], '.tmp', '.dbt')) + FErase(strtran(aTempDBF[i], '.tmp', '.dbt')) + END + NEXT + + aTableTemp := {} + aTempDBF := {} +Return + + +Function SQLFetch( fetchall ) + Local oQuery + Local oRow + Local cAlias := Upper(Alias()) + Local i, x, y + Local nPos := 0 + Local lEof := .F. + + Local cString := "" + Local aStruct + + 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. + end + + IF oQuery:Lastrec() >= nPos + + y := nPos + + 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++ + end + + ELSE + // Posiciona registro no eof + DBSkip() + + END + + lEof := nPos > oQuery:Lastrec() + END +return lEof + + +Procedure SQLFetchAll() + SQLFetch(.t.); DBGotop() +Return + + +Function SQLOpen( cAlias, cQuery, xFetch ) + Local cFile + Local Result := .t. + Local i, x + Local oServer + Local oQuery + Local aStrudbf + Local lFetch + Local cOrder + + 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() + END + + IF ISNIL(cQuery) + cQuery := 'SELECT * FROM ' + cAlias + ' ORDER BY ' + cOrder + END + + cQuery := cQuery + oQuery := oServer:Query(cQuery) + + IF oQuery:NetErr() + Alert(oQuery:Error()) + RETURN .F. + END + + 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 + + END + + IF ! ISNIL(xFetch) + lFetch := xFetch + ELSE + lFetch := .F. + END + + /* 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 + + END + + /* Traz registros da base de dados */ + SQLFetch(lFetch) + + IF lFetch + DBGotop() + END + +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:Error()) + lRetval := .f. + end + oServer:lAllCols := .F. +Return lRetval + + +Procedure SQLDestroy() + if ! ISNIL(oServer) + oServer:Destroy() + end +return + + +Function SQLCurrentServer + Return oServer + + +Function SQLQuery( cQuery ) + Local oQuery + + oQuery := oServer:Query(cQuery) + IF oQuery:NetErr() + Alert(cQuery + ':' + oQuery:Error()) + END +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:Error()) + + result := .F. + + ELSE + oQuery:Destroy() + + END +Return result + + +Function SQLPrepare( cQuery, x01, x02, x03, x04, x05, x06, x07, x08, x09, x10,; + x11, x12, x13, x14, x15, x16, x17, x18, x19, x20,; + x21, x22, x23, x24, x25, x26, x27, x28, x29, x30,; + x31, x32, x33, x34, x35, x36, x37, x38, x39, x40,; + x41, x42, x43, x44, x45, x46, x47, x48, x49, x50,; + x51, x52, x53, x54, x55, x56, x57, x58, x59, x60,; + x61, x62, x63, x64, x65, x66, x67, x68, x69, x70,; + x71, x72, x73, x74, x75, x76, x77, x78, x79, x80,; + x81, x82, x83, x84, x85, x86, x87, x88, x89, x90,; + x91, x92, x93, x94, x95, x96, x97, x98, x99, x100) + 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 := PValue(i) + + if ! ISNIL(x) .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' + end + + cQuery := strtran(cQuery, '{:' + ltrim(str(i-1)) + '}', x) + next + end + + 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( lStart ) + 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 := ''; END + + IF ';' $ xDirectory + xDirectory := LEFT( xDirectory, AT( ';', xDirectory ) - 1 ) + END + + 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 + END +Return cString + + +Function DtoQ(cData) +Return "'" + Str(Year(cData),4) + "-" + StrZero(Month(cData), 2) + "-" + StrZero(Day(cData), 2) + "'" + +Function StoQ(cData) +Return "'" + cData + "'" + diff --git a/harbour/contrib/pgsql/tests/dbf2pg.prg b/harbour/contrib/pgsql/tests/dbf2pg.prg new file mode 100644 index 0000000000..d5ef8e2277 --- /dev/null +++ b/harbour/contrib/pgsql/tests/dbf2pg.prg @@ -0,0 +1,325 @@ +/* + * + * $Id$ + * + * Harbour Project source code: + * dbf2pg.prg - converts a .dbf file into a Postgres table + * + * Copyright 2000 Maurilio Longo + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + * The Original file was ported from Mysql and changed by Rodrigo Moreno rodrigo_moreno@yahoo.com + * + */ + +#include "inkey.ch" +#include "common.ch" + +#define CRLF chr(13) + chr(10) + +procedure main(c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15, c16, c17, c18, c19, c20) + + local cTok, nTok := 1 + local cHostName := "localhost" + local cUser := "postgres" + local cPassWord := "" + local cDataBase, cTable, cFile + local aDbfStruct, i + local lCreateTable := .F. + local oServer, oTable, oRecord + Local cField + Local sType + Local dType + Local cValue + Local nCommit := 100 + Local nHandle + Local nCount := 0 + Local nRecno := 0 + Local lTruncate := .F. + Local lUseTrans := .F. + Local cPath := 'public' + + SET CENTURY ON + SET EPOCH TO 1960 + SET DELETE ON + SET DATE FORMAT "dd/mm/yyyy" + + rddSetDefault( "DBFDBT" ) + + if PCount() < 6 + help() + quit + endif + + i := 1 + // Scan parameters and setup workings + while (i <= PCount()) + + cTok := PValue(i++) + + do case + case cTok == "-h" + cHostName := PValue(i++) + + case cTok == "-d" + cDataBase := PValue(i++) + + case cTok == "-t" + cTable := PValue(i++) + + case cTok == "-f" + cFile := PValue(i++) + + case cTok == "-u" + cUser := PValue(i++) + + case cTok == "-p" + cPassWord := PValue(i++) + + case cTok == "-c" + lCreateTable := .T. + + case cTok == "-x" + lTruncate := .T. + + case cTok == "-s" + lUseTrans := .T. + + case cTok == "-m" + nCommit := val(PValue(i++)) + + case cTok == "-r" + nRecno := val(PValue(i++)) + + case cTok == "-e" + cPath := PValue(i++) + + otherwise + help() + quit + endcase + enddo + + // create log file + if (nHandle := FCreate(Trim(cTable) + '.log')) == -1 + ? 'Cannot create log file' + quit + endif + + USE (cFile) SHARED + aDbfStruct := DBStruct() + + oServer := TPQServer():New(cHostName, cDatabase, cUser, cPassWord, nil, cPath) + if oServer:NetErr() + ? oServer:Error() + quit + endif + + oServer:lallCols := .F. + + if lCreateTable + if oServer:TableExists(cTable) + oServer:DeleteTable(cTable) + if oServer:NetErr() + ? oServer:Error() + FWrite( nHandle, "Error: " + oServer:Error() + CRLF ) + FClose( nHandle ) + quit + endif + endif + oServer:CreateTable(cTable, aDbfStruct) + + if oServer:NetErr() + ? oServer:Error() + FWrite( nHandle, "Error: " + oServer:Error() + CRLF ) + FClose( nHandle ) + quit + endif + endif + + if lTruncate + oServer:Execute('truncate table ' + cTable) + if oServer:NetErr() + ? oServer:Error() + FWrite( nHandle, "Error: " + oServer:Error() + CRLF ) + FClose( nHandle ) + quit + endif + endif + + oTable := oServer:Query("SELECT * FROM " + cTable + " LIMIT 1") + if oTable:NetErr() + Alert(oTable:Error()) + FWrite( nHandle, "Error: " + oTable:Error() + CRLF ) + FClose( nHandle ) + quit + endif + + if lUseTrans + oServer:StartTransaction() + endif + + FWrite( nHandle, "Start: " + time() + CRLF ) + + ? "Start: ", time() + ? + + if ! Empty(nRecno) + dbgoto(nRecno) + endif + + while ! eof() .and. Inkey() <> K_ESC .and. (empty(nRecno) .or. nRecno == recno()) + oRecord := oTable:GetBlankRow() + + for i := 1 to oTable:FCount() + cField := lower(oTable:FieldName(i)) + sType := fieldtype(fieldpos(cField)) + dType := oRecord:Fieldtype(i) + cValue := fieldget(fieldpos(cField)) + + if ! ISNIL(cValue) + if dType != sType + if dType == 'C' .and. sType == 'N' + cValue := Str(cValue) + + elseif dType == 'C' .and. sType == 'D' + cValue := DtoC(cValue) + + elseif dType == 'C' .and. sType == 'L' + cValue := IIF( cValue, "S", "N" ) + + elseif dType == 'N' .and. sType == 'C' + cValue := val(cValue) + + elseif dType == 'N' .and. sType == 'D' + cValue := Val(DtoS(cValue)) + + elseif dType == 'N' .and. sType == 'L' + cValue := IIF( cValue, 1, 0 ) + + elseif dType == 'D' .and. sType == 'C' + cValue := CtoD(cValue) + + elseif dType == 'D' .and. sType == 'N' + cValue := StoD(Str(cValue)) + + elseif dType == 'L' .and. sType == 'N' + cValue := ! Empty(cValue) + + elseif dType == 'L' .and. sType == 'C' + cValue := IIF( alltrim(cValue) $ "YySs1", .T., .F. ) + + end + end + + if ! ISNIL(cValue) + if oRecord:Fieldtype(i) == 'C' .or. oRecord:Fieldtype(i) == 'M' + oRecord:FieldPut(i, hb_oemtoansi(cValue)) + else + oRecord:FieldPut(i, cValue) + endif + endif + endif + next + + oTable:Append(oRecord) + + if oTable:NetErr() + ? + ? "Error Record: ", recno(), left(oTable:Error(),70) + ? + FWrite( nHandle, "Error at record: " + Str(recno()) + " Description: " + oTable:Error() + CRLF ) + else + nCount++ + endif + + dbSkip() + + if (nCount % nCommit) == 0 + DevPos(Row(), 1) + DevOut("imported recs: " + Str(nCount)) + + if lUseTrans + oServer:commit() + oServer:StartTransaction() + endif + endif + enddo + + if (nCount % nCommit) != 0 + if lUseTrans + oServer:commit() + endif + endif + + FWrite( nHandle, "End: " + time() + ", records in dbf: " + ltrim(str(recno())) + ", imported recs: " + ltrim(str(nCount)) + CRLF ) + + ? "End: ", time() + ? + + FClose( nHandle ) + + close all + oTable:Destroy() + oServer:Destroy() +return + + +procedure Help() + + ? "dbf2pg - dbf file to PostgreSQL table conversion utility" + ? "-h hostname (default: localhost)" + ? "-u user (default: root)" + ? "-p password (default no password)" + ? "-d name of database to use" + ? "-t name of table to add records to" + ? "-c delete existing table and create a new one" + ? "-f name of .dbf file to import" + ? "-x truncate table before append records" + ? "-s use transaction" + ? "-m commit interval" + ? "-r insert only record number" + ? "-e search path" + + ? "" + +return diff --git a/harbour/contrib/pgsql/tests/simple.prg b/harbour/contrib/pgsql/tests/simple.prg new file mode 100644 index 0000000000..1584f2954d --- /dev/null +++ b/harbour/contrib/pgsql/tests/simple.prg @@ -0,0 +1,180 @@ +/* + * + * $Id$ + * + */ + +#include "common.ch" + +Function main() + Local oServer, oQuery, oRow, i, x, aTables, aStruct, aKey + + Local cHost := 'localhost' + Local cDatabase := 'test' + Local cUser := 'user' + Local cPass := 'pass' + Local cQuery + + oServer := TPQServer():New(cHost, cDatabase, cUser, cPass) + + if oServer:NetErr() + ? oServer:Error() + quit + end + + oServer:SetVerbosity(2) + oServer:traceon('lixo.log') + + ? 'Tables...' + + For x := 1 to 1 + aTables := oServer:ListTables() + + For i := 1 to Len(aTables) + ? aTables[i] + next + Next + + if oServer:TableExists('TEST') + ? oQuery := oServer:Execute('DROP TABLE Test') + + oQuery:Destroy() + end + + ? 'Creating test table...' + cQuery := 'CREATE TABLE test(' + cQuery += ' Code integer not null primary key, ' + cQuery += ' dept Integer, ' + cQuery += ' Name Varchar(40), ' + cQuery += ' Sales boolean, ' + cQuery += ' Tax Float4, ' + cQuery += ' Salary Double Precision, ' + cQuery += ' Budget Numeric(12,2), ' + cQuery += ' Discount Numeric (5,2), ' + cQuery += ' Creation Date, ' + cQuery += ' Description text ) ' + + oQuery := oServer:Query(cQuery) + + if oQuery:neterr() + ? oQuery:Error() + end + + oQuery:Destroy() + + ? 'Structure of test table' + aStruct := oServer:TableStruct('test') + + For i := 1 to Len(aStruct) + ? + For x := 1 to Len(aStruct[i]) + ?? aStruct[i,x], " " + Next + next + + ? 'Inserting, declared transaction control ' + oServer:StartTransaction() + + For i := 1 to 10 + cQuery := "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) " + cQuery += "VALUES( " + str(i) + ", 2, 'TEST', 'y', 5, 3000, 1500.2, 7.5, '12-22-2003', 'Short Description about what ? ')" + + oQuery := oServer:Query(cQuery) + + if oQuery:neterr() + ? oQuery:error() + end + + oQuery:destroy() + Next + + oServer:Commit() + + oQuery := oServer:Query('SELECT code, name, description, sales FROM test') + + + aStruct := oQuery:Struct() + + For i := 1 to Len(aStruct) + ? aStruct[i,1], aStruct[i,2], aStruct[i,3], aStruct[i,4] + Next + + aKey := oQuery:GetKeyField() + + ? "Fields: ", oQuery:Fcount(), "Primary Key: ", aKey[1] + + oRow := oQuery:Blank() + + ? oRow:FCount(), ; + oRow:Fieldpos('sales'), ; + oRow:Fieldget(1), ; + oRow:Fieldname(2), ; + oRow:Fieldtype(1), ; + oRow:Fielddec(1), ; + oRow:Fieldlen(1) + + oRow:Fieldput(1, 150) + oRow:Fieldput(2, 'MY TEST') + + ? oRow:Fieldget(1), oRow:Fieldget(2) + + ? oRow:aRow[1], oRow:aRow[2], oRow:aOld[1], oRow:aOld[2] + + ? oQuery:Append(oRow) + + ? oQuery:error() + + DO WHILE ! oQuery:Eof() + ? oQuery:Recno(),; + oQuery:Fieldpos('code'),; + oQuery:Fieldget(oQuery:Fieldpos('code')), ; + oQuery:Fieldget(4), ; + oQuery:Fieldget(2), ; + oQuery:Fieldname(1),; + oQuery:Fieldtype(1), ; + oQuery:Fielddec(1), ; + oQuery:Fieldlen(1),; + oQuery:Fieldget(3) + + if oQuery:Recno() == 50 + oRow := oQuery:getrow() + + oRow:Fieldput(2, 'My Second test') + ? 'Update: ', oQuery:Update(oRow) + end + + if oQuery:Recno() == 60 + oRow := oQuery:getrow() + ? 'Delete: ', oQuery:Delete(oRow) + end + + oQuery:Skip() + + END + + oQuery:Refresh() + + For i := 1 to oQuery:Lastrec() + oRow := oQuery:getrow(i) + + ? i, oRow:Fieldget(oRow:Fieldpos('code')), ; + oRow:Fieldget(4), ; + oRow:Fieldget(2), ; + oRow:Fieldname(1),; + oRow:Fieldtype(1), ; + oRow:Fielddec(1), ; + oRow:Fieldlen(1),; + oRow:Fieldget(i, 3) + + END + + oQuery:Destroy() + + oServer:Destroy() + + ? "Closing..." + + return nil + + + diff --git a/harbour/contrib/pgsql/tests/stress.prg b/harbour/contrib/pgsql/tests/stress.prg new file mode 100644 index 0000000000..042cb4d243 --- /dev/null +++ b/harbour/contrib/pgsql/tests/stress.prg @@ -0,0 +1,131 @@ +/* + * + * $Id$ + * + * VERY IMPORTANT: Don't use this querys as sample, they are used for stress tests !!! + * + */ + +#include "common.ch" +#include "../postgres.ch" + +Function Main() + Local conn, res, oRow, i, x + + Local cServer := '192.168.1.20' + Local cDatabase := 'test' + Local cUser := 'rodrigo' + Local cPass := 'moreno' + Local cQuery + + CLEAR SCREEN + + ? 'Connecting....' + conn := PQconnect(cDatabase, cServer, cUser, cPass, 5432) + + ? PQstatus(conn), PQerrormessage(conn) + + if PQstatus(conn) != CONNECTION_OK + quit + endif + + ? 'Dropping table...' + + res := PQexec(conn, 'DROP TABLE test') + PQclear(res) + + ? 'Creating test table...' + cQuery := 'CREATE TABLE test(' + cQuery += ' Code integer not null primary key, ' + cQuery += ' dept Integer, ' + cQuery += ' Name Varchar(40), ' + cQuery += ' Sales boolean, ' + cQuery += ' Tax Float4, ' + cQuery += ' Salary Double Precision, ' + cQuery += ' Budget Numeric(12,2), ' + cQuery += ' Discount Numeric (5,2), ' + cQuery += ' Creation Date, ' + cQuery += ' Description text ) ' + + res := PQexec(conn, cQuery) + PQclear(res) + + res := PQexec(conn, 'SELECT code, dept, name, sales, salary, creation FROM test') + PQclear(res) + + res := PQexec(conn, 'BEGIN') + PQclear(res) + + For i := 1 to 10000 + @ 15,0 say 'Inserting values....' + str(i) + + cQuery := 'INSERT INTO test(code, dept, name, sales, salary, creation) ' + cQuery += 'VALUES( ' + str(i) + ',' + str(i+1) + ", 'DEPARTMENT NAME " + strzero(i) + "', 'y', " + str(300.49+i) + ", '2003-12-28' )" + + res := PQexec(conn, cQuery) + PQclear(res) + + if mod(i,100) == 0 + ? res := PQexec(conn, 'COMMIT') + ? PQclear(res) + + ? res := PQexec(conn, 'BEGIN') + ? PQclear(res) + end + Next + + For i := 5000 to 7000 + @ 16,0 say 'Deleting values....' + str(i) + + cQuery := 'DELETE FROM test WHERE code = ' + str(i) + res := PQexec(conn, cQuery) + PQclear(res) + + if mod(i,100) == 0 + res := PQexec(conn, 'COMMIT') + PQclear(res) + + res := PQexec(conn, 'BEGIN') + PQclear(res) + end + Next + + For i := 2000 to 3000 + @ 17,0 say 'Updating values....' + str(i) + + cQuery := 'UPDATE FROM test SET salary = 400 WHERE code = ' + str(i) + res := PQexec(conn, cQuery) + PQclear(res) + + if mod(i,100) == 0 + res := PQexec(conn, 'COMMIT') + PQclear(res) + + res := PQexec(conn, 'BEGIN') + PQclear(res) + end + Next + + res := PQexec(conn, 'SELECT sum(salary) as sum_salary FROM test WHERE code between 1 and 4000') + + if PQresultStatus(res) == PGRES_TUPLES_OK + @ 18,0 say 'Sum values....' + PQgetvalue(res, 1, 1) + end + + PQclear(res) + + x := 0 + For i := 1 to 4000 + res := PQexec(conn, 'SELECT salary FROM test WHERE code = ' + str(i)) + + if PQresultStatus(res) == PGRES_TUPLES_OK + x += val(PQgetvalue(res, 1, 1)) + + @ 19,0 say 'Sum values....' + str(x) + end + Next + + ? "Closing..." + PQclose(conn) + +return nil diff --git a/harbour/contrib/pgsql/tests/test.prg b/harbour/contrib/pgsql/tests/test.prg new file mode 100644 index 0000000000..da640236e7 --- /dev/null +++ b/harbour/contrib/pgsql/tests/test.prg @@ -0,0 +1,102 @@ +/* + * + * $Id$ + * + */ + +#include "../postgres.ch" + +Function main() + Local conn, res, aTemp, i, x,y, pFile + Local cDb := 'test' + Local cUser := 'user' + Local cPass := 'pass' + + CLEAR SCREEN + + conn := PQsetdbLogin( 'localhost', "5432", NIL, NIL, cDb, cUser, cPass) + ? PQdb(conn), PQuser(conn), PQpass(conn), PQhost(conn), PQport(conn), PQtty(conn), PQoptions(conn) + ? PQClose(conn) + + conn := PQConnect(cDb, 'localhost', cuser, cpass, 5432) + + ? PQstatus(conn), PQerrormessage(conn) + + if PQstatus(conn) != CONNECTION_OK + quit + endif + + ? "Blocking: ", PQisnonblocking(conn), PQsetnonblocking(conn, .t.), PQisnonblocking(conn) + + pFile := PQcreatetrace( 'trace.log' ) + PQtrace( conn, pFile ) + + ? "Verbose: ", PQsetErrorVerbosity(conn, 2) + + ? "Protocol: ", PQprotocolVersion(conn), ; + " Server Version: ", PQserverVersion(conn), ; + " Client Encoding: ", PQsetClientEncoding(conn, "ASCII"), ; + "New encode: ", PQclientEncoding(conn) + + ? PQdb(conn), PQuser(conn), PQpass(conn), PQhost(conn), PQport(conn), PQtty(conn), PQoptions(conn) + + res := PQexec('drop table products') + ? PQresultStatus(res), PQresultErrorMessage(res) + PQclear(res) + + res := PQexec('create table products ( product_no numeric(10), name varchar(20), price numeric(10,2) )') + ? PQresultStatus(res), PQresultErrorMessage(res) + PQclear(res) + + res := PQexecParams(conn, 'insert into products(product_no, name, price) values ($1, $2, $3)', {'2', 'bread', '10.95'}) + ? "Oid Row: ", PQoidValue(res), PQoidStatus(res) + + if PQresultStatus(res) != PGRES_COMMAND_OK + ? PQresultStatus(res), PQresultErrorMessage(res) + endif + PQclear(res) + + res := PQexec(conn, 'select price, name, product_no as "produto" from products') + + if PQresultStatus(res) != PGRES_TUPLES_OK + ? PQresultStatus(res), PQresultErrorMessage(res) + endif + + ? "Binary: ", PQbinaryTuples(res) + ? "Rows: ", PQntuples(res), "Cols: ", PQnfields(res) + ? PQfname(res, 1), PQftable(res, 1), PQftype(res, 1), PQfnumber(res, "name"), PQfmod(res, 1), PQfsize(res, 1), PQgetisnull(res,1,1) + + aTemp := PQmetadata(res) + + for x := 1 to len(aTemp) + ? "Linha 1: " + for y := 1 to 6 + ?? aTemp[x,y], ", " + next + next + + ? PQFcount(res) + + ? PQlastrec(res) + + ? PQGetvalue(res,1, 2) + + ? PQclear(res) + + ? "Large Objects, always should be in a transaction..." + + res := PQexec(conn, 'begin') + PQclear(res) + + ? (x := lo_Import( conn, 'test.prg' )) + ? lo_Export( conn, x, 'test.new' ) + ? lo_Unlink( conn, x ) + + res := PQexec(conn, 'commit') + PQclear(res) + + PQuntrace( conn ) + PQclosetrace( pFile ) + PQClose(conn) + return nil + diff --git a/harbour/contrib/pgsql/tpostgre.prg b/harbour/contrib/pgsql/tpostgre.prg new file mode 100644 index 0000000000..0c44e594ff --- /dev/null +++ b/harbour/contrib/pgsql/tpostgre.prg @@ -0,0 +1,1321 @@ +/* + * $Id$ + * + * xHarbour Project source code: + * PostgreSQL RDBMS low level (client api) interface code. + * + * Copyright 2003 Rodrigo Moreno rodrigo_moreno@yahoo.com + * www - http://www.xharbour.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + * See doc/license.txt for licensing terms. + * + */ + +#include "common.ch" +#include "hbclass.ch" +#include "postgres.ch" + +CLASS TPQServer + DATA pDb + DATA lTrans + DATA lallCols INIT .T. + DATA Schema INIT 'public' + DATA lError INIT .F. + DATA cError INIT '' + DATA lTrace INIT .F. + DATA pTrace + + METHOD New( cHost, cDatabase, cUser, cPass, nPort, Schema ) + METHOD Destroy() + METHOD Close() INLINE ::Destroy() + + METHOD StartTransaction() + METHOD TransactionStatus() INLINE PQtransactionstatus(::pDb) + METHOD Commit() + METHOD Rollback() + + METHOD Query( cQuery ) + METHOD Execute( cQuery ) INLINE ::Query(cQuery) + METHOD SetSchema( cSchema ) + + METHOD NetErr() INLINE ::lError + METHOD ErrorMsg() INLINE ::cError + + METHOD TableExists( cTable ) + METHOD ListTables() + METHOD TableStruct( cTable ) + METHOD CreateTable( cTable, aStruct ) + METHOD DeleteTable( cTable ) + METHOD TraceOn(cFile) + METHOD TraceOff() + METHOD SetVerbosity(num) INLINE PQsetErrorVerbosity( ::pDb, iif( num >= 0 .and. num <= 2, num, 1 ) ) + + //DESTRUCTOR Destroy +ENDCLASS + + +METHOD New( cHost, cDatabase, cUser, cPass, nPort, Schema ) CLASS TPQserver + Local res + DEFAULT nPort TO 5432 + + ::pDB := PQconnect(cDatabase, cHost, cUser, cPass, nPort) + + if PQstatus(::pDb) != CONNECTION_OK + ::lError := .T. + ::cError := PQerrormessage(::pDb) + + else + if ! Empty(Schema) + ::SetSchema(Schema) + else + res := PQexec( ::pDB, 'SELECT current_schema()' ) + if PQresultStatus(res) == PGRES_TUPLES_OK + ::Schema := PQgetvalue( res, 1, 1 ) + endif + PQclear(res) + endif + endif + +RETURN self + + +METHOD Destroy() CLASS TPQserver + ::TraceOff() + PQClose(::pDb) +RETURN nil + + +METHOD SetSchema( cSchema ) CLASS TPQserver + Local res + Local result := .F. + + if PQstatus(::pDb) == CONNECTION_OK + ::Schema := cSchema + res := PQexec( ::pDB, 'SET search_path TO ' + cSchema ) + result := (PQresultStatus(res) == PGRES_COMMAND_OK) + PQclear(res) + endif +RETURN result + + +METHOD StartTransaction() CLASS TPQserver + Local res, lError + + res := PQexec( ::pDB, 'BEGIN' ) + lError := PQresultstatus(res) != PGRES_COMMAND_OK + + if lError + ::lError := .T. + ::cError := PQresultErrormessage(res) + else + ::lError := .F. + ::cError := '' + endif + PQclear(res) +RETURN lError + + +METHOD Commit() CLASS TPQserver + Local res, lError + + res := PQexec( ::pDB, 'COMMIT' ) + lError := PQresultstatus(res) != PGRES_COMMAND_OK + + if lError + ::lError := .T. + ::cError := PQresultErrormessage(res) + else + ::lError := .F. + ::cError := '' + endif + PQclear(res) +RETURN lError + + +METHOD Rollback() CLASS TPQserver + Local res, lError + + res := PQexec( ::pDB, 'ROLLBACK' ) + lError := PQresultstatus(res) != PGRES_COMMAND_OK + + if lError + ::lError := .T. + ::cError := PQresultErrormessage(res) + else + ::lError := .F. + ::cError := '' + endif + PQclear(res) +RETURN lError + + +METHOD Query( cQuery ) CLASS TPQserver + Local oQuery + + oQuery := TPQquery():New(::pDB, cQuery, ::lallCols, ::Schema) +RETURN oQuery + + +METHOD TableExists( cTable ) CLASS TPQserver + Local result := .F. + Local cQuery + Local res + + cQuery := "select table_name " + cQuery += " from information_schema.tables " + cQuery += " where table_type = 'BASE TABLE' and table_schema = " + DataToSql(::Schema) + " and table_name = " + DataToSql(lower(cTable)) + + res := PQexec( ::pDB, cQuery ) + + if PQresultstatus(res) == PGRES_TUPLES_OK + result := (PQlastrec(res) != 0) + ::lError := .F. + ::cError := '' + else + ::lError := .T. + ::cError := PQresultErrormessage(res) + endif + + PQclear(res) +RETURN result + + +METHOD ListTables() CLASS TPQserver + Local result := {} + Local cQuery + Local res + Local i + + cQuery := "select table_name " + cQuery += " from information_schema.tables " + cQuery += " where table_schema = " + DataToSql(::Schema) + " and table_type = 'BASE TABLE' " + + res := PQexec( ::pDB, cQuery ) + + if PQresultstatus(res) == PGRES_TUPLES_OK + For i := 1 to PQlastrec(res) + aadd( result, PQgetvalue( res, i, 1 ) ) + Next + ::lError := .F. + ::cError := '' + else + ::lError := .T. + ::cError := PQresultErrormessage(res) + endif + + PQclear(res) +RETURN result + +METHOD TableStruct( cTable ) CLASS TPQserver + Local result := {} + Local cQuery + Local res + Local i + Local cField + Local cType + Local nSize + Local nDec + + cQuery := "SELECT column_name, data_type, character_maximum_length, numeric_precision, numeric_scale " + cQuery += " FROM information_schema.columns " + cQuery += " WHERE table_schema = " + DataToSql(::Schema) + " and table_name = " + DataToSql(lower(cTable)) + cQuery += "ORDER BY ordinal_position " + + res := PQexec( ::pDB, cQuery ) + + if PQresultstatus(res) == PGRES_TUPLES_OK + For i := 1 to PQlastrec(res) + cField := PQgetvalue(res, i, 1) + cType := PQgetvalue(res, i, 2) + nSize := PQgetvalue(res, i, 4) + nDec := PQgetvalue(res, i, 5) + + if 'char' $ cType + cType := 'C' + nSize := Val(PQgetvalue(res, i, 3)) + nDec := 0 + + elseif 'text' $ cType + cType := 'M' + nSize := 10 + nDec := 0 + + elseif 'boolean' $ cType + cType := 'L' + nSize := 1 + nDec := 0 + + elseif 'smallint' $ cType + cType := 'N' + nSize := 5 + nDec := 0 + + elseif 'integer' $ cType .or. 'serial' $ cType + cType := 'N' + nSize := 9 + nDec := 0 + + elseif 'bigint' $ cType .or. 'bigserial' $ cType + cType := 'N' + nSize := 19 + nDec := 0 + + elseif 'decimal' $ cType .or. 'numeric' $ cType + cType := 'N' + nDec := val(nDec) + // Postgres don't store ".", but .dbf does, it can cause data width problem + nSize := val(nSize) + iif( ! Empty(nDec), 1, 0 ) + + // Numeric/Decimal without scale/precision can genarete big values, so, i limit this to 10,5 + + if nDec > 100 + nDec := 5 + endif + + if nSize > 100 + nSize := 15 + endif + + elseif 'real' $ cType .or. 'float4' $ cType + cType := 'N' + nSize := 15 + nDec := 4 + + elseif 'double precision' $ cType .or. 'float8' $ cType + cType := 'N' + nSize := 19 + nDec := 9 + + elseif 'money' $ cType + cType := 'N' + nSize := 9 + nDec := 2 + + elseif 'timestamp' $ cType + cType := 'C' + nSize := 20 + nDec := 0 + + elseif 'date' $ cType + cType := 'D' + nSize := 8 + nDec := 0 + + elseif 'time' $ cType + cType := 'C' + nSize := 10 + nDec := 0 + + else + // Unsuported + cType := 'U' + nSize := 0 + nDec := -1 + + end + + if cType <> 'U' + aadd( result, { cField, cType, nSize, nDec } ) + end + + Next + ::lError := .F. + ::cError := '' + else + ::lError := .T. + ::cError := PQresultErrormessage(res) + endif + + PQclear(res) +RETURN result + +METHOD CreateTable( cTable, aStruct ) CLASS TPQserver + Local result := .T. + Local cQuery + Local res + Local i + + cQuery := 'CREATE TABLE ' + ::Schema + '.' + cTable + '( ' + + For i := 1 to Len(aStruct) + + cQuery += aStruct[i, 1] + + if aStruct[ i, 2 ] == "C" + cQuery += ' Char(' + ltrim(str(aStruct[i, 3])) + ')' + + elseif aStruct[ i, 2 ] == "D" + cQuery += ' Date ' + + elseif aStruct[ i, 2 ] == "N" + cQuery += ' Numeric(' + ltrim(str(aStruct[i, 3])) + ',' + ltrim(str(aStruct[i,4])) + ')' + + elseif aStruct[ i, 2 ] == "L" + cQuery += ' boolean ' + + elseif aStruct[ i, 2 ] == "M" + cQuery += ' text ' + end + + if i == Len(aStruct) + cQuery += ')' + else + cQuery += ',' + end + Next + + res := PQexec( ::pDB, cQuery ) + + if PQresultstatus(res) != PGRES_COMMAND_OK + result := .F. + ::lError := .T. + ::cError := PQresultErrormessage(res) + else + ::lError := .F. + ::cError := '' + end + + PQclear(res) +RETURN result + + +METHOD DeleteTable( cTable ) CLASS TPQserver + Local result := .T. + Local res + + res := PQexec( ::pDB, 'DROP TABLE ' + ::Schema + '.' + cTable ) + + if PQresultstatus(res) != PGRES_COMMAND_OK + result := .F. + ::lError := .T. + ::cError := PQresultErrormessage(res) + else + ::lError := .F. + ::cError := '' + end + + PQclear(res) +RETURN result + + +METHOD TraceOn( cFile ) CLASS TPQserver + ::pTrace := PQcreatetrace( cFile ) + + if ::pTrace != NIL + PQtrace( ::pDb, ::pTrace ) + ::lTrace := .t. + endif +RETURN nil + + +METHOD TraceOff() CLASS TPQserver + if ::pTrace != NIL + PQuntrace( ::pDb ) + PQclosetrace( ::pTrace ) + endif + + ::lTrace := .f. +RETURN nil + + + +CLASS TPQQuery + DATA pQuery + DATA pDB + + DATA lBof + DATA lEof + DATA lClosed + DATA lallCols INIT .T. + + DATA lError INIT .F. + DATA cError INIT '' + + DATA cQuery + DATA nRecno + DATA nFields + DATA nLastrec + + DATA aStruct + DATA aKeys + DATA TableName + DATA Schema + DATA rows INIT 0 + + METHOD New( pDB, cQuery, lallCols, cSchema, res ) + METHOD Destroy() + METHOD Close() INLINE ::Destroy() + + METHOD Refresh() + METHOD Fetch() INLINE ::Skip() + METHOD Skip( nRecno ) + + METHOD Bof() INLINE ::lBof + METHOD Eof() INLINE ::lEof + METHOD RecNo() INLINE ::nRecno + METHOD Lastrec() INLINE ::nLastrec + METHOD Goto(nRecno) + + METHOD NetErr() INLINE ::lError + METHOD ErrorMsg() INLINE ::cError + + METHOD FCount() INLINE ::nFields + METHOD FieldName( nField ) + METHOD FieldPos( cField ) + METHOD FieldLen( nField ) + METHOD FieldDec( nField ) + METHOD FieldType( nField ) + METHOD Update( oRow ) + METHOD Delete( oRow ) + METHOD Append( oRow ) + METHOD SetKey() + + METHOD Changed(nField) INLINE ::aRow[nField] != ::aOld[nField] + METHOD Blank() INLINE ::GetBlankRow() + + METHOD Struct() + + METHOD FieldGet( nField, nRow ) + METHOD GetRow( nRow ) + METHOD GetBlankRow() + + //DESTRUCTOR Destroy +ENDCLASS + + +METHOD New( pDB, cQuery, lallCols, cSchema, res ) CLASS TPQquery + ::pDB := pDB + ::lClosed := .T. + ::cQuery := cQuery + ::lallCols := lallCols + ::Schema := cSchema + + if ! ISNIL(res) + ::pQuery := res + endif + + ::Refresh(ISNIL(res)) +RETURN self + + +METHOD Destroy() CLASS TPQquery + if ! ::lClosed + PQclear( ::pQuery ) + ::lClosed := .T. + endif +RETURN .T. + + +METHOD Refresh(lQuery,lMeta) CLASS TPQquery + Local res + Local cTableCodes := '' + Local cFieldCodes := '' + Local aStruct := {} + Local aTemp := {} + Local i + Local n + Local temp + Local cQuery + Local cType, nType, nDec, nSize + + Default lQuery To .T. + Default lMeta To .T. + + ::Destroy() + + ::lBof := .F. + ::lEof := .F. + ::lClosed := .F. + ::nRecno := 0 + ::nLastrec := 0 + ::Rows := 0 + + if lQuery + res := PQexec( ::pDB, ::cQuery ) + else + res := ::pQuery + endif + + if PQresultstatus(res) == PGRES_TUPLES_OK + + if lMeta + ::aStruct := {} + ::nFields := 0 + // Get some information about metadata + aTemp := PQmetadata(res) + if ISARRAY(aTemp) + For i := 1 to Len(aTemp) + cType := aTemp[ i, 2 ] + nSize := aTemp[ i, 3 ] + nDec := aTemp[ i, 4 ] + + if nSize == 0 .and. PQlastrec(res) >= 1 + nSize := PQgetLength(res, 1, i) + endif + + if 'char' $ cType + cType := 'C' + + elseif 'text' $ cType + cType := 'M' + + elseif 'boolean' $ cType + cType := 'L' + nSize := 1 + + elseif 'smallint' $ cType + cType := 'N' + nSize := 5 + + elseif 'integer' $ cType .or. 'serial' $ cType + cType := 'N' + nSize := 9 + + elseif 'bigint' $ cType .or. 'bigserial' $ cType + cType := 'N' + nSize := 19 + + elseif 'decimal' $ cType .or. 'numeric' $ cType + cType := 'N' + + // Postgres don't store ".", but .dbf does, it can cause data width problem + if ! Empty(nDec) + nSize++ + endif + + // Numeric/Decimal without scale/precision can genarete big values, so, i limit this to 10,5 + if nDec > 100 + nDec := 5 + endif + + if nSize > 100 + nSize := 15 + endif + + elseif 'real' $ cType .or. 'float4' $ cType + cType := 'N' + nSize := 15 + nDec := 4 + + elseif 'double precision' $ cType .or. 'float8' $ cType + cType := 'N' + nSize := 19 + nDec := 9 + + elseif 'money' $ cType + cType := 'N' + nSize := 10 + nDec := 2 + + elseif 'timestamp' $ cType + cType := 'C' + nSize := 20 + + elseif 'date' $ cType + cType := 'D' + nSize := 8 + + elseif 'time' $ cType + cType := 'C' + nSize := 10 + + else + // Unsuported + cType := 'K' + endif + + aadd( aStruct, {aTemp[ i, 1 ], cType, nSize, nDec, aTemp[i, 5], aTemp[i, 6]} ) + Next + + ::nFields := PQfcount(res) + + ::aStruct := aStruct + + endif + endif + + ::nLastrec := PQlastrec(res) + ::lError := .F. + ::cError := '' + + if ::nLastrec != 0 + ::nRecno := 1 + endif + + elseif PQresultstatus(res) == PGRES_COMMAND_OK + ::lError := .F. + ::cError := '' + ::rows := val(PQcmdTuples(res)) + + else + ::lError := .T. + ::cError := PQresultErrormessage(res) + endif + + ::pQuery := res + +RETURN ! ::lError + + +METHOD Struct() CLASS TPQquery + Local result := {} + Local i + + For i := 1 to Len(::aStruct) + aadd( result, { ::aStruct[i, 1], ::aStruct[i, 2], ::aStruct[i, 3], ::aStruct[i, 4] }) + Next +RETURN result + + +METHOD Skip( nrecno ) CLASS TPQquery + DEFAULT nRecno TO 1 + + if ::nRecno + nRecno > 0 .and. ::nRecno + nRecno <= ::nLastrec + ::nRecno := ::nRecno + nRecno + ::lEof := .F. + ::lBof := .F. + + else + if ::nRecno + nRecno > ::nLastRec + ::nRecno := ::nLastRec + 1 + ::lEof := .T. + end + + if ::nRecno + nRecno < 1 + ::nRecno := 1 + ::lBof := .T. + end + end +RETURN .T. + + +METHOD Goto( nRecno ) CLASS TPQquery + if nRecno > 0 .and. nRecno <= ::nLastrec + ::nRecno := nRecno + ::lEof := .F. + end +RETURN .T. + + +METHOD FieldPos( cField ) CLASS TPQquery + Local result := 0 + + if PQresultstatus(::pQuery) == PGRES_TUPLES_OK + result := AScan( ::aStruct, {|x| x[1] == trim(Lower(cField)) }) + end +RETURN result + + +METHOD FieldName( nField ) CLASS TPQquery + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if PQresultstatus(::pQuery) == PGRES_TUPLES_OK .and. nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 1] + endif +RETURN result + + +METHOD FieldType( nField ) CLASS TPQquery + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if PQresultstatus(::pQuery) == PGRES_TUPLES_OK .and. nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 2] + end +RETURN result + + +METHOD FieldLen( nField ) CLASS TPQquery + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if PQresultstatus(::pQuery) == PGRES_TUPLES_OK .and. nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 3] + end +RETURN result + + +METHOD FieldDec( nField ) CLASS TPQquery + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if PQresultstatus(::pQuery) == PGRES_TUPLES_OK .and. nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 4] + end +RETURN result + + +METHOD Delete(oRow) CLASS TPQquery + Local res + Local i + Local nField + Local xField + Local cQuery + Local cWhere := '' + Local aParams := {} + + ::SetKey() + + if ! Empty(::Tablename) .and. ! Empty(::aKeys) + For i := 1 to len(::aKeys) + nField := oRow:Fieldpos(::aKeys[i]) + xField := oRow:FieldGetOld(nField) + + cWhere += ::aKeys[i] + ' = $' + ltrim(str(i)) + + AADD( aParams, ValueToString(xField) ) + + if i <> len(::aKeys) + cWhere += ' and ' + endif + Next + + if ! (cWhere == '') + cQuery := 'DELETE FROM ' + ::Schema + '.' + ::Tablename + ' WHERE ' + cWhere + res := PQexecParams( ::pDB, cQuery, aParams) + + if PQresultstatus(res) != PGRES_COMMAND_OK + ::lError := .T. + ::cError := PQresultErrormessage(res) + ::rows := 0 + else + ::lError := .F. + ::cError := '' + ::rows := val(PQcmdTuples(res)) + endif + PQclear(res) + end + else + ::lError := .T. + ::cError := 'There is no primary keys or query is a joined table' + endif +RETURN ! ::lError + + +METHOD Append( oRow ) CLASS TPQquery + Local cQuery + Local i + Local res + Local lChanged := .f. + Local aParams := {} + Local nParams := 0 + + ::SetKey() + + if ! Empty(::Tablename) + cQuery := 'INSERT INTO ' + ::Schema + '.' + ::Tablename + '(' + For i := 1 to oRow:FCount() + if ::lallCols .or. oRow:changed(i) + lChanged := .t. + cQuery += oRow:Fieldname(i) + ',' + endif + Next + + cQuery := Left( cQuery, len(cQuery) - 1 ) + ') VALUES (' + + For i := 1 to oRow:FCount() + if ::lallCols .or. oRow:Changed(i) + nParams++ + cQuery += '$' + ltrim(str(nParams)) + ',' + aadd( aParams, ValueToString(oRow:FieldGet(i)) ) + endif + Next + + cQuery := Left( cQuery, len(cQuery) - 1 ) + ')' + + if lChanged + res := PQexecParams( ::pDB, cQuery, aParams) + + if PQresultstatus(res) != PGRES_COMMAND_OK + ::lError := .T. + ::cError := PQresultErrormessage(res) + ::rows := 0 + else + ::lError := .F. + ::cError := '' + ::rows := val(PQcmdTuples(res)) + endif + + PQclear(res) + endif + else + ::lError := .T. + ::cError := 'Cannot insert in a joined table, or unknown error' + endif +RETURN ! ::lError + + +METHOD Update(oRow) CLASS TPQquery + Local result := .F. + Local cQuery + Local i + Local nField + Local xField + Local cWhere + Local res + Local lChanged := .f. + Local aParams := {} + Local nParams := 0 + + ::SetKey() + + if ! Empty(::Tablename) .and. ! Empty(::aKeys) + cWhere := '' + For i := 1 to len(::aKeys) + + nField := oRow:Fieldpos(::aKeys[i]) + xField := oRow:FieldGetOld(nField) + + cWhere += ::aKeys[i] + '=' + DataToSql(xField) + + if i <> len(::aKeys) + cWhere += ' and ' + end + Next + + cQuery := 'UPDATE ' + ::Schema + '.' + ::Tablename + ' SET ' + For i := 1 to oRow:FCount() + if ::lallcols .or. oRow:Changed(i) + lChanged := .t. + nParams++ + cQuery += oRow:Fieldname(i) + ' = $' + ltrim(str(nParams)) + ',' + aadd( aParams, ValueToString(oRow:FieldGet(i)) ) + end + Next + + if ! (cWhere == '') .and. lChanged + + cQuery := Left( cQuery, len(cQuery) - 1 ) + ' WHERE ' + cWhere + + res := PQexecParams( ::pDB, cQuery, aParams) + + if PQresultstatus(res) != PGRES_COMMAND_OK + ::lError := .T. + ::cError := PQresultErrormessage(res) + ::rows := 0 + else + ::lError := .F. + ::cError := '' + ::rows := val(PQcmdTuples(res)) + endif + + PQclear(res) + end + else + ::lError := .T. + ::cError := 'Cannot insert in a joined table, or unknown error' + endif +RETURN ! ::lError + + +METHOD FieldGet( nField, nRow ) CLASS TPQquery + Local result + Local i + Local cType + Local nSize + Local tmp + Local cDateFmt + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= ::nFields .and. ! ::lclosed .and. PQresultstatus(::pQuery) == PGRES_TUPLES_OK + + if ISNIL(nRow) + nRow := ::nRecno + endif + + result := PQgetvalue( ::pQuery, nRow, nField) + cType := ::aStruct[ nField, 2 ] + nSize := ::aStruct[ nField, 3 ] + + if cType == "N" + if ! ISNIL(result) + result := val(result) + else + result := 0 + end + + elseif cType == "D" + if ! ISNIL(result) + tmp := 'yyyy-mm-dd' + tmp := strtran( tmp, 'dd', substr(result, 9, 2) ) + tmp := strtran( tmp, 'mm', substr(result, 6, 2) ) + tmp := strtran( tmp, 'yyyy', left(result, 4) ) + + cDateFmt := Set(_SET_DATEFORMAT, 'yyyy-mm-dd') + result := CtoD(tmp) + Set(_SET_DATEFORMAT, cDateFmt) + else + result := CtoD('') + end + + elseif cType == "L" + if ! ISNIL(result) + result := (result == 't') + else + result := .F. + end + + elseif cType == "C" + if Empty(nSize) + nSize := PQgetLength(::pQuery, nRow, nField) + endif + + if ISNIL(result) + result := Space(nSize) + else + result := PadR(result, nSize) + end + + elseif cType == "M" + if ISNIL(result) + result := "" + else + result := result + end + + end + end +RETURN result + + +METHOD Getrow( nRow ) CLASS TPQquery + Local result, aRow := {}, aOld := {}, nCol + + DEFAULT nRow TO ::nRecno + + if ! ::lclosed .and. PQresultstatus(::pQuery) == PGRES_TUPLES_OK + + if nRow > 0 .and. nRow <= ::nLastRec + + ASize(aRow, ::nFields) + ASize(aOld, ::nFields) + + For nCol := 1 to ::nFields + aRow[nCol] := ::Fieldget(nCol, nRow) + aOld[nCol] := ::Fieldget(nCol, nRow) + Next + + result := TPQRow():New( aRow, aOld, ::aStruct ) + + elseif nRow > ::nLastrec + result := ::GetBlankRow() + end + end +RETURN result + + +METHOD GetBlankRow() CLASS TPQquery + Local result, aRow := {}, aOld := {}, i + + ASize(aRow, ::nFields) + ASize(aOld, ::nFields) + + For i := 1 to ::nFields + if ::aStruct[i, 2] == 'C' + aRow[i] := '' + aOld[i] := '' + elseif ::aStruct[i, 2] == 'N' + aRow[i] := 0 + aOld[i] := 0 + elseif ::aStruct[i, 2] == 'L' + aRow[i] := .F. + aOld[i] := .F. + elseif ::aStruct[i, 2] == 'D' + aRow[i] := CtoD('') + aOld[i] := CtoD('') + elseif ::aStruct[i, 2] == 'M' + aRow[i] := '' + aOld[i] := '' + end + Next + + result := TPQRow():New( aRow, aOld, ::aStruct ) +RETURN result + + +METHOD SetKey() CLASS TPQquery + Local cQuery + Local i, x + Local nTableId, xTableId := -1 + Local nCount := 0 + Local cTable + Local res + Local nPos + + if PQresultstatus(::pQuery) == PGRES_TUPLES_OK + if ISNIL(::Tablename) + /* set the table name looking for table oid */ + for i := 1 to len(::aStruct) + /* Store table codes oid */ + nTableId := ::aStruct[i, 5] + + if nTableId != xTableId + xTableId := nTableId + nCount++ + endif + next + + if nCount == 1 + /* first, try get the table name from select, else get from pg_catalog */ + if (npos := at('FROM ', Upper(::cQuery))) != 0 + cQuery := lower(ltrim(substr( ::cQuery, nPos + 5 ))) + + if (npos := at('.', cQuery)) != 0 + ::Schema := alltrim(left(cQuery,npos-1)) + cQuery := substr(cQuery, nPos + 1) + endif + + if (npos := at(' ', cQuery)) != 0 + ::Tablename := trim(Left(cQuery, npos)) + else + ::Tablename := cQuery + endif + endif + + if empty(::Tablename) + cQuery := 'select relname from pg_class where oid = ' + str(xTableId) + + res := PQexec(::pDB, cQuery) + + if PQresultstatus(res) == PGRES_TUPLES_OK .and. PQlastrec(res) != 0 + ::Tablename := trim(PQgetvalue(res, 1, 1)) + endif + + PQclear(res) + endif + endif + endif + + if ISNIL(::aKeys) .and. ! empty(::Tablename) + /* Set the table primary keys */ + cQuery := "SELECT c.attname " + cQuery += " FROM pg_class a, pg_class b, pg_attribute c, pg_index d, pg_namespace e " + cQuery += " WHERE a.oid = d.indrelid " + cQuery += " AND a.relname = '" + ::Tablename + "'" + cQuery += " AND b.oid = d.indexrelid " + cQuery += " AND c.attrelid = b.oid " + cQuery += " AND d.indisprimary " + cQuery += " AND e.oid = a.relnamespace " + cQuery += " AND e.nspname = " + DataToSql(::Schema) + + res := PQexec(::pDB, cQuery) + + if PQresultstatus(res) == PGRES_TUPLES_OK .and. PQlastrec(res) != 0 + ::aKeys := {} + + For x := 1 To PQlastrec(res) + aadd( ::aKeys, PQgetvalue( res, x, 1 ) ) + Next + endif + + PQclear(res) + endif + endif + +RETURN nil + +CLASS TPQRow + DATA aRow + DATA aOld + DATA aStruct + + METHOD New( row, old, struct ) + + METHOD FCount() INLINE Len(::aRow) + METHOD FieldGet( nField ) + METHOD FieldPut( nField, Value ) + METHOD FieldName( nField ) + METHOD FieldPos( cFieldName ) + METHOD FieldLen( nField ) + METHOD FieldDec( nField ) + METHOD FieldType( nField ) + METHOD Changed( nField ) INLINE !(::aRow[nField] == ::aOld[nField]) + METHOD FieldGetOld( nField ) INLINE ::aOld[nField] +ENDCLASS + + +METHOD new( row, old, struct) CLASS TPQrow + ::aRow := row + ::aOld := old + ::aStruct := struct +RETURN self + + +METHOD FieldGet( nField ) CLASS TPQrow + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= len(::aRow) + result := ::aRow[nField] + end + +RETURN result + + +METHOD FieldPut( nField, Value ) CLASS TPQrow + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= len(::aRow) + result := ::aRow[nField] := Value + end +RETURN result + + +METHOD FieldName( nField ) CLASS TPQrow + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 1] + end + +RETURN result + + +METHOD FieldPos( cField ) CLASS TPQrow + Local result := 0 + + result := AScan( ::aStruct, {|x| x[1] == trim(lower(cField)) }) + +RETURN result + + +METHOD FieldType( nField ) CLASS TPQrow + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 2] + end + +RETURN result + + +METHOD FieldLen( nField ) CLASS TPQrow + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 3] + end +RETURN result + + +METHOD FieldDec( nField ) CLASS TPQrow + Local result + + if ISCHARACTER(nField) + nField := ::Fieldpos(nField) + endif + + if nField >= 1 .and. nField <= len(::aStruct) + result := ::aStruct[nField, 4] + end +RETURN result + + +Static Function DataToSql(xField) + Local cType, result := 'NULL' + + cType := ValType(xField) + + if cType == "C" .or. cType == "M" + result := "'"+ strtran(xField, "'", ' ') + "'" + elseif cType == "D" .and. ! Empty(xField) + result := "'" + StrZero(month(xField),2) + '/' + StrZero(day(xField),2) + '/' + StrZero(Year(xField),4) + "'" + elseif cType == "N" + result := str(xField) + elseif cType == "L" + result := iif( xField, "'t'", "'f'" ) + end +return result + +Static Function ValueToString(xField) + Local cType, result := nil + + cType := ValType(xField) + + if cType == "D" .and. ! Empty(xField) + result := StrZero(month(xField),2) + '/' + StrZero(day(xField),2) + '/' + StrZero(Year(xField),4) + elseif cType == "N" + result := str(xField) + elseif cType == "L" + result := iif( xField, "t", "f" ) + elseif cType == "C" .or. cType == "M" + result := xField + end +return result + + + diff --git a/harbour/contrib/pgsql/tstpgrdd.prg b/harbour/contrib/pgsql/tstpgrdd.prg new file mode 100644 index 0000000000..d22a37d46a --- /dev/null +++ b/harbour/contrib/pgsql/tstpgrdd.prg @@ -0,0 +1,90 @@ +/* The aim of this test is to check the same RDD functions and statements against a dbf file + and the same dbf imported into a PostgreSQL database. + Replace <...> with your data and configuration. +*/ + + +procedure main() + + local nConn + + set deleted on + + request DBFCDX + request PGRDD + + use index exclusive via "dbfcdx" + + set order to 1 + + test_code( "DBF" ) + + use + + nConn := dbpgconnection( ";;;;;" ) + + /* if you want to update and insert data you need at least a primary key */ + + use "select from
order by " alias
via "pgrdd" connection nConn + + test_code( "SQL" ) + + use + + dbpgclearconnection( nConn ) + + return + +function test_code( cMode ) + + local xTemp + +
->( dbgotop() ) + ?
->,
->,
-> +
->( dbgobottom() ) + ?
->,
->,
-> + /* goto 100 has different meaning */ +
->( dbgoto( 100 ) ) + ?
->,
->,
-> + xTemp :=
-> + replace
-> with "*** replaced ***" + ?
->,
->,
-> + replace
-> with xTemp + dbcommit() // the real write is made via dbcommit() so it is needed + ?
->,
->,
-> + ? eof() + dbgobottom() + dbskip() + ? eof() + ? bof() + dbgotop() + dbskip(-1) + ? bof() + + dbappend() + replace
-> with <"9"> + replace
-> with <"999999"> + replace
-> with <"APPENDED"> + dbcommit() + + // recno() has different meaning, in SQL it is the number of the row and change for every select */ + ?
->( recno() ),
->,
->,
-> + + wait + + cls + + BROWSE() + + dbgobottom() + replace
-> with "REPLACED" + dbcommit() + dbgobottom() + + BROWSE() + + delete for
-> = "9" + + return nil + + diff --git a/harbour/source/rtl/empty.c b/harbour/source/rtl/empty.c index d8e3e2e55a..cfe964ceff 100644 --- a/harbour/source/rtl/empty.c +++ b/harbour/source/rtl/empty.c @@ -63,6 +63,10 @@ HB_FUNC( EMPTY ) hb_retl( hb_arrayLen( pItem ) == 0 ); break; + case HB_IT_HASH: + hb_retl( hb_hashLen( pItem ) == 0 ); + break; + case HB_IT_STRING: case HB_IT_MEMO: hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) ); diff --git a/harbour/source/rtl/itemseri.c b/harbour/source/rtl/itemseri.c index 342b951644..86adfbdb13 100644 --- a/harbour/source/rtl/itemseri.c +++ b/harbour/source/rtl/itemseri.c @@ -79,6 +79,7 @@ UCHAR [ 1 ] - item type 18. HASH16 2+n 19. HASH32 4+n 20. CYCLIC REFERENCE 4 + 21. SYMBOL 1+n */ #define HB_SERIAL_NIL 0 @@ -102,6 +103,7 @@ UCHAR [ 1 ] - item type #define HB_SERIAL_HASH16 18 #define HB_SERIAL_HASH32 19 #define HB_SERIAL_REF 20 +#define HB_SERIAL_SYMBOL 21 #include "hbapi.h" #include "hbapiitm.h" @@ -150,6 +152,10 @@ static ULONG hb_itemSerialSize( PHB_ITEM pItem ) ulSize = 9; break; + case HB_IT_SYMBOL: + ulSize = 2 + strlen( hb_itemGetSymbol( pItem )->szName ); + break; + case HB_IT_STRING: case HB_IT_MEMO: ulLen = hb_itemGetCLen( pItem ); @@ -202,6 +208,7 @@ static UCHAR * hb_serializeItem( PHB_ITEM pItem, UCHAR * pBuffer ) ULONG ulLen, u; LONG l; double d; + char * szVal; switch( hb_itemType( pItem ) ) { @@ -272,6 +279,17 @@ static UCHAR * hb_serializeItem( PHB_ITEM pItem, UCHAR * pBuffer ) } break; + case HB_IT_SYMBOL: + szVal = hb_itemGetSymbol( pItem )->szName; + ulLen = strlen( szVal ); + if( ulLen > 0xFF ) + ulLen = 0xFF; + *pBuffer++ = HB_SERIAL_SYMBOL; + *pBuffer++ = ( UCHAR ) ulLen; + memcpy( pBuffer, szVal, ulLen ); + pBuffer += ulLen; + break; + case HB_IT_STRING: case HB_IT_MEMO: ulLen = hb_itemGetCLen( pItem ); @@ -391,6 +409,7 @@ static UCHAR * hb_deserializeArray( PHB_ITEM pItem, UCHAR * pBuffer, ULONG ulLen static UCHAR * hb_deserializeItem( PHB_ITEM pItem, UCHAR * pBuffer ) { ULONG ulLen; + char * szVal; switch( *pBuffer++ ) { @@ -444,6 +463,14 @@ static UCHAR * hb_deserializeItem( PHB_ITEM pItem, UCHAR * pBuffer ) pBuffer += 3; break; + case HB_SERIAL_SYMBOL: + ulLen = *pBuffer++; + szVal = hb_strndup( ( char * ) pBuffer, ulLen ); + hb_itemPutSymbol( pItem, hb_dynsymGetSymbol( szVal ) ); + hb_xfree( szVal ); + pBuffer += ulLen; + break; + case HB_SERIAL_STRING8: ulLen = *pBuffer++; hb_itemPutCL( pItem, ( char * ) pBuffer, ulLen ); @@ -530,6 +557,7 @@ static BOOL hb_deserializeTest( UCHAR ** pBufferPtr, ULONG * pulSize ) case HB_SERIAL_DOUBLE: ulSize = 9; break; + case HB_SERIAL_SYMBOL: case HB_SERIAL_STRING8: ulSize = 1 + ( ulSize >= 2 ? *pBuffer : ulSize ); break;