From 6855fe72577e613dbd7e27d2dce0468633d0477e Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 3 Feb 2010 11:48:17 +0000 Subject: [PATCH] 2010-02-03 12:47 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbpgsql/tpostgre.prg + Formatted. ! Indented. % Optimized to use SWITCH/CASE. % Optimized to avoid ASize() and AAdd() in a few places. + Using constants for structure array positions. * contrib/hbpgsql/tpostgre.prg * contrib/hbpgsql/postgres.ch * contrib/hbpgsql/postgres.c + Added and using HBPG_META_* constants. --- harbour/ChangeLog | 13 + harbour/contrib/hbpgsql/postgres.c | 23 +- harbour/contrib/hbpgsql/postgres.ch | 14 + harbour/contrib/hbpgsql/tpostgre.prg | 1849 +++++++++++++------------- 4 files changed, 965 insertions(+), 934 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 798ab1292b..9138adf5be 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,19 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-02-03 12:47 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbpgsql/tpostgre.prg + + Formatted. + ! Indented. + % Optimized to use SWITCH/CASE. + % Optimized to avoid ASize() and AAdd() in a few places. + + Using constants for structure array positions. + + * contrib/hbpgsql/tpostgre.prg + * contrib/hbpgsql/postgres.ch + * contrib/hbpgsql/postgres.c + + Added and using HBPG_META_* constants. + 2010-02-03 11:40 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbpgsql/pgrdd.prg ! Fixed to not call ALERT(). diff --git a/harbour/contrib/hbpgsql/postgres.c b/harbour/contrib/hbpgsql/postgres.c index 0ce9c5583c..f92bc167b0 100644 --- a/harbour/contrib/hbpgsql/postgres.c +++ b/harbour/contrib/hbpgsql/postgres.c @@ -583,6 +583,15 @@ HB_FUNC( PQGETLENGTH ) hb_errRT_BASE( EG_ARG, 2020, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); } +/* PQMETADATA() positions for array returned */ +#define HBPG_META_FIELDNAME 1 +#define HBPG_META_FIELDTYPE 2 +#define HBPG_META_FIELDLEN 3 +#define HBPG_META_FIELDDEC 4 +#define HBPG_META_TABLE 5 +#define HBPG_META_TABLECOL 6 +#define HBPG_META_LEN_ 6 + HB_FUNC( PQMETADATA ) { PGresult * res = hb_PGresult_par( 1 ); @@ -692,13 +701,13 @@ HB_FUNC( PQMETADATA ) } pField = hb_arrayGetItemPtr( pResult, i + 1 ); - hb_arrayNew( pField, 6 ); - hb_arraySetC( pField, 1, PQfname( res, i ) ); - hb_arraySetC( pField, 2, buf ); - hb_arraySetNI( pField, 3, length ); - hb_arraySetNI( pField, 4, decimal ); - hb_arraySetNL( pField, 5, PQftable( res, i ) ); - hb_arraySetNI( pField, 6, PQftablecol( res, i ) ); + hb_arrayNew( pField, HBPG_META_LEN_ ); + hb_arraySetC( pField, HBPG_META_FIELDNAME, PQfname( res, i ) ); + hb_arraySetC( pField, HBPG_META_FIELDTYPE, buf ); + hb_arraySetNI( pField, HBPG_META_FIELDLEN , length ); + hb_arraySetNI( pField, HBPG_META_FIELDDEC , decimal ); + hb_arraySetNL( pField, HBPG_META_TABLE , PQftable( res, i ) ); + hb_arraySetNI( pField, HBPG_META_TABLECOL , PQftablecol( res, i ) ); } hb_itemReturnRelease( pResult ); diff --git a/harbour/contrib/hbpgsql/postgres.ch b/harbour/contrib/hbpgsql/postgres.ch index f75be4c68b..ecaada8d33 100644 --- a/harbour/contrib/hbpgsql/postgres.ch +++ b/harbour/contrib/hbpgsql/postgres.ch @@ -52,6 +52,9 @@ * */ +#ifndef HBPOSTGRES_CH_ +#define HBPOSTGRES_CH_ + #define CONNECTION_OK 0 #define CONNECTION_BAD 1 #define CONNECTION_STARTED 2 @@ -76,3 +79,14 @@ #define PQTRANS_INTRANS 2 #define PQTRANS_INERROR 3 #define PQTRANS_UNKNOWN 4 + +/* PQMETADATA() positions for array returned */ +#define HBPG_META_FIELDNAME 1 +#define HBPG_META_FIELDTYPE 2 +#define HBPG_META_FIELDLEN 3 +#define HBPG_META_FIELDDEC 4 +#define HBPG_META_TABLE 5 +#define HBPG_META_TABLECOL 6 +#define HBPG_META_LEN_ 6 + +#endif diff --git a/harbour/contrib/hbpgsql/tpostgre.prg b/harbour/contrib/hbpgsql/tpostgre.prg index 2ca73b4bbc..4e27854ff0 100644 --- a/harbour/contrib/hbpgsql/tpostgre.prg +++ b/harbour/contrib/hbpgsql/tpostgre.prg @@ -56,1118 +56,1119 @@ #include "hbclass.ch" #include "postgres.ch" +#define _STRU_FIELDNAME 1 +#define _STRU_FIELDTYPE 2 +#define _STRU_FIELDLEN 3 +#define _STRU_FIELDDEC 4 +#define _STRU_TABLE 5 +#define _STRU_TABLECOL 6 + CREATE CLASS TPQServer - VAR pDb - VAR lTrans - VAR lallCols INIT .T. - VAR Schema INIT "public" - VAR lError INIT .F. - VAR cError INIT "" - VAR lTrace INIT .F. - VAR pTrace + VAR pDb + VAR lTrans + VAR lallCols INIT .T. + VAR Schema INIT "public" + VAR lError INIT .F. + VAR cError INIT "" + VAR lTrace INIT .F. + VAR pTrace - METHOD New( cHost, cDatabase, cUser, cPass, nPort, Schema ) - METHOD Destroy() - METHOD Close() INLINE ::Destroy() + 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 StartTransaction() + METHOD TransactionStatus() INLINE PQtransactionstatus( ::pDb ) + METHOD Commit() + METHOD Rollback() - METHOD Query( cQuery ) - METHOD Execute( cQuery ) INLINE ::Query(cQuery) - METHOD SetSchema( cSchema ) + METHOD Query( cQuery ) + METHOD Execute( cQuery ) INLINE ::Query( cQuery ) + METHOD SetSchema( cSchema ) - METHOD NetErr() INLINE ::lError - METHOD ErrorMsg() INLINE ::cError + 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 ) ) + 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 + LOCAL res - ::pDB := PQconnect(cDatabase, cHost, cUser, cPass, nPort) + DEFAULT nPort TO 5432 - if PQstatus(::pDb) != CONNECTION_OK - ::lError := .T. - ::cError := PQerrormessage(::pDb) + ::pDB := PQconnect( cDatabase, cHost, cUser, cPass, nPort ) - 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 - res := NIL - endif - endif - -RETURN self + 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 + res := NIL + ENDIF + ENDIF + RETURN self METHOD Destroy() CLASS TPQserver - ::TraceOff() - ::pDb := NIL -RETURN nil - + ::TraceOff() + ::pDb := NIL + RETURN NIL METHOD SetSchema( cSchema ) CLASS TPQserver - Local res - Local result := .F. + 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) - res := NIL - endif -RETURN result + IF PQstatus( ::pDb ) == CONNECTION_OK + ::Schema := cSchema + res := PQexec( ::pDB, "SET search_path TO " + cSchema ) + result := ( PQresultStatus( res ) == PGRES_COMMAND_OK ) + res := NIL + ENDIF + RETURN result METHOD StartTransaction() CLASS TPQserver - Local res, lError + LOCAL res + LOCAL lError - res := PQexec( ::pDB, "BEGIN" ) - lError := PQresultstatus(res) != PGRES_COMMAND_OK + res := PQexec( ::pDB, "BEGIN" ) + lError := PQresultstatus( res ) != PGRES_COMMAND_OK - if lError - ::lError := .T. - ::cError := PQresultErrormessage(res) - else - ::lError := .F. - ::cError := "" - endif - res := NIL -RETURN lError + IF lError + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ELSE + ::lError := .F. + ::cError := "" + ENDIF + RETURN lError METHOD Commit() CLASS TPQserver - Local res, lError + LOCAL res + LOCAL lError - res := PQexec( ::pDB, "COMMIT" ) - lError := PQresultstatus(res) != PGRES_COMMAND_OK + res := PQexec( ::pDB, "COMMIT" ) + lError := PQresultstatus( res ) != PGRES_COMMAND_OK - if lError - ::lError := .T. - ::cError := PQresultErrormessage(res) - else - ::lError := .F. - ::cError := "" - endif - res := NIL -RETURN lError + IF lError + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ELSE + ::lError := .F. + ::cError := "" + ENDIF + RETURN lError METHOD Rollback() CLASS TPQserver - Local res, lError + LOCAL res + LOCAL lError - res := PQexec( ::pDB, "ROLLBACK" ) - lError := PQresultstatus(res) != PGRES_COMMAND_OK + res := PQexec( ::pDB, "ROLLBACK" ) + lError := PQresultstatus( res ) != PGRES_COMMAND_OK - if lError - ::lError := .T. - ::cError := PQresultErrormessage(res) - else - ::lError := .F. - ::cError := "" - endif - res := NIL -RETURN lError + IF lError + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ELSE + ::lError := .F. + ::cError := "" + ENDIF + RETURN lError METHOD Query( cQuery ) CLASS TPQserver - Local oQuery - - oQuery := TPQquery():New(::pDB, cQuery, ::lallCols, ::Schema) -RETURN oQuery - + RETURN TPQquery():New( ::pDB, cQuery, ::lallCols, ::Schema ) METHOD TableExists( cTable ) CLASS TPQserver - Local result := .F. - Local cQuery - Local res + 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)) + 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 ) + res := PQexec( ::pDB, cQuery ) - if PQresultstatus(res) == PGRES_TUPLES_OK - result := (PQlastrec(res) != 0) - ::lError := .F. - ::cError := "" - else - ::lError := .T. - ::cError := PQresultErrormessage(res) - endif - - res := NIL -RETURN result + IF PQresultstatus( res ) == PGRES_TUPLES_OK + result := ( PQlastrec( res ) != 0 ) + ::lError := .F. + ::cError := "" + ELSE + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ENDIF + RETURN result METHOD ListTables() CLASS TPQserver - Local result := {} - Local cQuery - Local res - Local i + 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' " + cQuery := "SELECT table_name " + cQuery += " FROM information_schema.tables " + cQuery += " WHERE table_schema = " + DataToSql( ::Schema ) + " AND table_type = 'BASE TABLE' " - res := PQexec( ::pDB, cQuery ) + 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 + 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 - res := NIL -RETURN result + RETURN result METHOD TableStruct( cTable ) CLASS TPQserver - Local result := {} - Local cQuery - Local res - Local i - Local cField - Local cType - Local nSize - Local nDec + 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 " + 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 ) + 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 PQresultstatus( res ) == PGRES_TUPLES_OK - if "char" $ cType - cType := "C" - nSize := Val(PQgetvalue(res, i, 3)) - nDec := 0 + FOR i := 1 TO PQlastrec( res ) - elseif "text" $ cType - cType := "M" - nSize := 10 - nDec := 0 + cField := PQgetvalue( res, i, 1 ) + cType := PQgetvalue( res, i, 2 ) + nSize := PQgetvalue( res, i, 4 ) + nDec := PQgetvalue( res, i, 5 ) - elseif "boolean" $ cType - cType := "L" - nSize := 1 - nDec := 0 + IF "char" $ cType + cType := "C" + nSize := Val( PQgetvalue( res, i, 3 ) ) + nDec := 0 - elseif "smallint" $ cType - cType := "N" - nSize := 5 - nDec := 0 + ELSEIF "text" $ cType + cType := "M" + nSize := 10 + nDec := 0 - elseif "integer" $ cType .or. "serial" $ cType - cType := "N" - nSize := 9 - nDec := 0 + ELSEIF "boolean" $ cType + cType := "L" + nSize := 1 + nDec := 0 - elseif "bigint" $ cType .or. "bigserial" $ cType - cType := "N" - nSize := 19 - nDec := 0 + ELSEIF "smallint" $ cType + cType := "N" + nSize := 5 + 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( nDec > 0, 1, 0 ) + ELSEIF "integer" $ cType .OR. "serial" $ cType + cType := "N" + nSize := 9 + nDec := 0 - // Numeric/Decimal without scale/precision can genarete big values, so, i limit this to 10,5 + ELSEIF "bigint" $ cType .OR. "bigserial" $ cType + cType := "N" + nSize := 19 + nDec := 0 - if nDec > 100 - nDec := 5 - endif + ELSEIF "decimal" $ cType .OR. "numeric" $ cType + cType := "N" + nDec := Val( nDec ) + /* Postgres doesn't store ".", but .dbf does, it can cause data width problem */ + nSize := Val( nSize ) + iif( nDec > 0, 1, 0 ) - if nSize > 100 - nSize := 15 - endif + /* Numeric/Decimal without scale/precision can genarete big values, so, i limit this to 10,5 */ - elseif "real" $ cType .or. "float4" $ cType - cType := "N" - nSize := 15 - nDec := 4 + IF nDec > 100 + nDec := 5 + ENDIF - elseif "double precision" $ cType .or. "float8" $ cType - cType := "N" - nSize := 19 - nDec := 9 + IF nSize > 100 + nSize := 15 + ENDIF - elseif "money" $ cType - cType := "N" - nSize := 9 - nDec := 2 + ELSEIF "real" $ cType .OR. "float4" $ cType + cType := "N" + nSize := 15 + nDec := 4 - elseif "timestamp" $ cType - cType := "C" - nSize := 20 - nDec := 0 + ELSEIF "double precision" $ cType .OR. "float8" $ cType + cType := "N" + nSize := 19 + nDec := 9 - elseif "date" $ cType - cType := "D" - nSize := 8 - nDec := 0 + ELSEIF "money" $ cType + cType := "N" + nSize := 9 + nDec := 2 - elseif "time" $ cType - cType := "C" - nSize := 10 - nDec := 0 + ELSEIF "timestamp" $ cType + cType := "C" + nSize := 20 + nDec := 0 - else - // Unsuported - cType := "U" - nSize := 0 - nDec := -1 + ELSEIF "date" $ cType + cType := "D" + nSize := 8 + nDec := 0 - endif + ELSEIF "time" $ cType + cType := "C" + nSize := 10 + nDec := 0 - if !( cType == "U" ) - aadd( result, { cField, cType, nSize, nDec } ) - endif + ELSE + /* Unsuported */ + cType := "U" + nSize := 0 + nDec := -1 - Next - ::lError := .F. - ::cError := "" - else - ::lError := .T. - ::cError := PQresultErrormessage(res) - endif + ENDIF - res := NIL -RETURN result + IF !( cType == "U" ) + AAdd( result, { cField, cType, nSize, nDec } ) + ENDIF + NEXT + + ::lError := .F. + ::cError := "" + ELSE + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ENDIF + + RETURN result METHOD CreateTable( cTable, aStruct ) CLASS TPQserver - Local result := .T. - Local cQuery - Local res - Local i + LOCAL result := .T. + LOCAL cQuery + LOCAL res + LOCAL i - cQuery := "CREATE TABLE " + ::Schema + "." + cTable + "( " + cQuery := "CREATE TABLE " + ::Schema + "." + cTable + "( " - For i := 1 to Len(aStruct) + FOR i := 1 TO Len( aStruct ) - cQuery += aStruct[i, 1] + cQuery += aStruct[ i ][ _STRU_FIELDNAME ] - if aStruct[ i, 2 ] == "C" - cQuery += " Char(" + hb_NToS(aStruct[i, 3]) + ")" + SWITCH aStruct[ i ][ _STRU_FIELDTYPE ] + CASE "C" + cQuery += " Char(" + hb_ntos( aStruct[ i ][ _STRU_FIELDLEN ] ) + ")" + EXIT + CASE "D" + cQuery += " Date " + EXIT + CASE "N" + cQuery += " Numeric(" + hb_ntos( aStruct[ i ][ _STRU_FIELDLEN ] ) + "," + hb_ntos( aStruct[ i ][ _STRU_FIELDDEC ] ) + ")" + EXIT + CASE "L" + cQuery += " boolean " + EXIT + CASE "M" + cQuery += " text " + EXIT + ENDSWITCH - elseif aStruct[ i, 2 ] == "D" - cQuery += " Date " + IF i == Len( aStruct ) + cQuery += ")" + ELSE + cQuery += "," + ENDIF + NEXT - elseif aStruct[ i, 2 ] == "N" - cQuery += " Numeric(" + hb_NToS(aStruct[i, 3]) + "," + hb_NToS(aStruct[i,4]) + ")" + res := PQexec( ::pDB, cQuery ) - elseif aStruct[ i, 2 ] == "L" - cQuery += " boolean " - - elseif aStruct[ i, 2 ] == "M" - cQuery += " text " - endif - - if i == Len(aStruct) - cQuery += ")" - else - cQuery += "," - endif - Next - - res := PQexec( ::pDB, cQuery ) - - if PQresultstatus(res) != PGRES_COMMAND_OK - result := .F. - ::lError := .T. - ::cError := PQresultErrormessage(res) - else - ::lError := .F. - ::cError := "" - endif - - res := NIL -RETURN result + IF PQresultstatus( res ) != PGRES_COMMAND_OK + result := .F. + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ELSE + ::lError := .F. + ::cError := "" + ENDIF + RETURN result METHOD DeleteTable( cTable ) CLASS TPQserver - Local result := .T. - Local res + LOCAL result := .T. + LOCAL res - res := PQexec( ::pDB, "DROP TABLE " + ::Schema + "." + cTable ) + res := PQexec( ::pDB, "DROP TABLE " + ::Schema + "." + cTable ) - if PQresultstatus(res) != PGRES_COMMAND_OK - result := .F. - ::lError := .T. - ::cError := PQresultErrormessage(res) - else - ::lError := .F. - ::cError := "" - endif - - res := NIL -RETURN result + IF PQresultstatus( res ) != PGRES_COMMAND_OK + result := .F. + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ELSE + ::lError := .F. + ::cError := "" + ENDIF + RETURN result METHOD TraceOn( cFile ) CLASS TPQserver - ::pTrace := PQcreatetrace( cFile ) - - if ::pTrace != NIL - PQtrace( ::pDb, ::pTrace ) - ::lTrace := .t. - endif -RETURN nil + ::pTrace := PQcreatetrace( cFile ) + IF ::pTrace != NIL + PQtrace( ::pDb, ::pTrace ) + ::lTrace := .T. + ENDIF + RETURN NIL METHOD TraceOff() CLASS TPQserver - if ::pTrace != NIL - PQuntrace( ::pDb ) - ::pTrace := NIL - endif - - ::lTrace := .f. -RETURN nil + IF ::pTrace != NIL + PQuntrace( ::pDb ) + ::pTrace := NIL + ENDIF + ::lTrace := .F. + RETURN NIL CREATE CLASS TPQQuery - VAR pQuery - VAR pDB + VAR pQuery + VAR pDB - VAR nResultStatus + VAR nResultStatus - VAR lBof - VAR lEof - VAR lRead - VAR lAllCols INIT .T. + VAR lBof + VAR lEof + VAR lRead + VAR lAllCols INIT .T. - VAR lError INIT .F. - VAR cError INIT "" + VAR lError INIT .F. + VAR cError INIT "" - VAR cQuery - VAR nRecno - VAR nFields - VAR nLastrec + VAR cQuery + VAR nRecno + VAR nFields + VAR nLastrec - VAR aStruct - VAR aKeys - VAR TableName - VAR Schema - VAR rows INIT 0 + VAR aStruct + VAR aKeys + VAR TableName + VAR Schema + VAR rows INIT 0 - METHOD New( pDB, cQuery, lallCols, cSchema, res ) - METHOD Destroy() - METHOD Close() INLINE ::Destroy() + METHOD New( pDB, cQuery, lallCols, cSchema, res ) + METHOD Destroy() + METHOD Close() INLINE ::Destroy() - METHOD Refresh( lQuery, lMeta ) - METHOD Fetch() INLINE ::Skip() - METHOD Read() - METHOD Skip( nRecno ) + METHOD Refresh( lQuery, lMeta ) + METHOD Fetch() INLINE ::Skip() + METHOD Read() + METHOD Skip( nRecno ) - METHOD Bof() INLINE ::lBof - METHOD Eof() INLINE ::lEof - METHOD RecNo() INLINE ::nRecno - METHOD Lastrec() INLINE ::nLastrec - METHOD Goto(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 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 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 Changed( nField ) INLINE ::aRow[ nField ] != ::aOld[ nField ] + METHOD Blank() INLINE ::GetBlankRow() - METHOD Struct() + METHOD Struct() - METHOD FieldGet( nField, nRow ) - METHOD GetRow( nRow ) - METHOD GetBlankRow() + METHOD FieldGet( nField, nRow ) + METHOD GetRow( nRow ) + METHOD GetBlankRow() - //DESTRUCTOR Destroy ENDCLASS METHOD New( pDB, cQuery, lallCols, cSchema, res ) CLASS TPQquery - ::pDB := pDB - ::nResultStatus := -1 - ::cQuery := cQuery - ::lallCols := lallCols - ::Schema := cSchema - if res != NIL - ::pQuery := res - endif + ::pDB := pDB + ::nResultStatus := -1 + ::cQuery := cQuery + ::lallCols := lallCols + ::Schema := cSchema - ::Refresh( res == NIL ) -RETURN self + IF res != NIL + ::pQuery := res + ENDIF + ::Refresh( res == NIL ) + + RETURN self METHOD Destroy() CLASS TPQquery - if ::nResultStatus != -1 - ::pQuery := NIL - ::nResultStatus := -1 - endif -RETURN .T. + IF ::nResultStatus != -1 + ::pQuery := NIL + ::nResultStatus := -1 + ENDIF -METHOD Refresh(lQuery,lMeta) CLASS TPQquery - Local res - Local aStruct := {} - Local aTemp - Local i - Local cType, nDec, nSize + RETURN .T. - Default lQuery To .T. - Default lMeta To .T. +METHOD Refresh( lQuery, lMeta ) CLASS TPQquery + LOCAL res + LOCAL aStruct := {} + LOCAL aTemp + LOCAL i + LOCAL cType, nDec, nSize - ::Destroy() + DEFAULT lQuery TO .T. + DEFAULT lMeta TO .T. - ::lBof := .T. - ::lEof := .T. - ::lRead := .F. - ::nRecno := 0 - ::nLastrec := 0 - ::Rows := 0 + ::Destroy() - if lQuery - res := PQexec( ::pDB, ::cQuery ) - else - res := ::pQuery - endif + ::lBof := .T. + ::lEof := .T. + ::lRead := .F. + ::nRecno := 0 + ::nLastrec := 0 + ::Rows := 0 - ::nResultStatus := PQresultstatus(res) + IF lQuery + res := PQexec( ::pDB, ::cQuery ) + ELSE + res := ::pQuery + ENDIF - if ::nResultStatus == PGRES_TUPLES_OK + ::nResultStatus := PQresultstatus( res ) - 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 ::nResultStatus == PGRES_TUPLES_OK - if "char" $ cType - cType := "C" + IF lMeta - elseif "numeric" $ cType .or. "decimal" $ cType - cType := "N" + ::aStruct := {} + ::nFields := 0 - // Postgres don't store ".", but .dbf does, it can cause data width problem - if nDec > 0 - nSize++ - // Numeric/Decimal without scale/precision can genarete big values, so, i limit this to 10,5 - if nDec > 100 - nDec := 5 - endif - endif + /* Get some information about metadata */ + aTemp := PQmetadata( res ) - if nSize > 100 - nSize := 15 - endif + IF ISARRAY( aTemp ) - elseif "date" $ cType - cType := "D" - nSize := 8 + FOR i := 1 TO Len( aTemp ) - elseif "text" $ cType - cType := "M" + cType := aTemp[ i ][ HBPG_META_FIELDTYPE ] + nSize := aTemp[ i ][ HBPG_META_FIELDLEN ] + nDec := aTemp[ i ][ HBPG_META_FIELDDEC ] - elseif "boolean" $ cType - cType := "L" - nSize := 1 + IF "char" $ cType + cType := "C" - elseif "smallint" $ cType - cType := "N" - nSize := 5 + ELSEIF "numeric" $ cType .OR. "decimal" $ cType + cType := "N" - elseif "integer" $ cType .or. "serial" $ cType - cType := "N" - nSize := 9 + /* Postgres don't store ".", but .dbf does, it can cause data width problem */ + IF nDec > 0 + nSize++ + /* Numeric/Decimal without scale/precision can genarete big values, so, i limit this to 10,5 */ + IF nDec > 100 + nDec := 5 + ENDIF + ENDIF - elseif "bigint" $ cType .or. "bigserial" $ cType - cType := "N" - nSize := 19 + IF nSize > 100 + nSize := 15 + ENDIF - elseif "real" $ cType .or. "float4" $ cType - cType := "N" - nSize := 15 - nDec := 4 + ELSEIF "date" $ cType + cType := "D" + nSize := 8 - elseif "double precision" $ cType .or. "float8" $ cType - cType := "N" - nSize := 19 - nDec := 9 + ELSEIF "text" $ cType + cType := "M" - elseif "money" $ cType - cType := "N" - nSize := 10 - nDec := 2 + ELSEIF "boolean" $ cType + cType := "L" + nSize := 1 - elseif "timestamp" $ cType - cType := "C" - nSize := 20 + ELSEIF "smallint" $ cType + cType := "N" + nSize := 5 - elseif "time" $ cType - cType := "C" - nSize := 10 + ELSEIF "integer" $ cType .OR. "serial" $ cType + cType := "N" + nSize := 9 - else - // Unsuported - cType := "K" - endif + ELSEIF "bigint" $ cType .OR. "bigserial" $ cType + cType := "N" + nSize := 19 - aadd( aStruct, {aTemp[ i, 1 ], cType, nSize, nDec, aTemp[i, 5], aTemp[i, 6]} ) - Next + ELSEIF "real" $ cType .OR. "float4" $ cType + cType := "N" + nSize := 15 + nDec := 4 - ::nFields := PQfcount(res) + ELSEIF "double precision" $ cType .OR. "float8" $ cType + cType := "N" + nSize := 19 + nDec := 9 - ::aStruct := aStruct + ELSEIF "money" $ cType + cType := "N" + nSize := 10 + nDec := 2 - endif - endif + ELSEIF "timestamp" $ cType + cType := "C" + nSize := 20 - ::nLastrec := PQlastrec(res) - ::lError := .F. - ::cError := "" + ELSEIF "time" $ cType + cType := "C" + nSize := 10 - if ::nLastrec != 0 - ::nRecno := 1 - ::lBof := .F. - ::lEof := .F. - endif + ELSE + /* Unsuported */ + cType := "K" + ENDIF - elseif ::nResultStatus == PGRES_COMMAND_OK - ::lError := .F. - ::cError := "" - ::rows := val(PQcmdTuples(res)) + AAdd( aStruct, { aTemp[ i ][ HBPG_META_FIELDNAME ],; + cType,; + nSize,; + nDec,; + aTemp[ i ][ HBPG_META_TABLE ],; + aTemp[ i ][ HBPG_META_TABLECOL ] } ) + NEXT - else - ::lError := .T. - ::cError := PQresultErrormessage(res) - endif + ::nFields := PQfcount( res ) - ::pQuery := res + ::aStruct := aStruct -RETURN ! ::lError + ENDIF + ENDIF + ::nLastrec := PQlastrec( res ) + ::lError := .F. + ::cError := "" + + IF ::nLastrec != 0 + ::nRecno := 1 + ::lBof := .F. + ::lEof := .F. + ENDIF + + ELSEIF ::nResultStatus == 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 + LOCAL result := Array( Len( ::aStruct ) ) + 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 + FOR i := 1 TO Len( ::aStruct ) + result[ i ] := { ::aStruct[ i ][ _STRU_FIELDNAME ], ::aStruct[ i ][ _STRU_FIELDTYPE ], ::aStruct[ i ][ _STRU_FIELDLEN ], ::aStruct[ i ][ _STRU_FIELDDEC ] } + NEXT + + RETURN result METHOD Read() CLASS TPQquery - if !::lEof - if !::lRead - ::lRead := .T. - else - ::Skip( 1 ) - endif - endif + IF ! ::lEof + IF ! ::lRead + ::lRead := .T. + ELSE + ::Skip( 1 ) + ENDIF + ENDIF -RETURN !::lEof + RETURN ! ::lEof METHOD Skip( nrecno ) CLASS TPQquery - DEFAULT nRecno TO 1 - if ::nRecno + nRecno > 0 .and. ::nRecno + nRecno <= ::nLastrec - ::nRecno := ::nRecno + nRecno - ::lEof := .F. - ::lBof := .F. + DEFAULT nRecno TO 1 - else - if ::nRecno + nRecno > ::nLastRec - ::nRecno := ::nLastRec + 1 - ::lEof := .T. - endif + 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. + ENDIF - if ::nRecno + nRecno < 1 - ::nRecno := 1 - ::lBof := .T. - endif - endif -RETURN .T. + IF ::nRecno + nRecno < 1 + ::nRecno := 1 + ::lBof := .T. + ENDIF + ENDIF + RETURN .T. METHOD Goto( nRecno ) CLASS TPQquery - if nRecno > 0 .and. nRecno <= ::nLastrec - ::nRecno := nRecno - ::lEof := .F. - endif -RETURN .T. + IF nRecno > 0 .AND. nRecno <= ::nLastrec + ::nRecno := nRecno + ::lEof := .F. + ENDIF + + RETURN .T. METHOD FieldPos( cField ) CLASS TPQquery - cField := trim(Lower(cField)) + cField := RTrim( Lower( cField ) ) -RETURN AScan( ::aStruct, {|x| x[1] == cField }) + RETURN AScan( ::aStruct, {| x | x[ _STRU_FIELDNAME ] == cField } ) METHOD FieldName( nField ) CLASS TPQquery - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - elseif nField < 1 .or. nField > len(::aStruct) - nField := 0 - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ELSEIF nField < 1 .OR. nField > Len( ::aStruct ) + nField := 0 + ENDIF - if nField > 0 - result := ::aStruct[nField, 1] - endif -RETURN result + IF nField > 0 + result := ::aStruct[ nField ][ _STRU_FIELDNAME ] + ENDIF + RETURN result METHOD FieldType( nField ) CLASS TPQquery - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - elseif nField < 1 .or. nField > len(::aStruct) - nField := 0 - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ELSEIF nField < 1 .OR. nField > Len( ::aStruct ) + nField := 0 + ENDIF - if nField > 0 - result := ::aStruct[nField, 2] - endif -RETURN result + IF nField > 0 + result := ::aStruct[ nField ][ _STRU_FIELDTYPE ] + ENDIF + RETURN result METHOD FieldLen( nField ) CLASS TPQquery - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - elseif nField < 1 .or. nField > len(::aStruct) - nField := 0 - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ELSEIF nField < 1 .OR. nField > Len( ::aStruct ) + nField := 0 + ENDIF - if nField > 0 - result := ::aStruct[nField, 3] - endif -RETURN result + IF nField > 0 + result := ::aStruct[ nField ][ _STRU_FIELDLEN ] + ENDIF + RETURN result METHOD FieldDec( nField ) CLASS TPQquery - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - elseif nField < 1 .or. nField > len(::aStruct) - nField := 0 - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ELSEIF nField < 1 .OR. nField > Len( ::aStruct ) + nField := 0 + ENDIF - if nField > 0 - result := ::aStruct[nField, 4] - endif -RETURN result + IF nField > 0 + result := ::aStruct[ nField ][ _STRU_FIELDDEC ] + ENDIF + RETURN result -METHOD Delete(oRow) CLASS TPQquery - Local res - Local i - Local nField - Local xField - Local cQuery - Local cWhere := "" - Local aParams := {} +METHOD Delete( oRow ) CLASS TPQquery + LOCAL res + LOCAL i + LOCAL nField + LOCAL xField + LOCAL cQuery + LOCAL cWhere := "" + LOCAL aParams := {} - ::SetKey() + ::SetKey() - if ! Empty(::Tablename) .and. ! Empty(::aKeys) - For i := 1 to len(::aKeys) - nField := oRow:Fieldpos(::aKeys[i]) - xField := oRow:FieldGetOld(nField) + IF ! Empty( ::Tablename ) .AND. ! Empty( ::aKeys ) + FOR i := 1 TO Len( ::aKeys ) + nField := oRow:Fieldpos( ::aKeys[ i ] ) + xField := oRow:FieldGetOld( nField ) - cWhere += ::aKeys[i] + " = $" + hb_NToS(i) + cWhere += ::aKeys[ i ] + " = $" + hb_ntos( i ) - AADD( aParams, ValueToString(xField) ) + AAdd( aParams, ValueToString( xField ) ) - if i != len(::aKeys) - cWhere += " and " - endif - Next + IF i != Len( ::aKeys ) + cWhere += " AND " + ENDIF + NEXT - if ! (cWhere == "") - cQuery := "DELETE FROM " + ::Schema + "." + ::Tablename + " WHERE " + cWhere - res := PQexecParams( ::pDB, cQuery, aParams) + 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 - res := NIL - endif - else - ::lError := .T. - ::cError := "There is no primary keys or query is a joined table" - endif -RETURN ! ::lError + IF PQresultstatus( res ) != PGRES_COMMAND_OK + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ::rows := 0 + ELSE + ::lError := .F. + ::cError := "" + ::rows := Val( PQcmdTuples( res ) ) + ENDIF + res := NIL + ENDIF + 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 + LOCAL cQuery + LOCAL i + LOCAL res + LOCAL lChanged := .F. + LOCAL aParams := {} + LOCAL nParams := 0 - ::SetKey() + ::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 + 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 (" + cQuery := Left( cQuery, Len( cQuery ) - 1 ) + ") VALUES (" - For i := 1 to oRow:FCount() - if ::lallCols .or. oRow:Changed(i) - nParams++ - cQuery += "$" + hb_NToS(nParams) + "," - aadd( aParams, ValueToString(oRow:FieldGet(i)) ) - endif - Next + FOR i := 1 TO oRow:FCount() + IF ::lallCols .OR. oRow:Changed( i ) + nParams++ + cQuery += "$" + hb_ntos( nParams ) + "," + AAdd( aParams, ValueToString( oRow:FieldGet( i ) ) ) + ENDIF + NEXT - cQuery := Left( cQuery, len(cQuery) - 1 ) + ")" + cQuery := Left( cQuery, Len( cQuery ) - 1 ) + ")" - if lChanged - res := PQexecParams( ::pDB, cQuery, aParams) + 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 + IF PQresultstatus( res ) != PGRES_COMMAND_OK + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ::rows := 0 + ELSE + ::lError := .F. + ::cError := "" + ::rows := Val( PQcmdTuples( res ) ) + ENDIF - res := NIL - endif - else - ::lError := .T. - ::cError := "Cannot insert in a joined table, or unknown error" - endif -RETURN ! ::lError + res := NIL + ENDIF + ELSE + ::lError := .T. + ::cError := "Cannot insert in a joined table, or unknown error" + ENDIF + RETURN ! ::lError -METHOD Update(oRow) CLASS TPQquery - Local cQuery - Local i - Local nField - Local xField - Local cWhere - Local res - Local lChanged := .f. - Local aParams := {} - Local nParams := 0 +METHOD Update( oRow ) CLASS TPQquery + LOCAL cQuery + LOCAL i + LOCAL nField + LOCAL xField + LOCAL cWhere + LOCAL res + LOCAL lChanged := .F. + LOCAL aParams := {} + LOCAL nParams := 0 - ::SetKey() + ::SetKey() - if ! Empty(::Tablename) .and. ! Empty(::aKeys) - cWhere := "" - For i := 1 to len(::aKeys) + IF ! Empty( ::Tablename ) .AND. ! Empty( ::aKeys ) + cWhere := "" + FOR i := 1 TO Len( ::aKeys ) - nField := oRow:Fieldpos(::aKeys[i]) - xField := oRow:FieldGetOld(nField) + nField := oRow:Fieldpos( ::aKeys[ i ] ) + xField := oRow:FieldGetOld( nField ) - cWhere += ::aKeys[i] + "=" + DataToSql(xField) + cWhere += ::aKeys[ i ] + "=" + DataToSql( xField ) - if i != len(::aKeys) - cWhere += " and " - endif - Next + IF i != Len( ::aKeys ) + cWhere += " AND " + ENDIF + 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) + " = $" + hb_NToS(nParams) + "," - aadd( aParams, ValueToString(oRow:FieldGet(i)) ) - endif - 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 ) + " = $" + hb_ntos( nParams ) + "," + AAdd( aParams, ValueToString( oRow:FieldGet( i ) ) ) + ENDIF + NEXT - if ! (cWhere == "") .and. lChanged + IF !( cWhere == "" ) .AND. lChanged - cQuery := Left( cQuery, len(cQuery) - 1 ) + " WHERE " + cWhere + cQuery := Left( cQuery, Len( cQuery ) - 1 ) + " WHERE " + cWhere - res := PQexecParams( ::pDB, cQuery, aParams) + 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 + IF PQresultstatus( res ) != PGRES_COMMAND_OK + ::lError := .T. + ::cError := PQresultErrormessage( res ) + ::rows := 0 + ELSE + ::lError := .F. + ::cError := "" + ::rows := Val( PQcmdTuples( res ) ) + ENDIF - res := NIL - endif - else - ::lError := .T. - ::cError := "Cannot insert in a joined table, or unknown error" - endif -RETURN ! ::lError + res := NIL + ENDIF + 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 result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - elseif nField < 1 .or. nField > ::nFields - nField := 0 - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ELSEIF nField < 1 .OR. nField > ::nFields + nField := 0 + ENDIF - if nField > 0 .and. ::nResultStatus == PGRES_TUPLES_OK + IF nField > 0 .AND. ::nResultStatus == PGRES_TUPLES_OK - if nRow == NIL - nRow := ::nRecno - endif + DEFAULT nRow TO ::nRecno - result := PQgetvalue( ::pQuery, nRow, nField) - cType := ::aStruct[ nField, 2 ] - //nSize := ::aStruct[ nField, 3 ] + result := PQgetvalue( ::pQuery, nRow, nField ) - if cType == "C" - if result == NIL - result := "" - else - result := result - endif + SWITCH ::aStruct[ nField ][ _STRU_FIELDTYPE ] + CASE "C" + CASE "M" + IF result != NIL + result := result + ELSE + result := "" + ENDIF + EXIT - elseif cType == "N" - if result != NIL - result := val(result) - else - result := 0 - endif + CASE "N" + IF result != NIL + result := Val( result ) + ELSE + result := 0 + ENDIF + EXIT - elseif cType == "D" - if result != NIL - result := hb_SToD( strtran( result, "-", "" ) ) - else - result := hb_SToD("") - endif + CASE "D" + IF result != NIL + result := hb_SToD( StrTran( result, "-", "" ) ) + ELSE + result := hb_SToD() + ENDIF + EXIT - elseif cType == "L" - if result != NIL - result := (result == "t") - else - result := .F. - endif - - elseif cType == "M" - if result == NIL - result := "" - else - result := result - endif - - endif - endif -RETURN result + CASE "L" + IF result != NIL + result := ( result == "t" ) + ELSE + result := .F. + ENDIF + EXIT + ENDSWITCH + ENDIF + RETURN result METHOD Getrow( nRow ) CLASS TPQquery - Local result, aRow := {}, aOld := {}, nCol + LOCAL result + LOCAL aRow + LOCAL aOld + LOCAL nCol - DEFAULT nRow TO ::nRecno + DEFAULT nRow TO ::nRecno - if ::nResultStatus == PGRES_TUPLES_OK + IF ::nResultStatus == PGRES_TUPLES_OK - if nRow > 0 .and. nRow <= ::nLastRec + IF nRow > 0 .AND. nRow <= ::nLastRec - ASize(aRow, ::nFields) - ASize(aOld, ::nFields) + aRow := Array( ::nFields ) + aOld := Array( ::nFields ) - For nCol := 1 to ::nFields - aRow[nCol] := ::Fieldget(nCol, nRow) - aOld[nCol] := ::Fieldget(nCol, nRow) - Next + FOR nCol := 1 TO ::nFields + aRow[ nCol ] := ::Fieldget( nCol, nRow ) + aOld[ nCol ] := ::Fieldget( nCol, nRow ) + NEXT - result := TPQRow():New( aRow, aOld, ::aStruct ) + result := TPQRow():New( aRow, aOld, ::aStruct ) - elseif nRow > ::nLastrec - result := ::GetBlankRow() - endif - endif -RETURN result + ELSEIF nRow > ::nLastrec + result := ::GetBlankRow() + ENDIF + ENDIF + RETURN result METHOD GetBlankRow() CLASS TPQquery - Local result, aRow := {}, aOld := {}, i + LOCAL aRow := Array( ::nFields ) + LOCAL aOld := Array( ::nFields ) + LOCAL 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] := hb_StoD("") - aOld[i] := hb_StoD("") - elseif ::aStruct[i, 2] == "M" - aRow[i] := "" - aOld[i] := "" - endif - Next - - result := TPQRow():New( aRow, aOld, ::aStruct ) -RETURN result + FOR i := 1 TO ::nFields + SWITCH ::aStruct[ i ][ _STRU_FIELDTYPE ] + CASE "C" + CASE "M" + aRow[ i ] := "" + aOld[ i ] := "" + EXIT + CASE "N" + aRow[ i ] := 0 + aOld[ i ] := 0 + EXIT + CASE "L" + aRow[ i ] := .F. + aOld[ i ] := .F. + EXIT + CASE "D" + aRow[ i ] := hb_SToD() + aOld[ i ] := hb_SToD() + EXIT + ENDSWITCH + NEXT + RETURN TPQRow():New( aRow, aOld, ::aStruct ) METHOD SetKey() CLASS TPQquery - Local cQuery - Local i, x - Local nTableId, xTableId := -1 - Local nCount := 0 - Local res - Local nPos + LOCAL cQuery + LOCAL i, x + LOCAL nTableId, xTableId := -1 + LOCAL nCount := 0 + LOCAL res + LOCAL nPos - if ::nResultStatus == PGRES_TUPLES_OK - if ::Tablename == NIL - /* set the table name looking for table oid */ - for i := 1 to len(::aStruct) - /* Store table codes oid */ - nTableId := ::aStruct[i, 5] + IF ::nResultStatus == PGRES_TUPLES_OK + IF ::Tablename == NIL + /* set the table name looking for table oid */ + FOR i := 1 TO Len( ::aStruct ) + /* Store table codes oid */ + nTableId := ::aStruct[ i ][ _STRU_TABLE ] - if nTableId != xTableId - xTableId := nTableId - nCount++ - endif - next + 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 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 + ::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 ( npos := At( " ", cQuery ) ) != 0 + ::Tablename := RTrim( Left( cQuery, npos ) ) + ELSE + ::Tablename := cQuery + ENDIF + ENDIF - if empty(::Tablename) - cQuery := "select relname from pg_class where oid = " + str(xTableId) + IF Empty( ::Tablename ) + cQuery := "SELECT relname FROM pg_class WHERE oid = " + Str( xTableId ) - res := PQexec(::pDB, cQuery) + res := PQexec( ::pDB, cQuery ) - if PQresultstatus(res) == PGRES_TUPLES_OK .and. PQlastrec(res) != 0 - ::Tablename := trim(PQgetvalue(res, 1, 1)) - endif + IF PQresultstatus( res ) == PGRES_TUPLES_OK .AND. PQlastrec( res ) != 0 + ::Tablename := RTrim( PQgetvalue( res, 1, 1 ) ) + ENDIF - res := NIL - endif - endif - endif + res := NIL + ENDIF + ENDIF + ENDIF - if ::aKeys == NIL .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) + IF ::aKeys == NIL .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) + res := PQexec( ::pDB, cQuery ) - if PQresultstatus(res) == PGRES_TUPLES_OK .and. PQlastrec(res) != 0 - ::aKeys := {} + 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 + FOR x := 1 TO PQlastrec( res ) + AAdd( ::aKeys, PQgetvalue( res, x, 1 ) ) + NEXT + ENDIF - res := NIL - endif - endif + res := NIL + ENDIF + ENDIF -RETURN nil + RETURN NIL CREATE CLASS TPQRow VAR aRow @@ -1176,7 +1177,7 @@ CREATE CLASS TPQRow METHOD New( row, old, struct ) - METHOD FCount() INLINE Len(::aRow) + METHOD FCount() INLINE Len( ::aRow ) METHOD FieldGet( nField ) METHOD FieldPut( nField, Value ) METHOD FieldName( nField ) @@ -1184,135 +1185,129 @@ CREATE CLASS TPQRow METHOD FieldLen( nField ) METHOD FieldDec( nField ) METHOD FieldType( nField ) - METHOD Changed( nField ) INLINE !(::aRow[nField] == ::aOld[nField]) - METHOD FieldGetOld( nField ) INLINE ::aOld[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 - + ::aRow := row + ::aOld := old + ::aStruct := struct + RETURN self METHOD FieldGet( nField ) CLASS TPQrow - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ENDIF - if nField >= 1 .and. nField <= len(::aRow) - result := ::aRow[nField] - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aRow ) + result := ::aRow[ nField ] + ENDIF + RETURN result METHOD FieldPut( nField, Value ) CLASS TPQrow - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ENDIF - if nField >= 1 .and. nField <= len(::aRow) - result := ::aRow[nField] := Value - endif -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aRow ) + result := ::aRow[ nField ] := Value + ENDIF + RETURN result METHOD FieldName( nField ) CLASS TPQrow - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ENDIF - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 1] - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ _STRU_FIELDNAME ] + ENDIF + RETURN result METHOD FieldPos( cField ) CLASS TPQrow - Local result - result := AScan( ::aStruct, {|x| x[1] == trim(lower(cField)) }) - -RETURN result + cField := RTrim( Lower( cField ) ) + RETURN AScan( ::aStruct, {| x | x[ _STRU_FIELDNAME ] == cField } ) METHOD FieldType( nField ) CLASS TPQrow - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ENDIF - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 2] - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ _STRU_FIELDTYPE ] + ENDIF + RETURN result METHOD FieldLen( nField ) CLASS TPQrow - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ENDIF - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 3] - endif -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ _STRU_FIELDLEN ] + ENDIF + RETURN result METHOD FieldDec( nField ) CLASS TPQrow - Local result + LOCAL result - if ISCHARACTER(nField) - nField := ::Fieldpos(nField) - endif + IF ISCHARACTER( nField ) + nField := ::Fieldpos( nField ) + ENDIF - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 4] - endif -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ _STRU_FIELDDEC ] + ENDIF + RETURN result -Static Function DataToSql(xField) - Local cType, result := "NULL" +STATIC FUNCTION DataToSql( xField ) - cType := ValType(xField) + SWITCH ValType( xField ) + CASE "C" + CASE "M" + RETURN "'"+ StrTran( xField, "'", " " ) + "'" + CASE "D" + RETURN DToS( xField ) + CASE "N" + RETURN Str( xField ) + CASE "L" + RETURN iif( xField, "'t'", "'f'" ) + ENDSWITCH - if cType == "C" .or. cType == "M" - result := "'"+ strtran(xField, "'", " ") + "'" - elseif cType == "D" - result := dtos( xField) - elseif cType == "N" - result := str(xField) - elseif cType == "L" - result := iif( xField, "'t'", "'f'" ) - endif -return result + RETURN "NULL" -Static Function ValueToString(xField) - Local cType, result := nil +STATIC FUNCTION ValueToString( xField ) - cType := ValType(xField) + SWITCH ValType( xField ) + CASE "D" + RETURN DToS( xField ) + CASE "N" + RETURN Str( xField ) + CASE "L" + RETURN iif( xField, "t", "f" ) + CASE "C" + CASE "M" + RETURN xField + ENDSWITCH - if cType == "D" - result := dtos( xField ) - elseif cType == "N" - result := str(xField) - elseif cType == "L" - result := iif( xField, "t", "f" ) - elseif cType == "C" .or. cType == "M" - result := xField - endif -return result + RETURN NIL