/* * $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 cType, 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 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 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