fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2010-11-21 19:38 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* contrib/hbsqlit3/hbsqlit3.hbp
  + contrib/hbsqlit3/hdbcsqlt.prg
  + contrib/hbsqlit3/tests/hdbctest.prg
  * contrib/hbpgsql/hbpgsql.hbp
  + contrib/hbpgsql/hdbcpg.prg
  + contrib/hbpgsql/tests/hdbctest.prg
    + Added code posted by Lorenzo Fiorini. Many thanks for this contribution.
      It's JDBC-like classes to access PGSQL and SQLITE backends.

    + Cleanups to build in Harbour.
    + Added PROTECTED scope for all object variables. This cause at least
      one failure in sqlt. see TOFIX section.
    + Changed to use PQconnectDB() instead of deprecated PQconnect()
    + Some formatting.

    ; TOFIX: These hbpgsql functions are required, but they are not yet
             implemented in Harbour SVN:
        PQPREPARE()
        PQEXECPREPARED()

    ; TOFIX: Internal are accessing obj vars directly:
        Error BASE/42  Scope violation (protected): TSQLTSTATEMENT:PRES
        Called from TSQLTSTATEMENT:PRES(0)
        Called from TSQLTRESULTSET:NEW(0)
        Called from TSQLTSTATEMENT:EXECUTEQUERY(0)
        Called from MAIN(91)

    ; TODO: Delete PQRDD experimental RDD from pgsql.
    ; TODO: Rename classes to begin with HDBC*
    ; TODO: Somehow we should ensure the class layout doesn't deviate from 
            a common standard. F.e. by inheritance, or I don't know if 
            Harbour has something like interfaces in OOP.
This commit is contained in:
Viktor Szakats
2010-11-21 18:39:38 +00:00
parent d3b7a3a61b
commit d267434478
7 changed files with 1794 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
harbour/ChangeLog
View File

@@ -16,6 +16,40 @@
The license applies to all entries newer than 2009-04-28.
*/
2010-11-21 19:38 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbsqlit3/hbsqlit3.hbp
+ contrib/hbsqlit3/hdbcsqlt.prg
+ contrib/hbsqlit3/tests/hdbctest.prg
* contrib/hbpgsql/hbpgsql.hbp
+ contrib/hbpgsql/hdbcpg.prg
+ contrib/hbpgsql/tests/hdbctest.prg
+ Added code posted by Lorenzo Fiorini. Many thanks for this contribution.
It's JDBC-like classes to access PGSQL and SQLITE backends.
+ Cleanups to build in Harbour.
+ Added PROTECTED scope for all object variables. This cause at least
one failure in sqlt. see TOFIX section.
+ Changed to use PQconnectDB() instead of deprecated PQconnect()
+ Some formatting.
; TOFIX: These hbpgsql functions are required, but they are not yet
implemented in Harbour SVN:
PQPREPARE()
PQEXECPREPARED()
; TOFIX: Internal are accessing obj vars directly:
Error BASE/42 Scope violation (protected): TSQLTSTATEMENT:PRES
Called from TSQLTSTATEMENT:PRES(0)
Called from TSQLTRESULTSET:NEW(0)
Called from TSQLTSTATEMENT:EXECUTEQUERY(0)
Called from MAIN(91)
; TODO: Delete PQRDD experimental RDD from pgsql.
; TODO: Rename classes to begin with HDBC*
; TODO: Somehow we should ensure the class layout doesn't deviate from
a common standard. F.e. by inheritance, or I don't know if
Harbour has something like interfaces in OOP.
2010-11-21 17:35 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/src/vm/thread.c
* cover s_fThreadInit declaration by HB_MT_VM macro

1
harbour/contrib/hbpgsql/hbpgsql.hbp
View File

@@ -30,3 +30,4 @@ postgres.c
tpostgre.prg
pgrdd.prg
hdbcpg.prg

767
harbour/contrib/hbpgsql/hdbcpg.prg Normal file
View File

@@ -0,0 +1,767 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* PostgreSQL RDBMS JDBC like interface code.
*
* Copyright 2008 Lorenzo Fiorini lorenzo.fiorini@gmail.com
* www - http://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.
*
* See doc/license.txt for licensing terms.
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "error.ch"
#include "postgres.ch"
create class TPGConnection
PROTECTED:
var pDb
var lTrans
var lTrace INIT .F.
var pTrace
EXPORTED:
method new( cHost, cDatabase, cUser, cPass, nPort )
method close()
method startTransaction()
method transactionStatus() INLINE PQtransactionstatus( ::pDb )
method commit()
method rollback()
method createStatement()
method prepareStatement( cSql )
method getMetadata()
endclass
method new( cHost, cDatabase, cUser, cPass, nPort ) class TPGConnection
DEFAULT nPort TO 5432
::pDB := PQconnectDB( "dbname = " + cDatabase + " host = " + cHost + " user = " + cUser + " password = " + cPass + " port = " + hb_ntos( nPort ) )
if PQstatus( ::pDb ) != CONNECTION_OK
raiseError( PQerrormessage( ::pDb ) )
endif
return Self
method close() class TPGConnection
PQClose( ::pDb )
return nil
method startTransaction() class TPGConnection
Local pRes := PQexec( ::pDB, "BEGIN" )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
endif
PQclear( pRes )
return nil
method commit() class TPGConnection
Local pRes := PQexec( ::pDB, "COMMIT" )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
endif
PQclear( pRes )
return nil
method rollback() class TPGConnection
Local pRes := PQexec( ::pDB, "ROLLBACK" )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
endif
PQclear( pRes )
return nil
method createStatement() class TPGConnection
return TPGStatement():new( ::pDB )
method prepareStatement( cSql ) class TPGConnection
return TPGPreparedStatement():new( ::pDB, cSql )
method getMetadata() class TPGConnection
return TPGDatabaseMetaData():new( ::pDB )
create class TPGStatement
PROTECTED:
var pDB
var cSql
var pRes
var oRs
EXPORTED:
method new( pDB, cSql )
method executeQuery( cSql )
method executeUpdate( cSql )
method Close()
endclass
method new( pDB, cSql ) class TPGStatement
::pDB := pDB
::cSql := cSql
return self
method executeQuery( cSql ) class TPGStatement
::pRes := PQexec( ::pDB, cSql )
if PQresultstatus( ::pRes ) != PGRES_TUPLES_OK
raiseError( PQresultErrormessage( ::pRes ) )
else
::oRs := TPGResultSet():new( ::pDB, Self )
endif
return ::oRs
method executeUpdate( cSql ) class TPGStatement
Local nRows
::pRes := PQexec( ::pDB, cSql )
if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( ::pRes ) )
else
nRows := val( PQcmdTuples( ::pRes ) )
endif
return nRows
method Close() class TPGStatement
if !ISNIL( ::pRes )
PQclear( ::pRes )
::pRes := nil
endif
return nil
create class TPGPreparedStatement
PROTECTED:
var pDB
var cSql
var pRes
var oRs
var cName INIT "hdbcpg11"
var lPrepared INIT .F.
var nParams INIT 0
var aParams INIT array( 128 )
EXPORTED:
method new( pDB, cSql )
method executeQuery()
method executeUpdate()
method Close()
method setString( nParam, xValue )
method SetNumber( n, x ) INLINE ::setString( n, str( x ) )
method SetDate( n, x ) INLINE ::setString( n, dtos( x ) )
method SetBoolean( n, x ) INLINE ::setString( n, iif( x, "t", "f" ) )
endclass
method new( pDB, cSql ) class TPGPreparedStatement
::pDB := pDB
::cSql := cSql
return self
method executeQuery() class TPGPreparedStatement
Local pRes
if !::lPrepared
::aParams := asize( ::aParams, ::nParams )
pRes := PQprepare( ::pDB, ::cName, ::cSql, ::nParams )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
else
::lPrepared := .T.
endif
PQClear( pRes )
endif
if ::lPrepared
::pRes := PQexecPrepared( ::pDB, ::cName, ::aParams )
if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK .and. PQresultstatus( ::pRes ) != PGRES_TUPLES_OK
raiseError( PQresultErrormessage( ::pRes ) )
else
::oRs := TPGResultSet():new( ::pDB, Self )
::aParams := array( ::nParams )
endif
endif
return ::oRs
method executeUpdate() class TPGPreparedStatement
Local nRows
if !::lPrepared
::aParams := asize( ::aParams, ::nParams )
::pRes := PQprepare( ::pDB, ::cName, ::cSql, ::nParams )
if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( ::pRes ) )
else
::lPrepared := .T.
endif
PQClear( ::pRes )
endif
if ::lPrepared
::pRes := PQexecPrepared( ::pDB, ::cName, ::aParams )
if PQresultstatus( ::pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( ::pRes ) )
else
nRows := val( PQcmdTuples( ::pRes ) )
::aParams := array( ::nParams )
endif
endif
return nRows
method setString( nParam, xValue ) class TPGPreparedStatement
::aParams[ nParam ] := xValue
if !::lPrepared
if nParam > ::nParams
::nParams := nParam
endif
endif
return nil
method Close() class TPGPreparedStatement
if !ISNIL( ::pRes )
PQclear( ::pRes )
::pRes := nil
endif
::pRes := PQexec( ::pDB, "DEALLOCATE " + ::cName )
PQclear( ::pRes )
::pRes := nil
return nil
create class TPGResultSet
PROTECTED:
var pDB
var pStmt
var pRes
var lBeforeFirst INIT .T.
var lAfterLast INIT .F.
var nRow INIT 0
var nRows INIT 0
var cTableName
var aPrimaryKeys
var cPrimaryWhere
var aBuffer
var nCurrentRow
EXPORTED:
method new( pDB, pStmt )
method Close()
method beforeFirst()
method first() INLINE ::absolute( 1 )
method previous() INLINE ::relative( -1 )
method next() INLINE ::relative( 1 )
method last() INLINE ::absolute( ::nRows )
method afterLast()
method relative( nMove )
method absolute( nMove )
method isBeforeFirst() INLINE ::lBeforeFirst
method isFirst() INLINE ( ::nRow == 1 )
method isLast() INLINE ( ::nRow == ::nRows )
method isAfterLast() INLINE ::lAfterLast
method getRow() INLINE ::nRow
method findColumn( cField )
method getString( nField )
method getNumber( nField ) INLINE val( ::getString( nField ) )
method getDate( nField ) INLINE StoD( strtran( ::getString( nField ), "-", "" ) )
method getBoolean( nField ) INLINE ( ::getString( nField ) == "t" )
method getMetaData()
method setTableName( cTable ) INLINE ::cTableName := cTable
method setPrimaryKeys( aKeys ) INLINE ::aPrimaryKeys := aKeys
method moveToInsertRow()
method moveToCurrentRow()
method insertRow()
method updateRow()
method deleteRow()
method updateBuffer( nField, xValue, cType )
method updateString( nField, cValue ) INLINE ::updateBuffer( nField, cValue, "C" )
method updateNumber( nField, nValue ) INLINE ::updateBuffer( nField, alltrim( str( nValue ) ), "N" )
method updateDate( nField, dValue ) INLINE ::updateBuffer( nField, dtos( dValue ), "D" )
method updateBoolean( nField, lValue ) INLINE ::updateBuffer( nField, iif( lValue, "t", "f" ), "L" )
endclass
method new( pDB, pStmt ) class TPGResultSet
::pDB := pDB
::pStmt := pStmt
::pRes := pStmt:pRes
::nRows := PQlastrec( ::pRes )
if ::nRows != 0
::nRow := 0
::lBeforeFirst := .T.
::lAfterLast := .F.
endif
return Self
method Close() class TPGResultSet
return nil
method beforeFirst() class TPGResultSet
::nRow := 0
::lBeforeFirst := .T.
::lAfterLast := .F.
return nil
method afterLast() class TPGResultSet
::nRow := ::nRows + 1
::lBeforeFirst := .F.
::lAfterLast := .T.
return nil
method relative( nMove ) class TPGResultSet
Local nRowNew := ::nRow + nMove
if nRowNew >= 1 .and. nRowNew <= ::nRows
::nRow := nRowNew
::lBeforeFirst := .F.
::lAfterLast := .F.
return .T.
else
if nRowNew < 1
::nRow := 0
::lBeforeFirst := .T.
else
::nRow := ::nRows + 1
::lAfterLast := .T.
endif
endif
return .F.
method absolute( nMove ) class TPGResultSet
if nMove > 0
if nMove <= ::nRows
::nRow := nMove
::lBeforeFirst := .F.
::lAfterLast := .F.
return .T.
endif
elseif nMove < 0
if -nMove <= ::nRows
::nRow := ::nRows + nMove
::lBeforeFirst := .F.
::lAfterLast := .F.
return .T.
endif
endif
return .F.
method findColumn( cField ) class TPGResultSet
return PQFNumber( ::pRes, cField )
method getString( nField ) class TPGResultSet
if ISCHARACTER( nField )
nField := PQFNumber( ::pRes, nField )
endif
return PQgetvalue( ::pRes, ::nRow, nField )
method getMetaData() class TPGResultSet
return TPGResultSetMetaData():new( ::pRes )
method moveToInsertRow() class TPGResultSet
::nCurrentRow := ::nRow
::aBuffer := array( PQnfields( ::pRes ) )
return nil
method moveToCurrentRow() class TPGResultSet
::nRow := ::nCurrentRow
return nil
method updateBuffer( nField, xValue, cType ) class TPGResultSet
if ISCHARACTER( nField )
nField := ::findColumn( nField )
endif
if ::aBuffer == nil
::aBuffer := array( PQnfields( ::pRes ) )
endif
::aBuffer[ nField ] := { xValue, cType }
return nil
method insertRow() class TPGResultSet
local pRes := ::pRes
local aBuffer := ::aBuffer
local cSqlFields
local cSqlValues
local nField
local nFields := len( aBuffer )
if !empty( ::cTableName )
cSqlFields := ""
cSqlValues := ""
for nField := 1 to nFields
if aBuffer[ nField ] != nil
cSqlFields += "," + PQfname( pRes, nField )
cSqlValues += "," + iif( aBuffer[ nField ][ 2 ] == "N", aBuffer[ nField ][ 1 ], "'" + aBuffer[ nField ][ 1 ] + "'" )
endif
next
pRes := PQexec( ::pDB, "INSERT INTO " + ::cTableName + " (" + substr( cSqlFields, 2 ) + ") VALUES (" + substr( cSqlValues, 2 ) + ")" )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
endif
PQclear( pRes )
else
raiseError( "Table name is not set" )
endif
::aBuffer := nil
return nil
method updateRow() class TPGResultSet
local pRes := ::pRes
local aBuffer := ::aBuffer
local aKeys := ::aPrimaryKeys
local nKeys := len( aKeys )
local cSql
local cSqlWhere
local nField
local nFields := len( aBuffer )
if !empty( ::cTableName ) .and. !empty( aKeys )
cSql := ""
for nField := 1 to nFields
if aBuffer[ nField ] != nil
cSql += "," + PQfname( pRes, nField ) + "=" + iif( aBuffer[ nField ][ 2 ] == "N", aBuffer[ nField ][ 1 ], "'" + aBuffer[ nField ][ 1 ] + "'" )
endif
next
cSqlWhere := ""
for nField := 1 to nKeys
cSqlWhere += "AND " + aKeys[ nField ][ 1 ] + "=" + iif( aKeys[ nField ][ 2 ] == "N", ::getString( aKeys[ nField ][ 1 ] ), "'" + ::getString( aKeys[ nField ][ 1 ] ) + "'" )
next
pRes := PQexec( ::pDB, "UPDATE " + ::cTableName + " SET " + substr( cSql, 2 ) + " WHERE " + substr( cSqlWhere, 5 ) )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
endif
PQclear( pRes )
endif
return nil
method deleteRow() class TPGResultSet
local pRes
local aKeys := ::aPrimaryKeys
local nField
local nKeys := len( aKeys )
local cSqlWhere
if !empty( ::cTableName ) .and. !empty( aKeys )
cSqlWhere := ""
for nField := 1 to nKeys
cSqlWhere += "AND " + aKeys[ nField ][ 1 ] + "=" + iif( aKeys[ nField ][ 2 ] == "N", ::getString( aKeys[ nField ][ 1 ] ), "'" + ::getString( aKeys[ nField ][ 1 ] ) + "'" )
next
pRes := PQexec( ::pDB, "DELETE FROM " + ::cTableName + " WHERE " + substr( cSqlWhere, 5 ) )
if PQresultstatus( pRes ) != PGRES_COMMAND_OK
raiseError( PQresultErrormessage( pRes ) )
endif
PQclear( pRes )
endif
return nil
create class TPGResultSetMetaData
PROTECTED:
var pRes
EXPORTED:
method new( pRes )
method getColumnCount()
method getColumnName( nColumn )
method getColumnDisplaySize( nColumn )
endclass
method new( pRes ) class TPGResultSetMetaData
::pRes := pRes
return Self
method getColumnCount() class TPGResultSetMetaData
return PQnfields( ::pRes )
method getColumnName( nColumn ) class TPGResultSetMetaData
return PQfname( ::pRes, nColumn )
method getColumnDisplaySize( nColumn ) class TPGResultSetMetaData
return PQfsize( ::pRes, nColumn )
create class TPGDatabaseMetaData
PROTECTED:
var pDB
EXPORTED:
method new( pDB )
method getTables( cCatalog, cSchema, cTableName, cTableType )
method getPrimaryKeys( cCatalog, cSchema, cTableName )
endclass
method new( pDB ) class TPGDatabaseMetaData
::pDB := pDB
return Self
method getTables( cCatalog, cSchema, cTableName, cTableType ) class TPGDatabaseMetaData
Local n, nTables
Local aTables := {}
Local cSql
Local pRes
default cCatalog to ""
default cSchema to "public"
default cTableName to "%"
default cTableType to "BASE TABLE"
cSql := "select table_catalog, table_schema, table_name, table_type from information_schema.tables "
cSql += "where table_schema in ('" + cSchema + "') and table_schema not in ('pg_catalog', 'information_schema')"
cSql += " and table_name ilike '" + cTableName + "'"
cSql += " and table_type in ('" + cTableType + "')"
pRes := PQexec( ::pDB, cSql )
if PQresultstatus( pRes ) != PGRES_TUPLES_OK
raiseError( PQresultErrormessage( pRes ) )
else
nTables := PQlastrec( pRes )
for n := 1 to nTables
aadd( aTables, { PQgetvalue( pRes, n, 1 ), PQgetvalue( pRes, n, 2 ), PQgetvalue( pRes, n, 3 ), PQgetvalue( pRes, n, 4 ), "" } )
next
endif
PQclear( pRes )
return aTables
method getPrimaryKeys( cCatalog, cSchema, cTableName ) class TPGDatabaseMetaData
Local pRes
Local cQuery
Local nKeys
Local aKeys
Local n
default cCatalog to ""
default cSchema to "public"
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 = '" + cTableName + "'"
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 = '" + cSchema + "'"
pRes := PQexec( ::pDB, cQuery )
nKeys := PQlastrec( pRes )
if PQresultstatus( pRes ) == PGRES_TUPLES_OK .and. nKeys != 0
aKeys := {}
for n := 1 To nKeys
aadd( aKeys, PQgetvalue( pRes, n, 1 ) )
next
endif
PQclear( pRes )
return aKeys
static procedure raiseError( cErrMsg )
Local oErr
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_OPEN
oErr:subSystem := "HDBCPG"
oErr:SubCode := 1000
oErr:Description := cErrMsg
Eval( ErrorBlock(), oErr )
return

200
harbour/contrib/hbpgsql/tests/hdbctest.prg Normal file
View File

@@ -0,0 +1,200 @@
/*
* $Id$
*/
#include "common.ch"
FUNCTION Main( cHost, cDatabase, cUser, cPass )
LOCAL oConn, oMeta, oStmt, cSql, n, oRs
oConn := TPGConnection():New( cHost, cDatabase, cUser, cPass )
oMeta := oConn:getMetaData()
? hb_ValToExp( oMeta:getTables() )
IF AScan( oMeta:getTables(), { | a | "test" == a[ 3 ] } ) > 0
? "test table already exist let's drop it"
oStmt := oConn:createStatement()
oStmt:executeUpdate( "DROP TABLE test" )
oStmt:Close()
? "dropped"
ENDIF
? 'Creating test table...'
cSql := 'CREATE TABLE test('
cSql += ' Code integer not null primary key, '
cSql += ' dept Integer, '
cSql += ' Name Varchar(40), '
cSql += ' Sales boolean, '
cSql += ' Tax Float4, '
cSql += ' Salary Double Precision, '
cSql += ' Budget Numeric(12,2), '
cSql += ' Discount Numeric (5,2), '
cSql += ' Creation Date, '
cSql += ' Description text ) '
oStmt := oConn:createStatement()
oStmt:executeUpdate( cSql )
oStmt:Close()
? "created"
? 'Inserting, declared transaction control '
oConn:StartTransaction()
? "Inserting using direct statement..."
#define _NUMROWS_ 10
? Time()
FOR n := 1 TO _NUMROWS_
cSql := "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) "
cSql += "VALUES( " + str( n ) + ", 2, 'TEST', '" + iif( n % 2 != 0, "y", "n" ) + "', 5, 3000, 1500.2, 7.5, '12-22-2003', 'Short Description ')"
oStmt := oConn:createStatement()
oStmt:executeUpdate( cSql )
oStmt:close()
NEXT
? Time()
/*
? "Creating prepared statement"
? Time()
oStmt := oConn:prepareStatement( "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) VALUES ( $1, $2, $3, $4, $5, $6, $7, $8, $9, $10 )")
FOR n := _NUMROWS_ + 1 TO _NUMROWS_ * 2
oStmt:SetNumber( 1, n )
oStmt:SetNumber( 2, 2 )
oStmt:SetString( 3, "TEST" )
oStmt:SetBoolean( 4, iif( n % 2 != 0, .T., .F. ) )
oStmt:SetNumber( 5, 5 )
oStmt:SetNumber( 6, 3000 )
oStmt:SetNumber( 7, 1500 )
oStmt:SetNumber( 8, 7.5 )
oStmt:SetDate( 9, Date() )
oStmt:SetString( 10, "Short' Description" )
oStmt:executeUpdate()
NEXT
oStmt:close()
? Time()
*/
oConn:Commit()
oStmt := oConn:createStatement()
? "Excecuting query"
oRs := oStmt:executeQuery( "SELECT code, name, description, sales FROM test" )
? "Showing metadata"
? oRs:getMetaData():getColumnCount()
? "Showing results"
? "nRows", oRs:nRows
? "getrow", oRs:getRow()
? "isbeforefirst", oRs:isBeforeFirst()
? "next", oRs:next()
? "isfirst", oRs:isFirst()
? "getrow", oRs:getRow()
? "previous", oRs:previous()
? "getrow", oRs:getRow()
? "first", oRs:first()
? "getrow", oRs:getRow()
? "last", oRs:last()
? "getrow", oRs:getRow()
? "isbeforefirst", oRs:isBeforeFirst()
oRs:beforeFirst()
? "ascending"
DO WHILE oRs:next()
? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" )
ENDDO
? "isafterlast", oRs:isAfterLast()
oRs:AfterLast()
? "descending"
DO WHILE oRs:previous()
? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" )
ENDDO
? "isbeforefirst", oRs:isBeforeFirst()
oRs:Close()
oStmt:Close()
? hb_ValToExp( oConn:getMetaData():getPrimaryKeys( "", "public", "test" ) )
oStmt := oConn:createStatement()
? "Excecuting query"
oRs := oStmt:executeQuery( "SELECT * FROM test" )
oRs:setTableName( "TEST" )
oRs:setPrimaryKeys( { { "code", "N" } } )
oRs:moveToInsertRow()
oRs:updateNumber( 1, 11 )
oRs:updateString( "description", "Inserted" )
oRs:insertRow()
oRs:first()
oRs:updateNumber( 8, 99.99 )
oRs:updateDate( 9, date() )
oRs:updateString( "description", "Updated" )
oRs:updateRow()
oRs:next()
oRs:deleteRow()
oRs:next()
oRs:deleteRow()
oRs:Close()
oRs := oStmt:executeQuery( "SELECT * FROM test order by code" )
DO WHILE oRs:next()
? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" ), oRs:getString( "Creation" )
ENDDO
oRs:close()
oStmt:close()
/*
? "Creating query prepared statement"
oStmt := oConn:prepareStatement( "SELECT code FROM test WHERE name = $1" )
oStmt:SetString( 1, "TEST" )
oStmt:executeQuery()
? oRs:getMetaData():getColumnCount()
? oRs:getMetaData():getColumnName( 1 )
?
DO WHILE oRs:next()
FOR n := 1 TO 1
? oRs:getString( n )
next
ENDDO
oStmt:close()
*/
oConn:Close()
? "Closing..."
RETURN NIL

1
harbour/contrib/hbsqlit3/hbsqlit3.hbp
View File

@@ -20,5 +20,6 @@
-instfile=inc:hbsqlit3.ch
hbsqlit3.c
hdbcsqlt.prg
../3rd/sqlite3/sqlite3.hbc{HBMK_HAS_SQLITE3_LOCAL}

591
harbour/contrib/hbsqlit3/hdbcsqlt.prg Normal file
View File

@@ -0,0 +1,591 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SQLite3 JDBC like interface code.
*
* Copyright 2008 Lorenzo Fiorini lorenzo.fiorini@gmail.com
* www - http://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.
*
* See doc/license.txt for licensing terms.
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "error.ch"
#include "hbsqlit3.ch"
#define _TODO_ nil
create class TSQLTConnection
PROTECTED:
var pDb
var lTrans
var lTrace INIT .F.
var pTrace
EXPORTED:
method new( cDBFile, lCreateIfNotExist )
method close()
method startTransaction()
/* method transactionStatus */
method commit()
method rollback()
method getMetadata()
method createStatement()
method prepareStatement( cSql )
endclass
method new( cDBFile, lCreateIfNotExist ) class TSQLTConnection
::pDB := sqlite3_open( cDbFile, lCreateIfNotExist )
if sqlite3_errcode( ::pDb ) != SQLITE_OK
raiseError( sqlite3_errmsg( ::pDb ) )
endif
return Self
method close() class TSQLTConnection
::pDb := nil
return nil
method startTransaction() class TSQLTConnection
if sqlite3_exec( ::pDB, "BEGIN TRANSACTION" ) != SQLITE_OK
raiseError( sqlite3_errmsg( ::pDb ) )
endif
return nil
method commit() class TSQLTConnection
if sqlite3_exec( ::pDB, "COMMIT" ) != SQLITE_OK
raiseError( sqlite3_errmsg( ::pDb ) )
endif
return nil
method rollback() class TSQLTConnection
if sqlite3_exec( ::pDB, "ROLLBACK" ) != SQLITE_OK
raiseError( sqlite3_errmsg( ::pDb ) )
endif
return nil
method createStatement() class TSQLTConnection
return TSQLTStatement():new( ::pDB )
method prepareStatement( cSql ) class TSQLTConnection
return TSQLTPreparedStatement():new( ::pDB, cSql )
method getMetadata() class TSQLTConnection
return TSQLTDatabaseMetaData():new( ::pDB )
create class TSQLTStatement
PROTECTED:
var pDB
var cSql
var pRes
var oRs
EXPORTED:
method new( pDB, cSql )
method executeQuery( cSql )
method executeUpdate( cSql )
method Close()
endclass
method new( pDB, cSql ) class TSQLTStatement
::pDB := pDB
::cSql := cSql
return self
method executeQuery( cSql ) class TSQLTStatement
::pRes := sqlite3_prepare( ::pDB, cSql )
if ! hb_isPointer( ::pRes )
raiseError( sqlite3_errmsg( ::pDb ) )
else
::oRs := TSQLTResultSet():new( ::pDB, Self )
endif
return ::oRs
method executeUpdate( cSql ) class TSQLTStatement
Local nRows
if sqlite3_exec( ::pDB, cSql ) != SQLITE_OK
raiseError( sqlite3_errmsg( ::pDb ) )
else
nRows := sqlite3_changes( ::pDB )
endif
return nRows
method Close() class TSQLTStatement
if !ISNIL( ::pRes )
sqlite3_finalize( ::pRes )
::pRes := nil
endif
return nil
create class TSQLTPreparedStatement
PROTECTED:
var pDB
var cSql
var pRes
var oRs
var cName INIT "hdbcsqle"
var lPrepared INIT .F.
var nParams INIT 0
var aParams INIT array( 128 )
EXPORTED:
method new( pDB, cSql )
method executeQuery()
method executeUpdate()
method Close()
method setString( nParam, xValue )
method SetNumber( n, x ) INLINE ::setString( n, str( x ) )
method SetDate( n, x ) INLINE ::setString( n, dtos( x ) )
method SetBoolean( n, x ) INLINE ::setString( n, iif( x, "t", "f" ) )
endclass
method new( pDB, cSql ) class TSQLTPreparedStatement
::pDB := pDB
::cSql := cSql
return self
method executeQuery() class TSQLTPreparedStatement
if !::lPrepared
::aParams := asize( ::aParams, ::nParams )
/* TODO */
endif
if ::lPrepared
/* TODO */
endif
return _TODO_
method executeUpdate() class TSQLTPreparedStatement
if !::lPrepared
::aParams := asize( ::aParams, ::nParams )
/* TODO */
endif
if ::lPrepared
/* TODO */
endif
return _TODO_
method setString( nParam, xValue ) class TSQLTPreparedStatement
::aParams[ nParam ] := xValue
if !::lPrepared
if nParam > ::nParams
::nParams := nParam
endif
endif
return nil
method Close() class TSQLTPreparedStatement
if ! Empty( ::pRes )
sqlite3_finalize( ::pRes )
::pRes := nil
endif
return nil
create class TSQLTResultSet
PROTECTED:
var pDB
var pStmt
var pRes
var lBeforeFirst INIT .T.
var lAfterLast INIT .F.
var nRow INIT 0
var nRows INIT 0
var cTableName
var aPrimaryKeys
var cPrimaryWhere
var aBuffer
var nCurrentRow
var hColNames
EXPORTED:
method new( pDB, pStmt )
method Close()
method beforeFirst()
method first() INLINE ::absolute( 1 )
method previous() INLINE ::relative( -1 )
method next() INLINE ( sqlite3_step( ::pRes ) == SQLITE_ROW ) // ::relative( 1 )
method last() INLINE ::absolute( ::nRows )
method afterLast()
method relative( nMove )
method absolute( nMove )
method isBeforeFirst() INLINE ::lBeforeFirst
method isFirst() INLINE ( ::nRow == 1 )
method isLast() INLINE ( ::nRow == ::nRows )
method isAfterLast() INLINE ::lAfterLast
method getRow() INLINE ::nRow
method findColumn( cField )
method getString( nField )
method getNumber( nField ) INLINE val( ::getString( nField ) )
method getDate( nField ) INLINE StoD( strtran( ::getString( nField ), "-", "" ) )
method getBoolean( nField ) INLINE ( ::getString( nField ) == "t" )
method getMetaData()
method setTableName( cTable ) INLINE ::cTableName := cTable
method setPrimaryKeys( aKeys ) INLINE ::aPrimaryKeys := aKeys
method moveToInsertRow()
method moveToCurrentRow()
method insertRow()
method updateRow()
method deleteRow()
method updateBuffer( nField, xValue, cType )
method updateString( nField, cValue ) INLINE ::updateBuffer( nField, cValue, "C" )
method updateNumber( nField, nValue ) INLINE ::updateBuffer( nField, alltrim( str( nValue ) ), "N" )
method updateDate( nField, dValue ) INLINE ::updateBuffer( nField, dtos( dValue ), "D" )
method updateBoolean( nField, lValue ) INLINE ::updateBuffer( nField, iif( lValue, "t", "f" ), "L" )
endclass
method new( pDB, pStmt ) class TSQLTResultSet
::pDB := pDB
::pStmt := pStmt
::pRes := pStmt:pRes /* TOFIX ! */
::nRows := 100
if ::nRows != 0
::nRow := 0
::lBeforeFirst := .T.
::lAfterLast := .F.
endif
return Self
method Close() class TSQLTResultSet
return nil
method beforeFirst() class TSQLTResultSet
::nRow := 0
::lBeforeFirst := .T.
::lAfterLast := .F.
return nil
method afterLast() class TSQLTResultSet
::nRow := ::nRows + 1
::lBeforeFirst := .F.
::lAfterLast := .T.
return nil
method relative( nMove ) class TSQLTResultSet
Local nRowNew := ::nRow + nMove
if nRowNew >= 1 .and. nRowNew <= ::nRows
::nRow := nRowNew
::lBeforeFirst := .F.
::lAfterLast := .F.
return .T.
else
if nRowNew < 1
::nRow := 0
::lBeforeFirst := .T.
else
::nRow := ::nRows + 1
::lAfterLast := .T.
endif
endif
return .F.
method absolute( nMove ) class TSQLTResultSet
if nMove > 0
if nMove <= ::nRows
::nRow := nMove
::lBeforeFirst := .F.
::lAfterLast := .F.
return .T.
endif
elseif nMove < 0
if -nMove <= ::nRows
::nRow := ::nRows + nMove
::lBeforeFirst := .F.
::lAfterLast := .F.
return .T.
endif
endif
return .F.
method findColumn( cField ) class TSQLTResultSet
Local nCount
Local nMax
if !HB_ISHASH( ::hColNames )
::hColNames := { => }
nMax := sqlite3_column_count( ::pRes )
for nCount := 1 to nMax
::hColNames[ lower( sqlite3_column_name( ::pRes, nCount ) ) ] := nCount
next
endif
nCount := ::hColNames[ cField ]
return nCount
method getString( nField ) class TSQLTResultSet
if ISCHARACTER( nField )
nField := ::findColumn( nField )
endif
return sqlite3_column_text( ::pRes, nField )
method getMetaData() class TSQLTResultSet
return TSQLTResultSetMetaData():new( ::pRes )
method moveToInsertRow() class TSQLTResultSet
::nCurrentRow := ::nRow
::aBuffer := array( _TODO_ )
return nil
method moveToCurrentRow() class TSQLTResultSet
::nRow := ::nCurrentRow
return nil
method updateBuffer( nField, xValue, cType ) class TSQLTResultSet
if ISCHARACTER( nField )
nField := ::findColumn( nField )
endif
if ::aBuffer == nil
::aBuffer := array( _TODO_ )
endif
::aBuffer[ nField ] := { xValue, cType }
return nil
method insertRow() class TSQLTResultSet
/* TODO */
return nil
method updateRow() class TSQLTResultSet
/* TODO */
return nil
method deleteRow() class TSQLTResultSet
/* TODO */
return nil
create class TSQLTResultSetMetaData
PROTECTED:
var pRes
EXPORTED:
method new( pRes )
method getColumnCount()
method getColumnName( nColumn )
method getColumnDisplaySize( nColumn )
endclass
method new( pRes ) class TSQLTResultSetMetaData
::pRes := pRes
return Self
method getColumnCount() class TSQLTResultSetMetaData
return sqlite3_column_count( ::pRes )
method getColumnName( nColumn ) class TSQLTResultSetMetaData
return sqlite3_column_name( ::pRes, nColumn )
method getColumnDisplaySize( nColumn ) class TSQLTResultSetMetaData
HB_SYMBOL_UNUSED( nColumn )
return _TODO_
create class TSQLTDatabaseMetaData
PROTECTED:
var pDB
EXPORTED:
method new( pDB )
method getTables()
method getPrimaryKeys()
endclass
method new( pDB ) class TSQLTDatabaseMetaData
::pDB := pDB
return Self
method getTables() class TSQLTDatabaseMetaData
/* TODO */
return _TODO_
method getPrimaryKeys() class TSQLTDatabaseMetaData
/* TODO */
return _TODO_
static procedure raiseError( cErrMsg )
Local oErr
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_OPEN
oErr:subSystem := "HDBCSQLT"
oErr:SubCode := 1000
oErr:Description := cErrMsg
Eval( ErrorBlock(), oErr )
return

200
harbour/contrib/hbsqlit3/tests/hdbctest.prg Normal file
View File

@@ -0,0 +1,200 @@
/*
* $Id$
*/
#include "common.ch"
FUNCTION Main()
LOCAL oConn, oMeta, oStmt, cSql, n, oRs
oConn := TSQLTConnection():New( "test.db", .T. )
oMeta := oConn:getMetaData()
? hb_ValToExp( oMeta:getTables() )
IF AScan( oMeta:getTables(), { | a | "test" == a[ 3 ] } ) > 0
? "test table already exist let's drop it"
oStmt := oConn:createStatement()
oStmt:executeUpdate( "DROP TABLE test" )
oStmt:Close()
? "dropped"
ENDIF
? 'Creating test table...'
cSql := 'CREATE TABLE test('
cSql += ' Code integer not null primary key, '
cSql += ' dept Integer, '
cSql += ' Name Varchar(40), '
cSql += ' Sales boolean, '
cSql += ' Tax Float4, '
cSql += ' Salary Double Precision, '
cSql += ' Budget Numeric(12,2), '
cSql += ' Discount Numeric (5,2), '
cSql += ' Creation Date, '
cSql += ' Description text ) '
oStmt := oConn:createStatement()
oStmt:executeUpdate( cSql )
oStmt:Close()
? "created"
? 'Inserting, declared transaction control '
oConn:StartTransaction()
? "Inserting using direct statement..."
#define _NUMROWS_ 10
? Time()
FOR n := 1 TO _NUMROWS_
cSql := "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) "
cSql += "VALUES( " + str( n ) + ", 2, 'TEST', '" + iif( n % 2 != 0, "y", "n" ) + "', 5, 3000, 1500.2, 7.5, '12-22-2003', 'Short Description ')"
oStmt := oConn:createStatement()
oStmt:executeUpdate( cSql )
oStmt:close()
NEXT
? Time()
/*
? "Creating prepared statement"
? Time()
oStmt := oConn:prepareStatement( "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) VALUES ( $1, $2, $3, $4, $5, $6, $7, $8, $9, $10 )")
FOR n := _NUMROWS_ + 1 TO _NUMROWS_ * 2
oStmt:SetNumber( 1, n )
oStmt:SetNumber( 2, 2 )
oStmt:SetString( 3, "TEST" )
oStmt:SetBoolean( 4, iif( n % 2 != 0, .T., .F. ) )
oStmt:SetNumber( 5, 5 )
oStmt:SetNumber( 6, 3000 )
oStmt:SetNumber( 7, 1500 )
oStmt:SetNumber( 8, 7.5 )
oStmt:SetDate( 9, Date() )
oStmt:SetString( 10, "Short' Description" )
oStmt:executeUpdate()
NEXT
oStmt:close()
? Time()
*/
oConn:Commit()
oStmt := oConn:createStatement()
? "Excecuting query"
oRs := oStmt:executeQuery( "SELECT code, name, description, sales FROM test" )
? "Showing metadata"
? oRs:getMetaData():getColumnCount()
? "Showing results"
? "nRows", oRs:nRows
? "getrow", oRs:getRow()
? "isbeforefirst", oRs:isBeforeFirst()
? "next", oRs:next()
? "isfirst", oRs:isFirst()
? "getrow", oRs:getRow()
? "previous", oRs:previous()
? "getrow", oRs:getRow()
? "first", oRs:first()
? "getrow", oRs:getRow()
? "last", oRs:last()
? "getrow", oRs:getRow()
? "isbeforefirst", oRs:isBeforeFirst()
oRs:beforeFirst()
? "ascending"
DO WHILE oRs:next()
? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" )
ENDDO
? "isafterlast", oRs:isAfterLast()
oRs:AfterLast()
? "descending"
DO WHILE oRs:previous()
? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" )
ENDDO
? "isbeforefirst", oRs:isBeforeFirst()
oRs:Close()
oStmt:Close()
? hb_ValToExp( oConn:getMetaData():getPrimaryKeys( "", "public", "test" ) )
oStmt := oConn:createStatement()
? "Excecuting query"
oRs := oStmt:executeQuery( "SELECT * FROM test" )
oRs:setTableName( "TEST" )
oRs:setPrimaryKeys( { { "code", "N" } } )
oRs:moveToInsertRow()
oRs:updateNumber( 1, 11 )
oRs:updateString( "description", "Inserted" )
oRs:insertRow()
oRs:first()
oRs:updateNumber( 8, 99.99 )
oRs:updateDate( 9, date() )
oRs:updateString( "description", "Updated" )
oRs:updateRow()
oRs:next()
oRs:deleteRow()
oRs:next()
oRs:deleteRow()
oRs:Close()
oRs := oStmt:executeQuery( "SELECT * FROM test order by code" )
DO WHILE oRs:next()
? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" ), oRs:getString( "Creation" )
ENDDO
oRs:close()
oStmt:close()
/*
? "Creating query prepared statement"
oStmt := oConn:prepareStatement( "SELECT code FROM test WHERE name = $1" )
oStmt:SetString( 1, "TEST" )
oStmt:executeQuery()
? oRs:getMetaData():getColumnCount()
? oRs:getMetaData():getColumnName( 1 )
?
DO WHILE oRs:next()
FOR n := 1 TO 1
? oRs:getString( n )
next
ENDDO
oStmt:close()
*/
oConn:Close()
? "Closing..."
RETURN NIL