[PATCH] DBI interface with PostgreSQL and MySQL support

This interface was written by Mike Anderson (except the MySQL interface
which is a port of the old code) and is more easily extensible, cleaner,
and more "Smalltalk-like".

There are many things that could be done.  In particular, the
FieldConverter should be moved up from the MySQL DBD so that every DBD
provides one.  This is necessary to provide prepared statements.
Supporting SQLite would be also a good thing.  The DBI interface could
be grown with an object interface to SQL (like Avi Bryant's ROE).

Having the copyright assigned FSF would also be better, but since part
of the MySQL DBD is copyrighted by Josh Miller (it was not written
specially for GNU Smalltalk) I can live without it.

Anyway, for now this is already much better than the previous version.
With this in place, 3.0 is feature complete.  Yeah.

Paolo

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-552 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-552
D/ packages/db
A/ packages/dbd-postgresql
A/ packages/dbi
D  packages/db/ChangeLog
D  packages/db/DB.st
D  packages/db/package.xml
D  packages/mysql/MySQL.st
D  packages/mysql/README
D  packages/mysql/mysql-test.st
A  packages/dbd-mysql/Column.st
A  packages/dbd-mysql/Connection.st
A  packages/dbd-mysql/Extensions.st
A  packages/dbd-mysql/ResultSet.st
A  packages/dbd-mysql/Row.st
A  packages/dbd-mysql/Statement.st
A  packages/dbd-postgresql/ColumnInfo.st
A  packages/dbd-postgresql/Connection.st
A  packages/dbd-postgresql/ResultSet.st
A  packages/dbd-postgresql/Row.st
A  packages/dbd-postgresql/package.xml
A  packages/dbi/ColumnInfo.st
A  packages/dbi/Connection.st
A  packages/dbi/ConnectionInfo.st
A  packages/dbi/ResultSet.st
A  packages/dbi/Row.st
A  packages/dbi/Statement.st
A  packages/dbi/package.xml
M  packages/dbd-mysql/package.xml
M  packages/glorp/package.xml
M  configure.ac
M  packages/glorp/Glorp.st
M  packages/glorp/GlorpMySQL.st
M  packages/glorp/GlorpTest.st
M  packages/dbd-mysql/MySQLTests.st
M  NEWS
/> packages/mysql packages/dbd-mysql

* modified files

--- orig/NEWS
+++ mod/NEWS
@@ -63,6 +63,9 @@ o   The #writeStream method was moved do
     ArrayedCollection, since it does not really work well on variable-sized
     collections such as OrderedCollections.
 
+o   The database access library has been replaced by a new DBI-like library,
+    contributed by Mike Anderson.
+
 
 Packages improvements:
 


--- orig/configure.ac
+++ mod/configure.ac
@@ -241,6 +241,7 @@ GST_HAVE_GMP
 GST_HAVE_READLINE
 
 GST_PACKAGE_PREFIX([packages])
+
 GST_PACKAGE_ENABLE([BloxTK], [blox/tk],
    [GST_HAVE_TCLTK],
    [gst_cv_tcltk_libs],
@@ -249,7 +250,20 @@ GST_PACKAGE_ENABLE([Browser], [browser])
 GST_PACKAGE_ENABLE([Complex], [complex])
 GST_PACKAGE_ENABLE([Continuations], [continuations])
 GST_PACKAGE_ENABLE([DebugTools], [debug])
-GST_PACKAGE_ENABLE([DB], [db])
+
+GST_PACKAGE_ENABLE([DBD-MySQL], [dbd-mysql])
+AC_MSG_CHECKING([whether to run MySQL tests])
+AC_ARG_ENABLE(mysql-tests,
+[  --enable-mysql-tests=USER:PWD:DATABASE
+                          test MySQL bindings [default=root:root:test]], ,
+[enable_mysql_tests=no])
+AC_SUBST(enable_mysql_tests)
+
+GST_PACKAGE_ENABLE([DBD-PostgreSQL], [dbd-postgresql],
+   [GST_HAVE_LIB(pq, PQconnectdb)],
+   [ac_cv_lib_pq_PQconnectdb])
+GST_PACKAGE_ENABLE([DBI], [dbi])
+
 GST_PACKAGE_ENABLE([GDBM], [gdbm],
    [AC_CHECK_HEADER([gdbm.h])],
    [ac_cv_header_gdbm_h],
@@ -296,14 +310,6 @@ GST_PACKAGE_ENABLE([Iconv], [iconv],
 GST_PACKAGE_ENABLE([Java], [java])
 GST_PACKAGE_ENABLE([Digest], [digest], [], [], [Makefile], [digest.la])
 
-GST_PACKAGE_ENABLE([MySQL], [mysql])
-AC_MSG_CHECKING([whether to run MySQL tests])
-AC_ARG_ENABLE(mysql-tests,
-[  --enable-mysql-tests=USER:PWD:DATABASE
-                          test MySQL bindings [default=root:root:test]], ,
-[enable_mysql_tests=no])
-AC_SUBST(enable_mysql_tests)
-
 GST_PACKAGE_ENABLE([NCurses],
   [ncurses],
   [GST_HAVE_LIB(ncurses, initscr)],


--- orig/packages/mysql/MySQLTests.st
+++ mod/packages/dbd-mysql/MySQLTests.st
@@ -1,6 +1,6 @@
 "=====================================================================
 |
-|   Just a Database Manager - MySQL driver unit tests
+|   MySQL DBI driver unit tests
 |
 |
  ======================================================================"
@@ -29,140 +29,130 @@
 |
  ======================================================================"
 
-TestCase subclass: #JdmMysqlBaseTestCase
+TestCase subclass: #DBIMySQLBaseTestCase
  instanceVariableNames: 'connection testSupport testProgress '
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-JdmMysqlBaseTestCase subclass: #JdmMysqlCreateTableTestCase
+DBIMySQLBaseTestCase subclass: #DBIMySQLCreateTableTestCase
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-JdmMysqlBaseTestCase subclass: #JdmMysqlDropTableTestCase
+DBIMySQLBaseTestCase subclass: #DBIMySQLDropTableTestCase
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-JdmMysqlBaseTestCase subclass: #JdmMysqlDeleteTestCase
+DBIMySQLBaseTestCase subclass: #DBIMySQLDeleteTestCase
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-JdmMysqlBaseTestCase subclass: #JdmMysqlInsertTestCase
+DBIMySQLBaseTestCase subclass: #DBIMySQLInsertTestCase
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-JdmMysqlBaseTestCase subclass: #JdmMysqlSelectTestCase
+DBIMySQLBaseTestCase subclass: #DBIMySQLSelectTestCase
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-Object subclass: #JdmRangedRandom
+Object subclass: #RangedRandom
  instanceVariableNames: 'random highValue lowValue range numRandomBits '
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-Object subclass: #JdmTestProgress
+Object subclass: #TestProgress
  instanceVariableNames: 'resolution totalSteps numSteps stepsPerLevel currentStep displayCharacter '
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-TestSuite subclass: #JdmMysqlTestSuite
+TestSuite subclass: #DBIMySQLTestSuite
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-Object subclass: #JdmMysqlTestSupport
- instanceVariableNames: 'randomGenerators connectionSpec mysqlTypes mysqlValues enumSetValues '
+Object subclass: #DBIMySQLTestSupport
+ instanceVariableNames: 'randomGenerators mysqlTypes mysqlValues enumSetValues '
  classVariableNames: 'Instance '
  poolDictionaries: ''
  category: 'Mysql-Driver-Tests'!
 
 
-!JdmMysqlBaseTestCase methodsFor: 'initialize-release'!
+!DBIMySQLBaseTestCase methodsFor: 'initialize-release'!
 
 setUp
  super setUp.
- testSupport := JdmMysqlTestSupport mysqlTestSupport.
- connection := JdmConnection on: testSupport connectionSpec.
- testProgress := JdmTestProgress new: testSupport class numRowsToInsert.
+ testSupport := DBIMySQLTestSupport mysqlTestSupport.
+ connection := testSupport connect.
+ testProgress := TestProgress new: testSupport class numRowsToInsert.
  testProgress!
 
 tearDown
  connection close.! !
 
 
-!JdmMysqlBaseTestCase class methodsFor: 'constants'!
-
-tableName
- ^'TestTable'! !
-
-!JdmMysqlCreateTableTestCase methodsFor: 'tests'!
+!DBIMySQLCreateTableTestCase methodsFor: 'tests'!
 
 createTable
  | result |
  Transcript show: 'Creating table: ', testSupport class tableName, '...'.
- result := connection createStatement
- executeQuery: testSupport createTable.
+ result := connection do: testSupport createTable.
  Transcript show: ' Done'; nl.
- self should: [result type = #update and: [result value = 0]]! !
+ self should: [result isSelect not and: [result rowsAffected = 0]]! !
 
-!JdmMysqlDropTableTestCase methodsFor: 'tests'!
+!DBIMySQLDropTableTestCase methodsFor: 'tests'!
 
 dropTableIfExists
  | result |
  Transcript show: 'Dropping table: ', testSupport class tableName, '...'.
- result := connection createStatement
- executeQuery: 'drop table if exists ' , testSupport class tableName.
+ result := connection do: 'drop table if exists ' , testSupport class tableName.
  Transcript show: ' Done'; nl.
- self should: [result type = #update and: [result value = 0]]!
+ self should: [result isSelect not and: [result rowsAffected = 0]]!
 
 dropTable
  | result |
  Transcript show: 'Dropping table: ', testSupport class tableName, '...'.
- result := connection createStatement
- executeQuery: 'drop table ' , testSupport class tableName.
+ result := connection do: 'drop table ' , testSupport class tableName.
  Transcript show: ' Done'; nl.
- self should: [result type = #update and: [result value = 0]]! !
+ self should: [result isSelect not and: [result rowsAffected = 0]]! !
 
-!JdmMysqlDeleteTestCase methodsFor: 'tests'!
+!DBIMySQLDeleteTestCase methodsFor: 'tests'!
 
 deleteRows
  | result |
  Transcript
  show: 'Deleting ' , testSupport class numRowsToInsert printString , ' rows...'.
- result := connection createStatement
- executeQuery: 'delete from ' , testSupport class tableName.
+ result := connection do: 'delete from ' , testSupport class tableName.
  Transcript show: ' Done'; nl.
  "Value is either 0 or numRowsToInsert, depending on the version"
- self should: [result type = #update]! !
+ self should: [result isSelect not] ! !
 
-!JdmMysqlInsertTestCase methodsFor: 'tests'!
+!DBIMySQLInsertTestCase methodsFor: 'tests'!
 
 insertRow
  | result |
- result := connection createStatement
- executeQuery: testSupport insertIntoTable.
+ result := connection do: testSupport insertIntoTable.
  testProgress nextStep.
  ^result!
 
@@ -175,21 +165,20 @@ insertRows
  ok := true.
  testSupport class numRowsToInsert timesRepeat: [
  result := self insertRow.
- ok := ok and: [result type = #update "and: [result value = 1]"].
+ ok := ok and: [result isSelect not "and: [result rowsAffected = 1]"].
  ].
  self should: [ ok ]! !
 
-!JdmMysqlSelectTestCase methodsFor: 'tests'!
+!DBIMySQLSelectTestCase methodsFor: 'tests'!
 
-checkResult: aResult
- | resultSet count numColumns |
- resultSet := aResult value.
- self should: [resultSet isNil not].
+checkResult: resultSet
+ | count numColumns row |
  count := 0.
  numColumns := resultSet columns size.
- [resultSet next] whileTrue:
- [1 to: numColumns
- do: [:columnNum | (resultSet valueAt: columnNum) printString].
+ [resultSet atEnd] whileFalse:
+ [row := resultSet next.
+ 1 to: numColumns
+ do: [:columnNum | (row atIndex: columnNum) printString].
  count := count + 1.
  testProgress nextStep].
  ^count!
@@ -198,13 +187,12 @@ selectRows
  | result |
  Transcript
  show: 'Selecting ' , testSupport class numRowsToInsert printString, ' rows'.
- result := connection createStatement
- executeQuery: 'select * from ' , testSupport class tableName.
+ result := connection select: 'select * from ' , testSupport class tableName.
  self should:
- [result type = #read
+ [result isSelect
  and: [(self checkResult: result) = testSupport class numRowsToInsert]]! !
 
-!JdmMysqlTestSupport methodsFor: 'private'!
+!DBIMySQLTestSupport methodsFor: 'private'!
 
 createDelimitedStringFor: aCollection delimiter: aDelimiter using: aBlock
  | collection writeStream |
@@ -230,7 +218,7 @@ enumValues
  using: [:enumValue | '''' , enumValue , '''']!
 
 fieldNameFor: aType
- ^'Jdm' , aType!
+ ^'test_' , aType!
 
 getFieldDefinitionFor: aType
  | writeStream |
@@ -247,9 +235,9 @@ writeFieldDefinitionFor: aType on: aWrit
  nextPut: $ ;
  nextPutAll: (mysqlTypes at: aType)! !
 
-!JdmMysqlTestSupport methodsFor: 'accessing'!
+!DBIMySQLTestSupport methodsFor: 'accessing'!
 
-connectionSpec
+connect
  | user password db isUser |
  user := TestSuitesScripter variableAt: 'mysqluser' ifAbsent: [ nil ].
  isUser := user notNil.
@@ -258,14 +246,10 @@ connectionSpec
     isUser ifTrue: [ nil ] ifFalse: [ 'root' ] ].
  db := TestSuitesScripter variableAt: 'mysqldb' ifAbsent: [ 'test' ].
 
- ^JdmConnectionSpec new
- initialize;
- user: user;
- password: password;
- host: 'localhost';
- database: db;
- port: 3306;
- yourself!
+ ^DBI.Connection
+ connect: 'dbi:MySQL:dbname=', db
+ user: user
+ password: password!
 
 createTable
  ^self createTableNamed: self class tableName!
@@ -312,12 +296,12 @@ insertIntoTableNamed: aName
  [:type |
  | valueSelector |
  valueSelector := mysqlValues at: type ifAbsent: #null.
- JdmFieldConverter fieldConverter
+ MySQLColumnInfo
  convertToMysql: ((self perform: valueSelector) value: type value: self)]);
  nextPut: $).
  ^writeStream contents! !
 
-!JdmMysqlTestSupport methodsFor: 'private-values'!
+!DBIMySQLTestSupport methodsFor: 'private-values'!
 
 charValue
  ^[:type :support | 'Z' ]!
@@ -325,8 +309,9 @@ charValue
 dateTimeValue
  ^
  [:type :support |
- JdmDateTime fromDate: (support dateValue value: #date value: support)
- andTime: (support timeValue value: #time value: support)]!
+ DateTime fromDays: (support dateValue value: #date value: support) days
+ seconds: (support timeValue value: #time value: support) seconds
+ offset: Duration zero ]!
 
 dateValue
  ^[:type :support | Date fromDays: (support nextRandomFor: type)]!
@@ -355,7 +340,7 @@ timestampValue
 timeValue
  ^[:type :support | Time fromSeconds: (support nextRandomFor: type)]! !
 
-!JdmMysqlTestSupport methodsFor: 'private-initialize'!
+!DBIMySQLTestSupport methodsFor: 'private-initialize'!
 
 initializeEnumSetValues
  enumSetValues add: 'Apples'.
@@ -458,38 +443,38 @@ initializeMysqlValues
 
 initializeRandomGenerators
  randomGenerators
- at: #tinyInt put: (JdmRangedRandom between: -128 and: 127);
- at: #tinyIntUnsigned put: (JdmRangedRandom between: 0 and: 255);
+ at: #tinyInt put: (RangedRandom between: -128 and: 127);
+ at: #tinyIntUnsigned put: (RangedRandom between: 0 and: 255);
  at: #tinyIntZerofill put: (randomGenerators at: #tinyInt);
  at: #tinyIntUnsignedZerofill
  put: (randomGenerators at: #tinyIntUnsigned);
 
- at: #smallInt put: (JdmRangedRandom between: -32768 and: 32767);
- at: #smallIntUnsigned put: (JdmRangedRandom between: 0 and: 65535);
+ at: #smallInt put: (RangedRandom between: -32768 and: 32767);
+ at: #smallIntUnsigned put: (RangedRandom between: 0 and: 65535);
  at: #smallIntZerofill put: (randomGenerators at: #smallInt);
  at: #smallIntUnsignedZerofill put: (randomGenerators at: #smallIntUnsigned);
 
- at: #mediumInt put: (JdmRangedRandom between: -8388608 and: 8388607);
- at: #mediumIntUnsigned put: (JdmRangedRandom between: 0 and: 16777215);
+ at: #mediumInt put: (RangedRandom between: -8388608 and: 8388607);
+ at: #mediumIntUnsigned put: (RangedRandom between: 0 and: 16777215);
  at: #mediumIntZerofill put: (randomGenerators at: #mediumInt);
  at: #mediumIntUnsignedZerofill put: (randomGenerators at: #mediumIntUnsigned);
 
- at: #int put: (JdmRangedRandom between: -2147483648 and: 2147483647);
- at: #intUnsigned put: (JdmRangedRandom between: 0 and: 4294967295);
+ at: #int put: (RangedRandom between: -2147483648 and: 2147483647);
+ at: #intUnsigned put: (RangedRandom between: 0 and: 4294967295);
  at: #intZerofill put: (randomGenerators at: #int);
  at: #intUnsignedZerofill put: (randomGenerators at: #intUnsigned);
 
- at: #bigInt put: (JdmRangedRandom between: -9223372036854775808 and: 9223372036854775807);
- at: #bigIntUnsigned put: (JdmRangedRandom between: 0 and:  18446744073709551615);
+ at: #bigInt put: (RangedRandom between: -9223372036854775808 and: 9223372036854775807);
+ at: #bigIntUnsigned put: (RangedRandom between: 0 and:  18446744073709551615);
  at: #bigIntZerofill put: (randomGenerators at: #bigInt);
  at: #bigIntUnsignedZerofill put: (randomGenerators at: #bigIntUnsigned);
 
- at: #date put: (JdmRangedRandom between: -329083 and:  2958098);
- at: #time put: (JdmRangedRandom between: 0 and: 86399);
- at: #enum put: (JdmRangedRandom between: 1 and: 5);
+ at: #date put: (RangedRandom between: -329083 and:  2958098);
+ at: #time put: (RangedRandom between: 0 and: 86399);
+ at: #enum put: (RangedRandom between: 1 and: 5);
  at: #set put: (randomGenerators at: #enum)! !
 
-!JdmMysqlTestSupport methodsFor: 'initialize-release'!
+!DBIMySQLTestSupport methodsFor: 'initialize-release'!
 
 initialize
  randomGenerators := IdentityDictionary new.
@@ -503,7 +488,7 @@ initialize
  initializeMysqlTypes! !
 
 
-!JdmMysqlTestSupport class methodsFor: 'singleton'!
+!DBIMySQLTestSupport class methodsFor: 'singleton'!
 
 mysqlTestSupport
  Instance isNil ifTrue: [Instance := self new initialize].
@@ -512,15 +497,15 @@ mysqlTestSupport
 resetMysqlTestSupport
  Instance := nil! !
 
-!JdmMysqlTestSupport class methodsFor: 'constants'!
+!DBIMySQLTestSupport class methodsFor: 'constants'!
 
 numRowsToInsert
  ^40!
 
 tableName
- ^'JdmMysqlTestTable'! !
+ ^'DBIMySQLTestTable'! !
 
-!JdmRangedRandom methodsFor: 'initialize'!
+!RangedRandom methodsFor: 'initialize'!
 
 between: anInteger and: anInteger2
  random := Random new.
@@ -530,7 +515,7 @@ between: anInteger and: anInteger2
  range > 0 ifTrue: [range := range + 1].
  numRandomBits := self randomBitsNeededFor: range! !
 
-!JdmRangedRandom methodsFor: 'accessing'!
+!RangedRandom methodsFor: 'accessing'!
 
 next
  | aRandom |
@@ -538,7 +523,7 @@ next
  aRandom = 0 ifTrue: [(self rangeIncludes: 0) ifFalse: [^self next]].
  ^lowValue + aRandom! !
 
-!JdmRangedRandom methodsFor: 'private'!
+!RangedRandom methodsFor: 'private'!
 
 maskFor: numBits
  ^(self class randomMask bitShift: numBits - self class randomBits)
@@ -566,7 +551,7 @@ rangeIncludes: aValue
  ^(highValue >= aValue and: [lowValue <= aValue])! !
 
 
-!JdmRangedRandom class methodsFor: 'constants'!
+!RangedRandom class methodsFor: 'constants'!
 
 randomBits
  ^16!
@@ -577,12 +562,12 @@ randomFactor
 randomMask
  ^16rFFFF! !
 
-!JdmRangedRandom class methodsFor: 'instance creation'!
+!RangedRandom class methodsFor: 'instance creation'!
 
 between: anInteger and: anInteger2
  ^self new between: anInteger and: anInteger2! !
 
-!JdmTestProgress methodsFor: 'initialize-release'!
+!TestProgress methodsFor: 'initialize-release'!
 
 initialize: aNumSteps
  numSteps := aNumSteps.
@@ -592,7 +577,7 @@ initialize: aNumSteps
  currentStep := 0.
  displayCharacter := self class defaultDisplayCharacter! !
 
-!JdmTestProgress methodsFor: 'private'!
+!TestProgress methodsFor: 'private'!
 
 checkSteps
  currentStep >= stepsPerLevel
@@ -606,7 +591,7 @@ checkSteps
  [Transcript
  show: ' Done'; nl]! !
 
-!JdmTestProgress methodsFor: 'accessing'!
+!TestProgress methodsFor: 'accessing'!
 
 currentStep
  ^currentStep!
@@ -635,12 +620,12 @@ totalSteps
  ^totalSteps! !
 
 
-!JdmTestProgress class methodsFor: 'instance creation'!
+!TestProgress class methodsFor: 'instance creation'!
 
 new: aNumSteps
  ^self new initialize: aNumSteps! !
 
-!JdmTestProgress class methodsFor: 'defaults'!
+!TestProgress class methodsFor: 'defaults'!
 
 defaultDisplayCharacter
  ^$.!
@@ -648,319 +633,21 @@ defaultDisplayCharacter
 defaultResolution
  ^20! !
 
-!JdmMysqlTestSuite methodsFor: 'initialize-release'!
+!DBIMySQLTestSuite methodsFor: 'initialize-release'!
 
 initialize
 " super initialize."
- self name: 'JdmMysql-Test'.
- self addTest: (JdmMysqlDropTableTestCase selector: #dropTableIfExists).
- self addTest: (JdmMysqlCreateTableTestCase selector: #createTable).
- self addTest: (JdmMysqlInsertTestCase selector: #insertRows).
- self addTest: (JdmMysqlSelectTestCase selector: #selectRows).
- self addTest: (JdmMysqlDeleteTestCase selector: #deleteRows).
- self addTest: (JdmMysqlDropTableTestCase selector: #dropTable).
+ self name: 'DBIMySQL-Test'.
+ self addTest: (DBIMySQLDropTableTestCase selector: #dropTableIfExists).
+ self addTest: (DBIMySQLCreateTableTestCase selector: #createTable).
+ self addTest: (DBIMySQLInsertTestCase selector: #insertRows).
+ self addTest: (DBIMySQLSelectTestCase selector: #selectRows).
+ self addTest: (DBIMySQLDeleteTestCase selector: #deleteRows).
+ self addTest: (DBIMySQLDropTableTestCase selector: #dropTable).
  Transcript nl! !
 
-!JdmMysqlTestSuite class methodsFor: 'instance creation'!
+!DBIMySQLTestSuite class methodsFor: 'instance creation'!
 
 suite
  ^super new initialize! !
 
-!JdmMysqlTestSupport methodsFor: 'private'!
-
-createDelimitedStringFor: aCollection delimiter: aDelimiter using: aBlock
- | collection writeStream |
- collection := aCollection asOrderedCollection.
- collection size = 0 ifTrue: [^''].
- writeStream := WriteStream on: String new.
- writeStream nextPutAll: (aBlock value: collection first).
- 2 to: collection size
- do:
- [:index |
- writeStream
- nextPutAll: aDelimiter;
- nextPutAll: (aBlock value: (collection at: index))].
- ^writeStream contents!
-
-enumSetValues
- ^enumSetValues!
-
-enumValues
- ^self
- createDelimitedStringFor: self enumSetValues
- delimiter: ', '
- using: [:enumValue | '''' , enumValue , '''']!
-
-fieldNameFor: aType
- ^'Jdm' , aType!
-
-getFieldDefinitionFor: aType
- | writeStream |
- writeStream := WriteStream on: String new.
- self writeFieldDefinitionFor: aType on: writeStream.
- ^writeStream contents!
-
-nextRandomFor: aType
- ^(randomGenerators at: aType) next!
-
-writeFieldDefinitionFor: aType on: aWriteStream
- aWriteStream
- nextPutAll: (self fieldNameFor: aType);
- nextPut: $ ;
- nextPutAll: (mysqlTypes at: aType)! !
-
-!JdmMysqlTestSupport methodsFor: 'accessing'!
-
-createTable
- ^self createTableNamed: self class tableName!
-
-createTableNamed: aName
- | writeStream |
- writeStream := WriteStream on: String new.
- writeStream
- nextPutAll: 'CREATE TABLE ';
- nextPutAll: aName;
- nextPut: $(;
- nl.
- writeStream nextPutAll: (self
- createDelimitedStringFor: mysqlTypes keys
- delimiter: ', '
- using: [:field | self getFieldDefinitionFor: field]).
- ^writeStream
- nextPut: $);
- contents!
-
-insertIntoTable
- ^self insertIntoTableNamed: self class tableName!
-
-insertIntoTableNamed: aName
- | writeStream |
- writeStream := WriteStream on: String new.
- writeStream
- nextPutAll: 'INSERT INTO ';
- nextPutAll: aName;
- nextPutAll: ' (';
- nl.
- writeStream nextPutAll: (self
- createDelimitedStringFor: mysqlTypes keys
- delimiter: ', '
- using: [:field | self fieldNameFor: field]).
- writeStream
- nextPutAll: ') VALUES (';
- nl.
- writeStream
- nextPutAll: (self
- createDelimitedStringFor: mysqlTypes keys
- delimiter: ', '
- using:
- [:type |
- | valueSelector |
- valueSelector := mysqlValues at: type ifAbsent: #null.
- JdmFieldConverter fieldConverter
- convertToMysql: ((self perform: valueSelector) value: type value: self)]);
- nextPut: $).
- ^writeStream contents! !
-
-!JdmMysqlTestSupport methodsFor: 'private-values'!
-
-charValue
- ^[:type :support | 'Z' ]!
-
-dateTimeValue
- ^
- [:type :support |
- JdmDateTime fromDate: (support dateValue value: #date value: support)
- andTime: (support timeValue value: #time value: support)]!
-
-dateValue
- ^[:type :support | Date fromDays: (support nextRandomFor: type)]!
-
-doubleValue
- ^[:type :support | 1.7976931348623d308 ]!
-
-enumValue
- ^[:type :support | support enumSetValues at: (support nextRandomFor: type)]!
-
-floatValue
- ^[:type :support | 3.402823466e38 ]!
-
-intValue
- ^[:type :support | support nextRandomFor: type]!
-
-null
- ^[:type :support | 'NULL' ]!
-
-stringValue
- ^[:type :support | 'This is a String with UPPER and lower CaSeS' ]!
-
-timestampValue
- ^[:type :support | DateTime now]!
-
-timeValue
- ^[:type :support | Time fromSeconds: (support nextRandomFor: type)]! !
-
-!JdmMysqlTestSupport methodsFor: 'private-initialize'!
-
-initializeEnumSetValues
- enumSetValues add: 'Apples'.
- enumSetValues add: 'Bananas'.
- enumSetValues add: 'Grapes'.
- enumSetValues add: 'Oranges'.
- enumSetValues add: 'Peaches'.!
-
-initializeMysqlTypes
- mysqlTypes
- at: #tinyInt put: 'TINYINT';
- at: #tinyIntUnsigned put: 'TINYINT UNSIGNED';
- at: #tinyIntZerofill put: 'TINYINT ZEROFILL';
- at: #tinyIntUnsignedZerofill put: 'TINYINT UNSIGNED ZEROFILL';
-
- at: #smallInt put: 'SMALLINT';
- at: #smallIntUnsigned put: 'SMALLINT UNSIGNED';
- at: #smallIntZerofill put: 'SMALLINT ZEROFILL';
- at: #smallIntUnsignedZerofill put: 'SMALLINT UNSIGNED ZEROFILL';
-
- at: #mediumInt put: 'MEDIUMINT';
- at: #mediumIntUnsigned put: 'MEDIUMINT UNSIGNED';
- at: #mediumIntZerofill put: 'MEDIUMINT ZEROFILL';
- at: #mediumIntUnsignedZerofill put: 'MEDIUMINT UNSIGNED ZEROFILL';
-
- at: #int put: 'INT';
- at: #intUnsigned put: 'INT UNSIGNED';
- at: #intZerofill put: 'INT ZEROFILL';
- at: #intUnsignedZerofill put: 'INT UNSIGNED ZEROFILL';
-
- at: #bigInt put: 'BIGINT';
- at: #bigIntUnsigned put: 'BIGINT UNSIGNED';
- at: #bigIntZerofill put: 'BIGINT ZEROFILL';
- at: #bigIntUnsignedZerofill put: 'BIGINT UNSIGNED ZEROFILL';
-
- at: #float put: 'FLOAT(4)';
- at: #double put: 'FLOAT(8)';
- at: #decimal put: 'DECIMAL(10, 5)';
- at: #date put: 'DATE';
- at: #time put: 'TIME';
- at: #dateTime put: 'DATETIME';
- at: #timestamp put: 'TIMESTAMP';
- at: #char put: 'CHAR';
- at: #varChar put: 'VARCHAR(70)';
- at: #tinyBlob put: 'TINYBLOB';
- at: #blob put: 'BLOB';
- at: #mediumBlob put: 'MEDIUMBLOB';
- at: #longBlob put: 'LONGBLOB';
- at: #tinyText put: 'TINYTEXT';
- at: #text put: 'TEXT';
- at: #mediumText put: 'MEDIUMTEXT';
- at: #enum put: 'ENUM(', self enumValues, ')';
- at: #set put: 'SET(', self enumValues, ')'!
-
-initializeMysqlValues
- mysqlValues
- at: #tinyInt put: #intValue;
- at: #tinyIntUnsigned put: #intValue;
- at: #tinyIntZerofill put: #intValue;
- at: #tinyIntUnsignedZerofill put: #intValue;
-
- at: #smallInt put: #intValue;
- at: #smallIntUnsigned put: #intValue;
- at: #smallIntZerofill put: #intValue;
- at: #smallIntUnsignedZerofill put: #intValue;
-
- at: #mediumInt put: #intValue;
- at: #mediumIntUnsigned put: #intValue;
- at: #mediumIntZerofill put: #intValue;
- at: #mediumIntUnsignedZerofill put: #intValue;
-
- at: #int put: #intValue;
- at: #intUnsigned put: #intValue;
- at: #intZerofill put: #intValue;
- at: #intUnsignedZerofill put: #intValue;
-
- at: #bigInt put: #intValue;
- at: #bigIntUnsigned put: #intValue;
- at: #bigIntZerofill put: #intValue;
- at: #bigIntUnsignedZerofill put: #intValue;
-
- at: #float put: #floatValue;
- at: #double put: #doubleValue;
- at: #decimal put: #doubleValue;
- at: #date put: #dateValue;
- at: #time put: #timeValue;
- at: #timestamp put: #timestampValue;
- at: #dateTime put: #dateTimeValue;
- at: #char put: #charValue;
- at: #varChar put: #stringValue;
- at: #tinyBlob put: #stringValue;
- at: #blob put: #stringValue;
- at: #mediumBlob put: #stringValue;
- at: #longBlob put: #stringValue;
- at: #tinyText put: #stringValue;
- at: #text put: #stringValue;
- at: #mediumText put: #stringValue;
- at: #enum put: #enumValue;
- at: #set put: #enumValue!
-
-initializeRandomGenerators
- randomGenerators
- at: #tinyInt put: (JdmRangedRandom between: -128 and: 127);
- at: #tinyIntUnsigned put: (JdmRangedRandom between: 0 and: 255);
- at: #tinyIntZerofill put: (randomGenerators at: #tinyInt);
- at: #tinyIntUnsignedZerofill
- put: (randomGenerators at: #tinyIntUnsigned);
-
- at: #smallInt put: (JdmRangedRandom between: -32768 and: 32767);
- at: #smallIntUnsigned put: (JdmRangedRandom between: 0 and: 65535);
- at: #smallIntZerofill put: (randomGenerators at: #smallInt);
- at: #smallIntUnsignedZerofill put: (randomGenerators at: #smallIntUnsigned);
-
- at: #mediumInt put: (JdmRangedRandom between: -8388608 and: 8388607);
- at: #mediumIntUnsigned put: (JdmRangedRandom between: 0 and: 16777215);
- at: #mediumIntZerofill put: (randomGenerators at: #mediumInt);
- at: #mediumIntUnsignedZerofill put: (randomGenerators at: #mediumIntUnsigned);
-
- at: #int put: (JdmRangedRandom between: -2147483648 and: 2147483647);
- at: #intUnsigned put: (JdmRangedRandom between: 0 and: 4294967295);
- at: #intZerofill put: (randomGenerators at: #int);
- at: #intUnsignedZerofill put: (randomGenerators at: #intUnsigned);
-
- at: #bigInt put: (JdmRangedRandom between: -9223372036854775808 and: 9223372036854775807);
- at: #bigIntUnsigned put: (JdmRangedRandom between: 0 and:  18446744073709551615);
- at: #bigIntZerofill put: (randomGenerators at: #bigInt);
- at: #bigIntUnsignedZerofill put: (randomGenerators at: #bigIntUnsigned);
-
- at: #date put: (JdmRangedRandom between: -329083 and:  2958098);
- at: #time put: (JdmRangedRandom between: 0 and: 86399);
- at: #enum put: (JdmRangedRandom between: 1 and: 5);
- at: #set put: (randomGenerators at: #enum)! !
-
-!JdmMysqlTestSupport methodsFor: 'initialize-release'!
-
-initialize
- randomGenerators := IdentityDictionary new.
- mysqlValues := IdentityDictionary new.
- enumSetValues := OrderedCollection new.
- mysqlTypes := IdentityDictionary new.
- self
- initializeEnumSetValues;
- initializeRandomGenerators;
- initializeMysqlValues;
- initializeMysqlTypes! !
-
-
-!JdmMysqlTestSupport class methodsFor: 'singleton'!
-
-mysqlTestSupport
- Instance isNil ifTrue: [Instance := self new initialize].
- ^Instance!
-
-resetMysqlTestSupport
- Instance := nil! !
-
-!JdmMysqlTestSupport class methodsFor: 'constants'!
-
-numRowsToInsert
- ^40!
-
-tableName
- ^'JdmMysqlTestTable'! !
-


--- orig/packages/mysql/package.xml
+++ mod/packages/dbd-mysql/package.xml
@@ -1,19 +1,27 @@
 <package>
-  <name>MySQL</name>
-  <namespace>Jdm.MySQL</namespace>
-  <prereq>DB</prereq>
+  <name>DBD-MySQL</name>
+  <namespace>DBI.MySQL</namespace>
+  <prereq>DBI</prereq>
   <prereq>TCP</prereq>
-  <prereq>SUnit</prereq>
   <prereq>Digest</prereq>
-  <filein>MySQL.st</filein>
+
+  <filein>Column.st</filein>
+  <filein>Connection.st</filein>
+  <filein>Extensions.st</filein>
+  <filein>ResultSet.st</filein>
+  <filein>Row.st</filein>
+  <filein>Statement.st</filein>
 
   <test>
-    <sunit>Jdm.MySQL.JdmMysqlTestSuite</sunit>
+    <sunit>DBI.MySQL.DBIMySQLTestSuite</sunit>
     <filein>MySQLTests.st</filein>
   </test>
 
-  <file>MySQL.st</file>
+  <file>Column.st</file>
+  <file>Connection.st</file>
+  <file>Extensions.st</file>
   <file>MySQLTests.st</file>
-  <file>mysql-test.st</file>
-  <file>README</file>
+  <file>ResultSet.st</file>
+  <file>Row.st</file>
+  <file>Statement.st</file>
 </package>


--- orig/packages/glorp/Glorp.st
+++ mod/packages/glorp/Glorp.st
@@ -7286,7 +7286,7 @@ postCopy! !
 !DatabaseAccessor class methodsFor: 'instance creation'!
 
 classForThisPlatform
-    Dialect isGNU ifTrue: [^Smalltalk Glorp JdmDatabaseAccessor].
+    Dialect isGNU ifTrue: [^Smalltalk Glorp DBIDatabaseAccessor].
     Dialect isSqueak ifTrue: [^Dialect smalltalkAt: #SqueakDatabaseAccessor].
     Dialect isVisualWorks ifTrue: [^Dialect smalltalkAt: #'Glorp.VWDatabaseAccessor'].
     Dialect isVisualAge ifTrue: [^Dialect smalltalkAt: #VA55DatabaseAccessor].


--- orig/packages/glorp/GlorpMySQL.st
+++ mod/packages/glorp/GlorpMySQL.st
@@ -31,7 +31,7 @@ DelegatingDatabaseConverter subclass: #M
     poolDictionaries: ''
     category: 'Glorp-MySQL'!
 
-DatabaseAccessor subclass: #JdmDatabaseAccessor
+DatabaseAccessor subclass: #DBIDatabaseAccessor
     instanceVariableNames: 'isInTransaction'
     classVariableNames: ''
     poolDictionaries: ''
@@ -95,26 +95,23 @@ convert: anObject toDatabaseRepresentati
 
 
 
-!JdmDatabaseAccessor methodsFor: 'login'!
+!DBIDatabaseAccessor methodsFor: 'login'!
 
 loginIfError: aBlock
-    | spec |
     self logging
  ifTrue: [self log: 'Login'].
 
-    spec := (Jdm.JdmConnectionSpec new initialize
-        user: currentLogin username;
-     password: currentLogin password;
-        database: currentLogin connectString).
-
-    isInTransaction := false.
-    self doCommand: [connection := self connectionClass on: spec] ifError: aBlock.
+    isInTransaction := 0.
+    self doCommand: [ connection := DBI.Connection
+        connect: currentLogin connectString
+     user: currentLogin username
+     password: currentLogin password ] ifError: aBlock.
     self logging
  ifTrue: [self log: 'Login finished']!
 
 connectionClassForLogin: aLogin
-    aLogin database class == MySQLPlatform
-     ifTrue: [^Jdm.MySQL.JdmConnection].
+    ('dbi:*' match: aLogin connectString)
+     ifTrue: [^DBI.Connection].
     self error: 'Unknown database: ' , aLogin database name!
 
 logout
@@ -128,7 +125,7 @@ isLoggedIn
 
     ^connection notNil! !
 
-!JdmDatabaseAccessor methodsFor: 'executing'!
+!DBIDatabaseAccessor methodsFor: 'executing'!
 
 disconnect
     connection close!
@@ -137,71 +134,61 @@ dropConstraint: aConstraint
 !
 
 dropTableNamed: aString
-    self executeSQLString: 'DROP TABLE IF EXISTS ' , aString!
+    self doCommand: [self executeSQLString: 'DROP TABLE ' , aString]
+        ifError: []!
 
 dropTableNamed: aString ifAbsent: aBlock
     self doCommand: [self executeSQLString: 'DROP TABLE ' , aString]
         ifError: aBlock!
 
 executeSQLString: aString
-    | statement result resultSet rows row numColumns |
-    statement := connection createStatement.
-    result := statement executeQuery: aString.
-    result type = #read ifFalse: [ ^#() ].
+    | resultSet rows numColumns |
+    resultSet := connection do: aString.
+    resultSet isSelect ifFalse: [ ^#() ].
     self logging ifTrue: [ self log: aString ].
 
     "Optimize the cases of 0 returned rows."
-    resultSet := result value.
-    resultSet next ifFalse: [ ^#() ].
+    resultSet rowCount = 0 ifTrue: [ ^#() ].
 
-    numColumns := resultSet columns size.
-    rows := (Array new: 1) writeStream.
-    [row := self fetchRowFrom: resultSet numColumns: numColumns.
-     rows nextPut: row.
-     resultSet next] whileTrue.
-
-    ^rows contents!
-
-fetchRowFrom: resultSet numColumns: numColumns
-    | row |
-    row := Array new: numColumns.
-        1 to: numColumns
-                do: [:i | row at: i put: (resultSet valueAt: i)].
-    ^row!
+    numColumns := resultSet columnCount.
+    rows := Array new: resultSet rowCount.
+    1 to: rows size do: [ :i |
+        rows at: i put: (self fetchValuesFrom: resultSet next) ].
+
+    ^rows!
+
+fetchValuesFrom: row
+    | array |
+    array := Array new: row columnCount.
+    1 to: row columnCount
+            do: [:i | array at: i put: (row atIndex: i)].
+    ^array!
 
-!JdmDatabaseAccessor methodsFor: 'transactions'!
+!DBIDatabaseAccessor methodsFor: 'transactions'!
 
 commitTransaction
 
     self logging ifTrue:
      [self log: 'Commit Transaction'].
-    self executeSQLString: 'COMMIT'.
-    isInTransaction := false!
+    connection commitTransaction.
+    isInTransaction > 0 ifTrue: [ isInTransaction := isInTransaction - 1 ]!
 
 isInTransaction
 
-    ^isInTransaction!
+    ^isInTransaction > 0!
 
 rollbackTransaction
     self logging ifTrue:
      [self log: 'Rollback Transaction'].
-    self executeSQLString: 'ROLLBACK'.
-    isInTransaction := false!
+    connection rollbackTransaction.
+    isInTransaction > 0 ifTrue: [ isInTransaction := isInTransaction - 1 ]!
 
 beginTransaction
     self logging ifTrue:
      [self log: 'Begin Transaction'].
-    self executeSQLString: 'START TRANSACTION'.
-    isInTransaction := true! !
-
-
-!Jdm.MySQL.JdmDateTime methodsFor: 'glorp'!
+    connection beginTransaction.
+    isInTransaction := isInTransaction + 1! !
 
-asTimestamp
-    ^DateTime
-        fromDays: self date daysFromBaseDay
-        seconds: self time asSeconds
-        offset: Duration zero! !
 
 
 !MySQLPlatform class methodsFor: 'LICENSE'!


--- orig/packages/glorp/GlorpTest.st
+++ mod/packages/glorp/GlorpTest.st
@@ -2233,7 +2233,7 @@ defaultMysqlLogin
      database: MySQLPlatform new;
  username: user;
  password: password;
- connectString: db! !
+ connectString: 'dbi:MySQL:dbname=', db! !
 
 !GlorpDatabaseLoginResource class methodsFor: 'LICENSE'!
 


--- orig/packages/glorp/package.xml
+++ mod/packages/glorp/package.xml
@@ -1,6 +1,6 @@
 <package>
   <name>Glorp</name>
-  <prereq>MySQL</prereq>
+  <prereq>DBD-MySQL</prereq>
   <prereq>SUnit</prereq>
 
   <namespace>Glorp</namespace>



* added files

--- /dev/null
+++ mod/packages/dbd-mysql/Column.st
@@ -0,0 +1,591 @@
+"=====================================================================
+|
+|   MySQL DBI driver - ColumnInfo class
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2002 Josh Miller
+| Written by Josh Miller, ported by Markus Fritsche,
+| refactored/rewritten by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library 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 Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+ColumnInfo subclass: #MySQLColumnInfo
+ instanceVariableNames: 'table name size type flags decimalPlaces charset index '
+ classVariableNames: 'Types ConverterSelectors TypeNames'
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+!MySQLColumnInfo methodsFor: 'testing'!
+
+hasFlag: aFlag
+ ^(self flags bitAnd: aFlag) > 0!
+
+isAutoIncrement
+ ^self hasFlag: self class autoIncrementFlag!
+
+isBinary
+ ^self hasFlag: self class binaryFlag!
+
+isBlob
+ ^self hasFlag: self class blobFlag!
+
+isEnumeration
+ ^self hasFlag: self class enumFlag!
+
+isMultipleKey
+ ^self hasFlag: self class multipleKeyFlag!
+
+isNotNull
+ ^self hasFlag: self class notNullFlag!
+
+isPrimaryKey
+ ^self hasFlag: self class primaryKeyFlag!
+
+isTimestamp
+ ^self hasFlag: self class timestampFlag!
+
+isUniqueKey
+ ^self hasFlag: self class uniqueKeyFlag!
+
+isZerofill
+ ^self hasFlag: self class zerofillFlag! !
+
+!MySQLColumnInfo methodsFor: 'accessing'!
+
+decimalPlaces
+ ^decimalPlaces!
+
+flags
+ ^flags!
+
+index
+ ^index!
+
+name
+ ^name!
+
+size
+ ^size!
+
+table
+ ^table!
+
+type
+ ^TypeNames at: type! !
+
+!MySQLColumnInfo class methodsFor: 'converting-smalltalk'!
+
+writeBoolean: aBoolean on: aStream
+ aBoolean
+ ifTrue: [ aStream nextPutAll: 'True' ]
+ ifFalse: [ aStream nextPutAll: 'False' ]!
+
+writeDate: aDate on: aStream
+ self printMysqlDate: aDate on: aStream!
+
+writeDouble: aDouble on: aStream
+ | readStream character |
+ readStream := ReadStream on: aDouble printString.
+
+ [character := readStream next.
+ character isNil] whileFalse:
+ [character = $d
+ ifTrue:
+ [character := readStream next.
+ character isNil ifTrue: [^self].
+ aStream nextPut: $e.
+ character = $- ifFalse: [aStream nextPut: $+]].
+ aStream nextPut: character]!
+
+writeFloat: aFloat on: aStream
+ | readStream character |
+ readStream := ReadStream on: aFloat printString.
+
+ [character := readStream next.
+ character isNil] whileFalse:
+ [character = $e
+ ifTrue:
+ [aStream nextPut: character.
+ character := readStream next.
+ character = $- ifFalse: [aStream nextPut: $+]].
+ aStream nextPut: character]!
+
+writeMySQLDateTime: aMySQLDateTime on: aStream
+ self writeDate: aMySQLDateTime asDate on: aStream.
+ aStream nextPut: $ .
+ self writeTime: aMySQLDateTime asTime on: aStream!
+
+writeQuotedDate: aDate on: aStream
+ aStream nextPut: $'.
+ self writeDate: aDate on: aStream.
+ aStream nextPut: $'.!
+
+writeQuotedTime: aTime on: aStream
+ aStream nextPut: $'.
+ self writeTime: aTime on: aStream.
+ aStream nextPut: $'.!
+
+writeQuotedTimestamp: aTimestamp on: aStream
+ aStream nextPut: $'.
+ self writeMySQLDateTime: aTimestamp on: aStream.
+ aStream nextPut: $'.!
+
+writeTime: aTime on: aStream
+ self printMysqlTime: aTime on: aStream!
+
+writeTimestamp: aTimestamp on: aStream
+ self printMysqlTimestamp: aTimestamp on: aStream! !
+
+!MySQLColumnInfo methodsFor: 'actions'!
+
+convert: aValue
+ ^self perform: (Types at: type) with: aValue!
+
+!MySQLColumnInfo class methodsFor: 'actions'!
+
+convertToMysql: aValue
+ | writeStream |
+ writeStream := WriteStream on: String new.
+ self convertToMysql: aValue on: writeStream.
+ ^writeStream contents!
+
+convertToMysql: aValue on: aStream
+ | aSelector |
+ aSelector := ConverterSelectors at: aValue class name
+ ifAbsent:
+ [aValue printOn: aStream.
+ ^self].
+ ^self
+ perform: aSelector
+ with: aValue
+ with: aStream! !
+
+!MySQLColumnInfo methodsFor: 'converting'!
+
+toBoolean: aString
+ aString isNil ifTrue: [ ^nil ].
+ ^aString first value = 1!
+
+toByteArray: aString
+ ^self isBinary
+ ifTrue: [aString isNil
+ ifTrue: [nil]
+ ifFalse: [aString asByteArray]]
+ ifFalse: [aString]!
+
+toDate: aString
+ ^self class
+ readDateFrom: (ReadStream on: aString)!
+
+toDateTime: aString
+ ^self class readTimestampFrom: aString readStream!
+
+toDouble: aString
+ | aStream writeStream character |
+ aStream := ReadStream on: aString.
+ writeStream := WriteStream on: String new.
+
+ [character := aStream next.
+ character isNil] whileFalse:
+ [character = $e
+ ifTrue:
+ [writeStream nextPut: $d.
+ character := aStream next.
+ character = $+ ifTrue: [character := aStream next]].
+ writeStream nextPut: character].
+ ^FloatD readFrom: (ReadStream on: writeStream contents)!
+
+toFloat: aString
+ | writeStream character aStream |
+ aStream := ReadStream on: aString.
+ writeStream := WriteStream on: String new.
+
+ [character := aStream next.
+ character isNil]
+ whileFalse: [character = $+ ifFalse: [writeStream nextPut: character]].
+ ^FloatE readFrom: (ReadStream on: writeStream contents)!
+
+toInteger: aString
+ ^Integer readFrom: (ReadStream on: aString)!
+
+toString: aString
+ ^aString!
+
+toTime: aString
+ ^self class
+ readTimeFrom: (ReadStream on: aString)!
+
+toTimestamp: aString
+ ^self class
+ readTimestampFrom: (ReadStream on: aString)! !
+
+!MySQLColumnInfo class methodsFor: 'private-initialize'!
+
+buildConversionMap
+ ConverterSelectors := IdentityDictionary new.
+ ConverterSelectors
+ at: #Boolean put: #writeBoolean:on:;
+ at: #FloatD put: #writeDouble:on:;
+ at: #FloatE put: #writeFloat:on:;
+ at: #Time put: #writeQuotedTime:on:;
+ at: #DateTime put: #writeQuotedTimestamp:on:;
+ at: #Date put: #writeQuotedDate:on:!
+
+buildTypeNameMap
+ TypeNames := Dictionary new.
+ TypeNames
+ at: MySQLColumnInfo bitType put: 'bit';
+ at: MySQLColumnInfo tinyType put: 'tinyint';
+ at: MySQLColumnInfo shortType put: 'smallint';
+ at: MySQLColumnInfo int24Type put: 'mediumint';
+ at: MySQLColumnInfo longType put: 'int';
+ at: MySQLColumnInfo longlongType put: 'bigint';
+ at: MySQLColumnInfo floatType put: 'float(4)';
+ at: MySQLColumnInfo doubleType put: 'float(8)';
+ at: MySQLColumnInfo oldDecimalType put: 'decimal';
+ at: MySQLColumnInfo decimalType put: 'decimal';
+ at: MySQLColumnInfo newDateType put: 'date';
+ at: MySQLColumnInfo dateType put: 'date';
+ at: MySQLColumnInfo datetimeType put: 'datetime';
+ at: MySQLColumnInfo timeType put: 'time';
+ at: MySQLColumnInfo timestampType put: 'timestamp';
+ at: MySQLColumnInfo enumType put: 'enum';
+ at: MySQLColumnInfo setType put: 'set';
+ at: MySQLColumnInfo tinyBlobType put: 'tinyblob';
+ at: MySQLColumnInfo mediumBlobType put: 'mediumblob';
+ at: MySQLColumnInfo longBlobType put: 'longblob';
+ at: MySQLColumnInfo blobType put: 'blob';
+ at: MySQLColumnInfo varCharType put: 'varchar';
+ at: MySQLColumnInfo varStringType put: 'varchar';
+ at: MySQLColumnInfo stringType put: 'string'!
+
+buildTypeMap
+ Types := Dictionary new.
+ Types
+ at: MySQLColumnInfo bitType put: #toBoolean:;
+ at: MySQLColumnInfo tinyType put: #toInteger:;
+ at: MySQLColumnInfo shortType put: #toInteger:;
+ at: MySQLColumnInfo longType put: #toInteger:;
+ at: MySQLColumnInfo int24Type put: #toInteger:;
+ at: MySQLColumnInfo longlongType put: #toInteger:;
+ at: MySQLColumnInfo floatType put: #toFloat:;
+ at: MySQLColumnInfo doubleType put: #toDouble:;
+ at: MySQLColumnInfo oldDecimalType put: #toDouble:;
+ at: MySQLColumnInfo decimalType put: #toDouble:;
+ at: MySQLColumnInfo newDateType put: #toDate:;
+ at: MySQLColumnInfo dateType put: #toDate:;
+ at: MySQLColumnInfo datetimeType put: #toDateTime:;
+ at: MySQLColumnInfo timeType put: #toTime:;
+ at: MySQLColumnInfo timestampType put: #toTimestamp:;
+ at: MySQLColumnInfo enumType put: #toString:;
+ at: MySQLColumnInfo setType put: #toSet:;
+ at: MySQLColumnInfo tinyBlobType put: #toByteArray:;
+ at: MySQLColumnInfo mediumBlobType put: #toByteArray:;
+ at: MySQLColumnInfo longBlobType put: #toByteArray:;
+ at: MySQLColumnInfo blobType put: #toByteArray:;
+ at: MySQLColumnInfo varCharType put: #toString:;
+ at: MySQLColumnInfo varStringType put: #toString:;
+ at: MySQLColumnInfo stringType put: #toString:! !
+
+!MySQLColumnInfo class methodsFor: 'initialize-release'!
+
+initialize
+ self
+ buildTypeMap;
+ buildTypeNameMap;
+ buildConversionMap! !
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+!MySQLColumnInfo class methodsFor: 'reading mysql'!
+
+readDateFrom: aStream
+ | day month year |
+ year := Integer readFrom: aStream.
+ aStream next.
+ month := Integer readFrom: aStream.
+ aStream next.
+ day := Integer readFrom: aStream.
+ ^Date
+ newDay: day
+ monthIndex: month
+ year: year!
+
+readTimeFrom: aStream
+ | hour minute second |
+ hour := Integer readFrom: aStream.
+ aStream next.
+ minute := Integer readFrom: aStream.
+ aStream next.
+ second := Integer readFrom: aStream.
+ ^Time fromSeconds: 60 * (60 * hour + minute) + second!
+
+readTimestampFrom: aStream
+ | year month day hour minute second separators |
+ year := self readIntegerFrom: aStream next: 4.
+ separators := aStream peekFor: $-.
+ month := self readIntegerFrom: aStream next: 2.
+ separators ifTrue: [ aStream next ].
+ day := self readIntegerFrom: aStream next: 2.
+ separators ifTrue: [ aStream next ].
+ hour := self readIntegerFrom: aStream next: 2.
+ separators ifTrue: [ aStream next ].
+ minute := self readIntegerFrom: aStream next: 2.
+ separators ifTrue: [ aStream next ].
+ second := self readIntegerFrom: aStream next: 2.
+ ^DateTime
+ fromDays: (Date newDay: day monthIndex: month year: year) days
+ seconds: (3600 * hour) + (60 * minute) + second
+ offset: Duration zero! !
+
+
+!MySQLColumnInfo class methodsFor: 'private-reading'!
+
+readIntegerFrom: aStream next: anInteger
+ ^Integer readFrom: (ReadStream on: (aStream next: anInteger))! !
+
+!MySQLColumnInfo class methodsFor: 'reading mysql'!
+
+printMysqlDate: aDate on: aStream
+ aDate year printOn: aStream.
+ aStream nextPut: $-.
+ self print: aDate month on: aStream next: 2.
+ aStream nextPut: $-.
+ self print: aDate day on: aStream next: 2!
+
+printMysqlTime: aTime on: aStream
+ self print: aTime hour on: aStream next: 2.
+ aStream nextPut: $:.
+ self print: aTime minute on: aStream next: 2.
+ aStream nextPut: $:.
+ self print: aTime second on: aStream next: 2!
+
+printMysqlTimestamp: aDateTime on: aStream
+ self print: aDateTime year on: aStream next: 4.
+ self print: aDateTime month on: aStream next: 2.
+ self print: aDateTime day on: aStream next: 2.
+ self print: aDateTime hour on: aStream next: 2.
+ self print: aDateTime minute on: aStream next: 2.
+ self print: aDateTime second on: aStream next: 2!
+
+
+!MySQLColumnInfo class methodsFor: 'private-writing'!
+
+print: anInteger on: aStream next: n
+ | str |
+ str := anInteger printString.
+ aStream next: n - str size put: $0.
+ aStream nextPutAll: str! !
+
+
+!MySQLColumnInfo methodsFor: 'reading'!
+
+charset
+ ^charset
+! !
+
+!MySQLColumnInfo methodsFor: 'reading'!
+
+readDecimalPlaces: aReadStream
+ decimalPlaces := aReadStream next asInteger!
+
+readFlags: aReadStream
+ flags := (aReadStream next: 2) asByteArray asInteger!
+
+readFrom: aReadStream index: i
+ | length fields |
+ "can be catalogue, db, table, org table, field (and org field follows)
+ or table, field, length, type, flags+decimal"
+ index := i.
+ fields := (1 to: 5) collect: [ :i |
+ aReadStream next: aReadStream next asInteger ].
+ aReadStream atEnd ifFalse: [
+ table := fields at: 3.
+ name := fields at: 5.
+ "org field"
+ aReadStream next: aReadStream next asInteger.
+ length := aReadStream next asInteger - 10.
+ self
+ readCharset: aReadStream;
+ readSize: aReadStream;
+ readType: aReadStream;
+ readFlags: aReadStream;
+ readDecimalPlaces: aReadStream.
+ aReadStream next: length.
+ ^self ].
+
+ "MySQL 3.x format."
+ table := fields at: 1.
+ name := fields at: 2.
+ size := (fields at: 3) asByteArray asInteger.
+ type := (fields at: 4) first asInteger.
+ self readFlags: (fields at: 5) readStream.
+ decimalPlaces := (fields at: 5) last asInteger!
+
+
+readCharset: aReadStream
+ charset := (aReadStream next: 2) asByteArray asInteger!
+
+readName: aReadStream
+ name := (aReadStream next: aReadStream next asInteger)!
+
+readSize: aReadStream
+ size := (aReadStream next: 4) asByteArray asInteger!
+
+readTable: aReadStream
+ table := (aReadStream next: aReadStream next asInteger)!
+
+readType: aReadStream
+ type := aReadStream next asInteger! !
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+MySQLColumnInfo class
+ instanceVariableNames: ''!
+
+
+!MySQLColumnInfo class methodsFor: 'constants-types'!
+
+bitType
+ ^16!
+
+blobType
+ ^252!
+
+datetimeType
+ ^12!
+
+newDateType
+ ^14!
+
+dateType
+ ^10!
+
+oldDecimalType
+ ^0!
+
+decimalType
+ ^246!
+
+doubleType
+ ^5!
+
+enumType
+ ^247!
+
+floatType
+ ^4!
+
+int24Type
+ ^9!
+
+longBlobType
+ ^251!
+
+longlongType
+ ^8!
+
+longType
+ ^3!
+
+mediumBlobType
+ ^250!
+
+newDateType
+ ^14!
+
+nullType
+ ^6!
+
+setType
+ ^248!
+
+shortType
+ ^2!
+
+stringType
+ ^254!
+
+timestampType
+ ^7!
+
+timeType
+ ^11!
+
+tinyBlobType
+ ^249!
+
+tinyType
+ ^1!
+
+varCharType
+ ^15!
+
+varStringType
+ ^253!
+
+yearType
+ ^13! !
+
+!MySQLColumnInfo class methodsFor: 'constants-flags'!
+
+autoIncrementFlag
+ ^512!
+
+binaryFlag
+ ^128!
+
+blobFlag
+ ^16!
+
+enumFlag
+ ^256!
+
+multipleKeyFlag
+ ^8!
+
+notNullFlag
+ ^1!
+
+primaryKeyFlag
+ ^2!
+
+timestampFlag
+ ^1024!
+
+uniqueKeyFlag
+ ^4!
+
+unsignedFlag
+ ^32!
+
+zerofillFlag
+ ^64! !
+
+!MySQLColumnInfo class methodsFor: 'instance creation'!
+
+readFrom: aReadStream
+ ^self new readFrom: aReadStream! !
+
+MySQLColumnInfo initialize!
--- /dev/null
+++ mod/packages/dbd-mysql/Connection.st
@@ -0,0 +1,708 @@
+"=====================================================================
+|
+|   MySQL DBI driver - Connection class and related classes
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2002 Josh Miller
+| Written by Josh Miller, ported by Markus Fritsche,
+| refactored/rewritten by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library 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 Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+ReadStream subclass: #MySQLReadStream
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+WriteStream subclass: #MySQLWriteStream
+ instanceVariableNames: 'outputPacket '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+Object subclass: #MySQLPacket
+ instanceVariableNames: 'packetNumber size buffer stream '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+MySQLPacket subclass: #MySQLInputPacket
+ instanceVariableNames: 'readStream '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+MySQLPacket subclass: #MySQLOutputPacket
+ instanceVariableNames: 'writeStream '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+Connection subclass: #MySQLConnection
+ instanceVariableNames: 'socket serverInfo database responsePacket '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+Object subclass: #MySQLServerInfo
+ instanceVariableNames: 'protocol serverThread serverVersion charset status hashSeed options '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+!MySQLReadStream methodsFor: 'accessing'!
+
+readNullTerminatedString
+ ^self upTo: self null asCharacter! !
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+MySQLReadStream class
+ instanceVariableNames: ''!
+
+
+!MySQLReadStream methodsFor: 'constants'!
+
+null
+ ^0! !
+
+!MySQLWriteStream methodsFor: 'mysql-constants'!
+
+cmdConnect
+ ^11!
+
+cmdCreateDatabase
+ ^5!
+
+cmdDebug
+ ^13!
+
+cmdDropDatabase
+ ^6!
+
+cmdFieldList
+ ^4!
+
+cmdInitializeDatabase
+ ^2!
+
+cmdKillProcess
+ ^12!
+
+cmdProcessInfo
+ ^10!
+
+cmdQuery
+ ^3!
+
+cmdQuit
+ ^1!
+
+cmdRefresh
+ ^7!
+
+cmdShutdown
+ ^8!
+
+cmdSleep
+ ^0!
+
+cmdStatistics
+ ^9! !
+
+!MySQLWriteStream methodsFor: 'accessing'!
+
+flush
+ outputPacket flush!
+
+nextPutAllNullTerminated: aCollection2
+ self nextPutAll: aCollection2.
+ self nextPut: self null asCharacter!
+
+nextPutCommand: aCommand
+ self
+ nextPut: (Character value: (self perform: aCommand));
+ nextPut: self null asCharacter!
+
+nextPutCommand: aCommand message: aString
+ self
+ nextPut: (Character value: (self perform: aCommand));
+ nextPutAllNullTerminated: aString!
+
+outputPacket
+ ^outputPacket!
+
+outputPacket: p
+ outputPacket := p!
+
+setWritePosition: aPosition
+    "aPosition timesRepeat: [ self nextPut: 0 asCharacter]"
+    ptr := aPosition + 1! !
+
+!MySQLWriteStream methodsFor: 'initialize'!
+
+initialize! !
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+MySQLWriteStream class
+ instanceVariableNames: ''!
+
+!MySQLWriteStream methodsFor: 'constants'!
+null
+ ^0! !
+
+
+!MySQLWriteStream class methodsFor: 'instance creation'!
+on: aCollection startingAt: aPosition
+outputPacket: op
+ | ws |
+ ws := (self on: aCollection)
+ setWritePosition: aPosition.
+ ws outputPacket: op.
+ ^ws! !
+
+!MySQLWriteStream class methodsFor: 'instance creation'!
+xon: aCollection outputPacket: op
+ | ws |
+ ws := (super on: aCollection) initialize.
+ ws outputPacket: op.
+ ^ws! !
+
+!MySQLConnection class methodsFor: 'errors'!
+
+throwException: aSymbol
+ self throwException: aSymbol message: ''!
+
+throwException: aSymbol message: aString
+ self
+ error: (self errorTable at: aSymbol ifAbsent: ['Unknown']) , ': ' , aString!
+
+errorTable
+ ErrorTable isNil ifTrue: [
+    ErrorTable := IdentityDictionary new.
+    1 to: self errorTableMap size by: 2 do: [ :i |
+        ErrorTable
+    at: (self errorTableMap at: i)
+            put: (self errorTableMap at: i + 1) ] ].
+
+ ^ErrorTable!
+
+errorTableMap
+ ^#(#protocol 'Invalid Protocol'
+    #authentication 'Access denied'
+    #setDatabase   'Could not set the database'
+    #invalidQuery 'Invalid query')! !
+
+!MySQLConnection class methodsFor: 'instance creation'!
+
+driverName
+    ^'MySQL'!
+
+paramConnect: aParams user: aUserName password: aPassword
+    | database connection host port |
+    database := aParams at: 'dbname' ifAbsent: [ nil ].
+    host := aParams at: 'host' ifAbsent: [ 'localhost' ].
+    port := (aParams at: 'port' ifAbsent: [ 3306 ]) asInteger.
+
+    connection := self new.
+    connection connectTo: host port: port.
+    connection login: aUserName password: aPassword.
+    database isNil ifFalse: [ connection database: database ].
+    ^connection! !
+
+!MySQLConnection methodsFor: 'querying'!
+
+beginTransaction
+ ^self do: 'START TRANSACTION'!
+
+commitTransaction
+ ^self do: 'COMMIT'!
+
+rollbackTransaction
+ ^self do: 'ROLLBACK'!
+
+database
+ ^database!
+
+do: aSQLQuery
+ ^(self prepare: aSQLQuery) execute!
+
+select: aSQLQuery
+ ^(self prepare: aSQLQuery) execute!
+
+prepare: aQuery
+ ^(MySQLStatement on: self) prepare: aQuery!
+
+!MySQLConnection methodsFor: 'closing'!
+
+finalize
+ self close!
+
+close
+ self
+ removeToBeFinalized;
+ closeRequest;
+ closeSocket!
+
+closeRequest
+ (self requestPacket writeStream)
+ nextPutCommand: #cmdQuit;
+ flush!
+
+closeSocket
+ socket isNil ifFalse: [socket close].
+ socket := nil! !
+
+!MySQLConnection methodsFor: 'initialize-release'!
+
+connectTo: host port: port
+    | messageText |
+    socket := TCP.Socket remote: host port: port.
+    self addToBeFinalized.
+
+    socket isNil ifTrue: [ ^self error: messageText].
+    serverInfo := MySQLServerInfo new.
+    serverInfo readFrom: self responsePacket
+!
+
+database: aString
+    (self requestPacket writeStream)
+ nextPutCommand: #cmdInitializeDatabase message: aString;
+ flush.
+    self responsePacket checkStatusOnError: #setDatabase.
+    database := aString!
+
+oldProtocolHashes: password
+    password isEmpty ifTrue: [ ^'' ].
+    ^{ self hash2: password seed: serverInfo hashSeed }!
+
+newProtocolHashes: password
+    password isEmpty ifTrue: [ ^String new: 1 ].
+    ^{ self hashSHA1: password seed: serverInfo hashSeed.
+       self hash2: password seed: serverInfo hashSeed }!
+
+login: user password: password
+    | replyStream hashes userSent longPassword |
+    replyStream := self replyPacket writeStream.
+    serverInfo hashSeed size = 8
+ ifTrue: [
+    hashes := self oldProtocolHashes: password.
+    replyStream
+        nextPutAll: (self class integerAsByteArray: 1 length: 2) asByteString;
+        nextPutAll: (self class integerAsByteArray: 65536 length: 3) asByteString;
+        nextPutAllNullTerminated: user;
+ nextPutAllNullTerminated: hashes first;
+ flush ]
+ ifFalse: [
+    hashes := self newProtocolHashes: password.
+    replyStream
+        nextPutAll: (self class integerAsByteArray: 41477 length: 4) asByteString;
+        nextPutAll: (self class integerAsByteArray: 65536 length: 4) asByteString;
+        nextPut: 8 asCharacter;
+        next: 23 put: 0 asCharacter;
+        nextPutAllNullTerminated: user;
+ nextPut: hashes first size asCharacter;
+ nextPutAll: hashes first;
+         flush.
+  
+    (self responsePacket isStatus: 254 onError: #authenticate) ifTrue: [
+ replyStream := self replyPacket writeStream.
+ replyStream nextPutAll: hashes second; flush ] ]! !
+
+!MySQLConnection methodsFor: 'hashing'!
+
+hash: aString seed: aSeed for: hashMethod
+ ^self class
+ perform: hashMethod
+ with: aString
+ with: aSeed! !
+
+!MySQLConnection methodsFor: 'accessing'!
+
+replyPacket
+ ^(MySQLOutputPacket on: socket)
+ packetNumber: responsePacket packetNumber + 1!
+
+requestPacket
+ ^MySQLOutputPacket on: socket!
+
+responsePacket
+ ^responsePacket := MySQLInputPacket on: socket! !
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+MySQLConnection class
+ instanceVariableNames: ''!
+
+
+!MySQLConnection methodsFor: 'hashing'!
+
+hashSHA1: aString seed: aSeed
+ "This algorithm is for MySQL 4.1+."
+
+ | hashedString hashedStringSeeded result |
+ "Compute hash1 = SHA1(password), then hash2 = SHA1(hash1). The server
+ already knows this, as that is what is held in its password table
+ (preceded with a *)."
+
+ hashedString := SHA1 digestOf: aString.
+ hashedStringSeeded := SHA1 digestOf: hashedString.
+
+ "Append hash2 to the salt sent by the server and hash that."
+ hashedStringSeeded := SHA1 digestOf: aSeed, hashedStringSeeded.
+
+ "Finally, XOR the result with SHA1(password).  The server takes this,
+ computes SHA1(salt.`SHA1 stored in DB`), uses the latter result to
+ undo the XOR, computes again SHA1, and compares that with the SHA1
+ stored in the DB."
+
+ result := String new: 20.
+ 1 to: 20 do: [ :i |
+    result at: i put: (Character value:
+ ((hashedString at: i) bitXor: (hashedStringSeeded at: i))) ].
+ ^result!
+
+hash2: aString seed: longSeed
+ "This algorithm is for MySQL 3.22+."
+
+ | hashedString maxValue result num1 num2 num3 aSeed |
+ "Reserve a final byte for NULL termination"
+ aSeed := longSeed copyFrom: 1 to: 8.
+ hashedString := String new: aSeed size.
+ result := self randomInit2: aString seed: aSeed.
+ maxValue := 16r3FFFFFFF.
+ num1 := result at: 1.
+ num2 := result at: 2.
+ 1 to: hashedString size
+ do:
+ [:index |
+ num1 := (num1 * 3 + num2) \\ maxValue.
+ num2 := (num1 + num2 + 33) \\ maxValue.
+ num3 := (num1 / maxValue * 31) truncated + 64.
+ hashedString at: index put: num3 asCharacter].
+ num1 := (num1 * 3 + num2) \\ maxValue.
+ num2 := (num1 + num2 + 33) \\ maxValue.
+ num3 := (num1 / maxValue * 31) truncated.
+ hashedString keysAndValuesDo: [:index :character |
+ hashedString
+ at: index
+ put: (character asInteger bitXor: num3) asCharacter].
+ ^hashedString!
+
+hash: aString
+ "Hash algorithm taken from mysql in order to send password to the server"
+
+ | num1 num2 num3 |
+ num1 := 1345345333.
+ num2 := 305419889.
+ num3 := 7.
+ aString do:
+ [:character |
+ (character = Character space or: [character = Character tab])
+ ifFalse:
+ [| charValue |
+ charValue := character asInteger.
+ num1 := num1
+ bitXor: ((num1 bitAnd: 63) + num3) * charValue + (num1 bitShift: 8).
+ num2 := num2 + ((num2 bitShift: 8) bitXor: num1).
+ num3 := num3 + charValue]].
+ ^Array with: (num1 bitAnd: 2147483647) with: (num2 bitAnd: 2147483647)!
+
+randomInit2: aString seed: aSeed
+ | result array1 array2 |
+ result := Array new: 2.
+ array1 := self hash: aString.
+ array2 := self hash: aSeed.
+ result at: 1 put: ((array1 at: 1) bitXor: (array2 at: 1)) \\ 16r3FFFFFFF.
+ result at: 2 put: ((array1 at: 2) bitXor: (array2 at: 2)) \\ 16r3FFFFFFF.
+ ^result! !
+
+!MySQLConnection class methodsFor: 'misc'!
+
+byteArrayAsInteger: ba
+    ^self byteArrayAsInteger: ba from: 1 for: ba size!
+
+byteArrayAsInteger: ba from: anOffset for: aLength
+    | shiftAmount anInteger |
+
+    shiftAmount := 0.
+    anInteger := 0.
+    anOffset to: aLength
+     do:
+     [:index |
+ anInteger := anInteger bitOr: ((ba at: index) bitShift: shiftAmount).
+ shiftAmount := shiftAmount + 8].
+    ^anInteger!
+
+integerAsByteArray: int length: aLength
+
+    | aByteArray shiftAmount mask |
+    aByteArray := ByteArray new: aLength.
+    shiftAmount := 0.
+    mask := 16rFF.
+    1 to: aLength
+      do:
+      [:index |
+  aByteArray at: index put: (mask bitAnd: (int bitShift: shiftAmount)).
+  shiftAmount := shiftAmount - 8].
+    ^aByteArray!
+
+byteArrayAsByteString: ba
+    | size s |
+    size := ba size.
+    s := String new: size.
+    1 to: size do: [:index |
+ s at: index put: (Character value: (ba at: index)).
+ ].
+    ^s! !
+
+!MySQLPacket methodsFor: 'accessing'!
+
+packetNumber
+ ^packetNumber!
+
+packetNumber: anInteger
+ packetNumber := anInteger!
+
+size
+ ^size!
+
+size: anObject
+ size := anObject!
+
+stream
+ ^stream!
+
+stream: anObject
+ stream := anObject! !
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+MySQLPacket class
+ instanceVariableNames: ''!
+
+
+!MySQLPacket class methodsFor: 'constants'!
+
+defaultBufferSize
+ ^8192!
+
+headerSize
+ ^4!
+
+packetNumberOffset
+ ^4!
+
+packetNumberSize
+ ^1!
+
+izeOffset
+ ^1!
+
+sizeSize
+ ^3! !
+
+!MySQLPacket class methodsFor: 'instance creation'!
+
+on: aStream
+ ^(self new)
+ stream: aStream;
+ initialize! !
+
+!MySQLInputPacket methodsFor: 'initialize-release'!
+
+initialize
+ self stream atEnd
+ ifTrue: [ size := packetNumber := 0. buffer := #[]. ^self ].
+ size := self readSize.
+ packetNumber := self readPacketNumber.
+ buffer := self readBuffer.
+ readStream := MySQLReadStream on: buffer.! !
+
+!MySQLInputPacket methodsFor: 'reading'!
+
+isStatus: anInteger onError: aSymbol
+ ^(self readStatusOnError: aSymbol) = anInteger!
+
+checkForStatus: anInteger onError: aSymbol
+ (self readStatusOnError: aSymbol) = anInteger ifFalse: [self handleError: aSymbol]!
+
+checkStatusOnError: aSymbol
+ self checkForStatus: 0 onError: aSymbol!
+
+handleError: aSymbol
+ | ba int1 int2 |
+ ba := (readStream next: 2) asByteArray.
+ int1 := ba basicAt: 1.
+ int2 := ba basicAt: 2.
+ int2 := int2 bitShift: 8.
+
+ MySQLConnection throwException: aSymbol
+ message: (int1 + int2) printString, ' ', readStream readNullTerminatedString
+" MySQLConnection throwException: aSymbol
+ message: (readStream next: 2) asByteArray asInteger printString , ' '
+ , readStream readNullTerminatedString"!
+
+readBuffer
+ ^self stream next: self size!
+
+readPacketNumber
+ | ba o int1 |
+ o := (self stream next: self class packetNumberSize).
+ ba := o asByteArray.
+ int1 := ba basicAt: 1.
+ ^int1.
+
+" ^(self stream next: self class packetNumberSize) asByteArray asInteger"!
+
+readSize
+ | ba o int1 int2 int3 |
+ o := self stream next: self class sizeSize.
+ "o := String streamContents: [:aStream | 1 to: self class sizeSize
+ do: [:i | aStream nextPut: self stream next]]."
+ ba := o asByteArray.
+ int1 := ba basicAt: 1.
+ int2 := ba basicAt: 2.
+ int2 := int2 bitShift: 8.
+ int3 := ba basicAt: 3.
+ int3 := int3 bitShift: 16.
+ ^int1 + int2 + int3.
+" ^(self stream next: self class sizeSize) asByteArray asInteger
+"
+!
+
+readStatusOnError: aSymbol
+ | status |
+ status := readStream next asInteger.
+ status = 255 ifFalse: [^status].
+ self handleError: aSymbol! !
+
+!MySQLInputPacket methodsFor: 'accessing'!
+
+readStream
+ ^readStream! !
+
+!MySQLOutputPacket methodsFor: 'accessing'!
+
+writeStream
+ ^writeStream! !
+
+!MySQLOutputPacket methodsFor: 'actions'!
+
+flush
+
+ | aString ba s bytesSend |
+ aString := self writeStream contents.
+ self size: aString size - self class headerSize.
+ ba := MySQLConnection integerAsByteArray: self size length: self class sizeSize.
+ s := MySQLConnection byteArrayAsByteString: ba.
+ aString replaceFrom: 1 to: self class sizeSize with: s startingAt: 1.
+
+ aString at: self class sizeSize + 1 put: (Character value: self packetNumber).
+ (self stream) nextPutAll: aString; flush
+! !
+
+
+!MySQLOutputPacket methodsFor: 'initialize-release'!
+
+initialize
+ packetNumber := 0.
+ buffer := String new: self class defaultBufferSize.
+ writeStream := MySQLWriteStream
+ on: buffer
+ startingAt: (self class headerSize)
+ outputPacket: self.
+
+ "This is a bit of a hack...I should utilize events instead"
+! !
+
+
+!MySQLServerInfo methodsFor: 'accessing'!
+
+charset
+ ^charset!
+
+status
+ ^status!
+
+hashSeed
+ ^hashSeed!
+
+options
+ ^options!
+
+protocol
+ ^protocol!
+
+serverThread
+ ^serverThread! !
+
+!MySQLServerInfo methodsFor: 'reading'!
+
+readFrom: aResponsePacket
+ self
+ readProtocolFrom: aResponsePacket;
+ readServerVersionFrom: aResponsePacket;
+ readServerThreadFrom: aResponsePacket;
+ readHashSeedFrom: aResponsePacket;
+ readOptionsFrom: aResponsePacket.
+ aResponsePacket readStream atEnd ifFalse: [
+ self
+ readCharsetFrom: aResponsePacket;
+ readStatusFrom: aResponsePacket;
+ readMoreSeedFrom: aResponsePacket ]!
+
+readStatusFrom: aResponsePacket
+ status := (aResponsePacket readStream next: 2) asByteArray asInteger.
+ aResponsePacket readStream next: 13!
+
+readCharsetFrom: aResponsePacket
+ charset := aResponsePacket readStream next value!
+
+readHashSeedFrom: aResponsePacket
+ hashSeed := aResponsePacket readStream readNullTerminatedString!
+
+readMoreSeedFrom: aResponsePacket
+ hashSeed := hashSeed, aResponsePacket readStream readNullTerminatedString!
+
+readOptionsFrom: aResponsePacket
+ options := (aResponsePacket readStream next: 2) asByteArray asInteger!
+
+readProtocolFrom: aResponsePacket
+ protocol := (aResponsePacket readStatusOnError: #protocol).
+ protocol = 10 ifFalse: [MySQLConnection error: #protocol]!
+
+readServerThreadFrom: aResponsePacket
+ serverThread := (aResponsePacket readStream next: 4) asByteArray asInteger!
+
+readServerVersionFrom: aResponsePacket
+ serverVersion := aResponsePacket readStream readNullTerminatedString! !
+
--- /dev/null
+++ mod/packages/dbd-mysql/Extensions.st
@@ -0,0 +1,55 @@
+"=====================================================================
+|
+|   MySQL DBI driver - base class extensions
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2002 Josh Miller
+| Written by Josh Miller, ported by Markus Fritsche,
+| refactored/rewritten by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library 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 Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+!ByteArray methodsFor: 'accessing'!
+asInteger
+    | shiftAmount anInteger |
+
+    shiftAmount := 0.
+    anInteger := 0.
+    1 to: self size
+     do:
+     [:index |
+ anInteger := anInteger bitOr: ((self at: index) bitShift: shiftAmount).
+ shiftAmount := shiftAmount + 8].
+    ^anInteger
+!
+
+asByteString
+    | stream |
+    stream := WriteStream on: String new.
+    1 to: self size do: [ :x |
+ stream nextPut: (Character value: (self basicAt: x))].
+    ^stream contents
+! !
+
--- /dev/null
+++ mod/packages/dbd-mysql/ResultSet.st
@@ -0,0 +1,181 @@
+"=====================================================================
+|
+|   MySQL DBI driver - ResultSet class
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2002 Josh Miller
+| Written by Josh Miller, ported by Markus Fritsche,
+| refactored/rewritten by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library 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 Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+ResultSet subclass: MySQLResultSet [
+    | index rows rowCount columns columnsDict |
+    
+    <comment: nil>
+    <category: 'DBI-Drivers'>
+
+    MySQLResultSet class >> on: aStatement [
+ <category: 'private'>
+ ^(self basicNew)
+    statement: aStatement;
+    readFrom: aStatement connection;
+    yourself
+    ]
+
+    readFrom: aConnection [
+ <category: 'private'>
+ rowCount := self isSelect
+ ifTrue: [ self readSelectFrom: aConnection ]
+ ifFalse: [ self readUpdateFrom: aConnection ]
+    ]
+
+    readUpdateFrom: aConnection [
+ <category: 'private'>
+ | responsePacket |
+        responsePacket := aConnection responsePacket.
+        responsePacket checkStatusOnError: #invalidQuery.
+        ^(responsePacket readStream next: 2) asByteArray asInteger
+    ]
+
+    readSelectFrom: aConnection [
+ <category: 'private'>
+ | row responsePacket column |
+        responsePacket := aConnection responsePacket.
+        columns := Array
+                new: (responsePacket readStatusOnError: #invalidQuery).
+
+        1 to: columns size do: [:index |
+            columns at: index put: (column := MySQLColumnInfo new).
+    column readFrom: aConnection responsePacket readStream index: index].
+
+        responsePacket := aConnection responsePacket.
+        responsePacket checkForStatus: 254 onError: #invalidQuery.
+
+ rows := OrderedCollection new.
+ [
+    row := MySQLRow on: self readFrom: aConnection responsePacket readStream.
+    row isEmpty
+ ] whileFalse: [ rows addLast: row ].
+
+ index := 0.
+ ^rows size
+    ]
+
+    position [
+ <category: 'cursor access'>
+ ^index
+    ]
+
+    position: anInteger [
+ <category: 'cursor access'>
+        (anInteger between: 0 and: self size)
+            ifTrue: [ index := anInteger ]
+            ifFalse: [ SystemExceptions.IndexOutOfRange signalOn: self withIndex: anInteger ]
+ ^index
+    ]
+
+    next [
+ <category: 'cursor access'>
+ self atEnd ifTrue: [self error: 'No more rows'].
+ index := index + 1.
+ ^rows at: index
+    ]
+
+    atEnd [
+ <category: 'cursor access'>
+ ^index >= self rowCount
+    ]
+
+    valueAtRow: aRowNum column: aColNum [
+ <category: 'private'>
+ ^(rows at: aRowNum) atIndex: aColNum
+    ]
+
+    isSelect [
+ <category: 'accessing'>
+ ^self statement isSelect
+    ]
+
+    isDML [
+ <category: 'accessing'>
+ ^self statement isSelect not
+    ]
+
+    rowCount [
+ <category: 'accessing'>
+ self isSelect ifFalse: [super rowCount].
+ ^rowCount
+    ]
+
+    rowsAffected [
+ <category: 'accessing'>
+ self isDML ifFalse: [super rowsAffected].
+ ^rowCount
+    ]
+
+    columnsArray [
+ <category: 'accessing'>
+ ^columns
+    ]
+
+    columns [
+ <category: 'accessing'>
+ | columnsDict |
+ columnsDict isNil
+    ifTrue:
+ [columnsDict := LookupTable new: columns size.
+ columns do: [:col | columnsDict at: col name put: col]].
+ ^columnsDict
+    ]
+
+    columnNames [
+ "Answer the names of the columns in this result set."
+
+ <category: 'accessing'>
+ ^columns collect: [:col | col name]
+    ]
+
+    columnCount [
+ "Answer the number of columns in the result set."
+
+ <category: 'accessing'>
+ ^columns size
+    ]
+
+    rows [
+ "This is slightly more efficient than the default method."
+
+ <category: 'accessing'>
+ ^rows
+    ]
+
+    release [
+ "Clear the result set."
+
+ <category: 'MySQL specific'>
+ columns := rows := nil
+    ]
+]
--- /dev/null
+++ mod/packages/dbd-mysql/Row.st
@@ -0,0 +1,117 @@
+"=====================================================================
+|
+|   MySQL DBI driver - Row class
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2002 Josh Miller
+| Written by Josh Miller, ported by Markus Fritsche,
+| refactored/rewritten by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library 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 Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+Row variableSubclass: #MySQLRow
+ instanceVariableNames: 'isEmpty '
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Mysql-Driver'!
+
+
+!MySQLRow methodsFor: 'reading'!
+
+checkForEndOrNull: aReadStream
+ "This is a bit unclean...the value 254 has been overloaded in the protocol.  When it is the only
+        value in the stream, it indicates there are no more rows.  It also indicates that the following
+        8 bytes contain the size of the field value.  The problem is that there is another condition that
+        produces a single value on the stream...a row with one column whose value is NULL."
+
+ | endOrNull |
+ aReadStream size = 1 ifTrue: [
+ endOrNull := aReadStream next asInteger.
+ isEmpty := endOrNull = 254.
+ ^true ].
+ (aReadStream size < 9 and: [ aReadStream peekFor: (Character value: 254) ])
+ ifTrue: [
+ aReadStream next: aReadStream size - 1.
+ isEmpty := true.
+ ^true ].
+
+ isEmpty := false.
+ ^false !
+
+readFrom: aReadStream
+ (self checkForEndOrNull: aReadStream) ifTrue: [^self].
+
+ 1 to: self columnCount
+ do:
+ [:index |
+ | aSize column |
+ aSize := self readSizeFrom: aReadStream.
+ aSize = -1 ifFalse: [
+ column := resultSet columnsArray at: index.
+ self at: index put: (column convert: (aReadStream next: aSize))]]!
+
+readSizeFrom: aReadStream
+ | aSize |
+ aSize := aReadStream next asInteger.
+ aSize < 251 ifTrue: [^aSize].
+ aSize = 251 ifTrue: [^-1].
+ aSize = 252 ifTrue: [^(aReadStream next: 2) asByteArray asInteger].
+ aSize = 253 ifTrue: [^(aReadStream next: 3) asByteArray asInteger].
+ aSize = 254 ifTrue: [^(aReadStream next: 8) asByteArray asInteger]! !
+
+!MySQLRow methodsFor: 'accessing'!
+
+at: aColumnName
+ ^self basicAt: (resultSet columns at: aColumnName) index!
+
+atIndex: anIndex
+ ^self basicAt: anIndex!
+
+columnCount
+ ^self size!
+
+columns
+ ^resultSet columns!
+
+columnNames
+ ^resultSet columnNames! !
+
+!MySQLRow methodsFor: 'testing'!
+
+isEmpty
+ ^isEmpty! !
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
+
+MySQLRow class
+ instanceVariableNames: ''!
+
+
+!MySQLRow class methodsFor: 'instance creation'!
+
+on: aResultSet readFrom: aConnection
+ ^(self new: aResultSet columnCount)
+ resultSet: aResultSet;
+ readFrom: aConnection! !
+
--- /dev/null
+++ mod/packages/dbd-mysql/Statement.st
@@ -0,0 +1,90 @@
+"=====================================================================
+|
+|   MySQL DBI driver - Statement class
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2002 Josh Miller
+| Written by Josh Miller, ported by Markus Fritsche,
+| refactored/rewritten by Paolo Bonzini
+|
+| This file is part of GNU Smalltalk.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library 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 Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+Statement subclass: MySQLStatement [
+    | statement isSelect |
+
+    <category: 'DBI-Framework'>
+    <comment: 'I represent a prepared statement.'>
+
+    SelectQueries := #('EXPLAIN' 'SELECT' 'SHOW' 'DESCRIBE') asSet.
+
+    getCommand [
+        | readStream writeStream aCharacter |
+        writeStream := WriteStream on: String new.
+        readStream := ReadStream on: statement.
+        readStream skipSeparators.
+        [readStream atEnd
+    or: [aCharacter := readStream next. aCharacter isSeparator]]
+                whileFalse: [writeStream nextPut: aCharacter asUppercase].
+        ^writeStream contents
+    ]
+
+    prepare: aSQLString [
+ "Prepare the statement in aSQLString."
+
+ <category: 'private'>
+ statement := aSQLString.
+ isSelect := SelectQueries includes: self getCommand.
+    ]
+
+    statement [
+ "Return the SQL template."
+ ^statement
+    ]
+
+    execute [
+ "Execute with no parameters"
+
+ <category: 'abstract'>
+        | queryInfo |
+        connection requestPacket writeStream
+            nextPutCommand: #cmdQuery message: statement;
+            flush.
+
+ ^MySQLResultSet on: self
+    ]
+
+    isSelect [
+ "Return whether the query is a SELECT-type query."
+ ^isSelect
+    ]
+
+    executeWithAll: aParams [
+ "Execute taking parameters from the Collection aParams."
+
+ <category: 'not implemented'>
+ self notYetImplemented
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbd-postgresql/ColumnInfo.st
@@ -0,0 +1,241 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+ColumnInfo subclass: PGColumnInfo [
+    | resultSet index cname ctype csize |
+    
+    <comment: nil>
+    <category: 'DBI-Framework'>
+
+    TypeNames := nil.
+    TypeConversions := nil.
+
+    PGColumnInfo class >> in: aResultSet at: aIndex [
+ <category: 'instance creation'>
+ ^self new in: aResultSet at: aIndex
+    ]
+
+    PGColumnInfo class >> convertBool: aRaw [
+ <category: 'type conversions'>
+ ^#(true false) at: ('tf' indexOf: (aRaw at: 1) ifAbsent: [^nil])
+    ]
+
+    PGColumnInfo class >> convertNumber: aRaw [
+ <category: 'type conversions'>
+ ^Number readFrom: (ReadStream on: aRaw)
+    ]
+
+    PGColumnInfo class >> convertPoint: aRaw [
+ <category: 'type conversions'>
+ ^aRaw "FIXME"
+    ]
+
+    PGColumnInfo class >> convertDate: aRaw [
+ <category: 'type conversions'>
+ ^Date readFrom: (ReadStream on: aRaw)
+    ]
+
+    PGColumnInfo class >> convertTime: aRaw [
+ <category: 'type conversions'>
+ ^Time readFrom: (ReadStream on: aRaw)
+    ]
+
+    PGColumnInfo class >> convertDateTime: aRaw [
+ <category: 'type conversions'>
+ ^DateTime readFrom: (ReadStream on: aRaw)
+    ]
+
+    PGColumnInfo class >> convertTimeInterval: aRaw [
+ <category: 'type conversions'>
+ ^aRaw "FIXME"
+    ]
+
+    PGColumnInfo class >> initTypes [
+ "Generated by extract_types.st; conversion routines added manually."
+
+ <category: 'type conversions'>
+ TypeNames := LookupTable new.
+ TypeConversions := LookupTable new.
+ #(#(#bool 16 #convertBool:)
+ "boolean, 'true'/'false'"
+  #(#bytea 17)
+ "variable-length string, binary values escaped"
+  #(#char 18)
+ "single character"
+  #(#name 19)
+ "63-character type for storing system identifiers"
+  #(#int8 20 #convertNumber:)
+ "~18 digit integer, 8-byte storage"
+  #(#int2 21 #convertNumber:)
+ "-32 thousand to 32 thousand, 2-byte storage"
+  #(#int2vector 22 #convertNumber:)
+ "array of INDEX_MAX_KEYS int2 integers, used in system tables"
+  #(#int4 23 #convertNumber:)
+ "-2 billion to 2 billion integer, 4-byte storage"
+  #(#regproc 24)
+ "registered procedure"
+  #(#text 25)
+ "variable-length string, no limit specified"
+  #(#oid 26 #convertNumber:)
+ "object identifier(oid), maximum 4 billion"
+  #(#tid 27)
+ "(Block, offset), physical location of tuple"
+  #(#xid 28 #convertNumber:)
+ "transaction id"
+  #(#cid 29)
+ "command identifier type, sequence in transaction id"
+  #(#oidvector 30)
+ "array of INDEX_MAX_KEYS oids, used in system tables"
+  #(#smgr 210)
+ "storage manager"
+  #(#point 600 #convertPoint:)
+ "geometric point '(x, y)'"
+  #(#lseg 601)
+ "geometric line segment '(pt1,pt2)'"
+  #(#path 602)
+ "geometric path '(pt1,...)'"
+  #(#box 603)
+ "geometric box '(lower left,upper right)'"
+  #(#polygon 604)
+ "geometric polygon '(pt1,...)'"
+  #(#line 628)
+ "geometric line (not implemented)'"
+  #(#float4 700 #convertNumber:)
+ "single-precision floating point number, 4-byte storage"
+  #(#float8 701 #convertNumber:)
+ "double-precision floating point number, 8-byte storage"
+  #(#abstime 702)
+ "absolute, limited-range date and time (Unix system time)"
+  #(#reltime 703)
+ "relative, limited-range time interval (Unix delta time)"
+  #(#tinterval 704)
+ "(abstime,abstime), time interval"
+  #(#unknown 705)
+ "geometric circle '(center,radius)'"
+  #(#circle 718)
+ "monetary amounts, $d,ddd.cc"
+  #(#money 790 #convertNumber:)
+ "XX:XX:XX:XX:XX:XX, MAC address"
+  #(#macaddr 829)
+ "IP address/netmask, host address, netmask optional"
+  #(#inet 869)
+ "network IP address/netmask, network address"
+  #(#cidr 650)
+
+  #(#aclitem 1033)
+ "access control list"
+  #(#bpchar 1042)
+ "char(length), blank-padded string, fixed storage length"
+  #(#varchar 1043)
+ "varchar(length), non-blank-padded string, variable storage length"
+  #(#date 1082 #convertDate:)
+ "ANSI SQL date"
+  #(#time 1083 #convertTime:)
+ "hh:mm:ss, ANSI SQL time"
+  #(#timestamp 1114 #convertDateTime:)
+ "date and time"
+  #(#timestamptz 1184 #convertDateTime:)
+ "date and time with time zone"
+  #(#interval 1186 #convertTimeInterval:)
+ "@ <number> <units>, time interval"
+  #(#timetz 1266 #convertTime:)
+ "hh:mm:ss, ANSI SQL time"
+  #(#bit 1560)
+ "fixed-length bit string"
+  #(#varbit 1562)
+ "variable-length bit string"
+  #(#numeric 1700 #convertNumber:)
+ "numeric(precision, decimal), arbitrary precision number"
+  #(#refcursor 1790)
+ "reference cursor (portal name)"
+  #(#regprocedure 2202)
+ "registered procedure (with args)"
+  #(#regoper 2203)
+ "registered operator"
+  #(#regoperator 2204)
+ "registered operator (with args)"
+  #(#regclass 2205)
+ "registered class"
+  #(#regtype 2206))
+ "registered type"
+    do:
+ [:a |
+ TypeNames at: a second put: a first.
+ a size > 2 ifTrue: [TypeConversions at: a first put: a third]]
+    ]
+
+    PGColumnInfo class >> printTypeNames [
+ <category: 'type conversions'>
+ TypeNames keysAndValuesDo:
+ [:k :v |
+ (Transcript << v << ' ')
+    << k;
+    nl]
+    ]
+
+    PGColumnInfo class >> typeFromOid: aOid [
+ <category: 'type conversions'>
+ ^TypeNames at: aOid ifAbsent: ['#' , aOid printString]
+    ]
+
+    PGColumnInfo class >> convert: aRaw type: aType [
+ <category: 'type conversions'>
+ TypeConversions at: aType ifPresent: [:sel | ^self perform: sel with: aRaw].
+ ^aRaw
+    ]
+
+    in: aResultSet at: aIndex [
+ <category: 'initialization'>
+ resultSet := aResultSet.
+ index := aIndex
+    ]
+
+    name [
+ <category: 'accessing'>
+ cname isNil ifTrue: [cname := resultSet columnAt: index].
+ ^cname
+    ]
+
+    index [
+ <category: 'accessing'>
+ ^index
+    ]
+
+    type [
+ <category: 'accessing'>
+ ctype isNil ifTrue: [ctype := resultSet columnTypeAt: index].
+ ^ctype
+    ]
+
+    size [
+ <category: 'accessing'>
+ csize isNil ifTrue: [csize := resultSet columnSizeAt: index].
+ ^csize
+    ]
+]
+
+
+
+Eval [
+    PGColumnInfo initTypes
+]
--- /dev/null
+++ mod/packages/dbd-postgresql/Connection.st
@@ -0,0 +1,163 @@
+"======================================================================
+|
+| Written by Mike Anderson [hidden email] 2006
+| Based on PostgreSQL interface by Thomas Braun [hidden email]
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Connection subclass: PGConnection [
+    | handle |
+    
+    <comment: nil>
+    <category: 'DBI-Drivers'>
+
+    PGConnection class >> driverName [
+ <category: 'initialization'>
+ ^'PostgreSQL'
+    ]
+
+    ConnectionStatus := #(#CONNECTION_OK
+ #CONNECTION_BAD
+ #CONNECTION_STARTED
+ #CONNECTION_MADE
+ #CONNECTION_AWAITING_RESPONSE
+ #CONNECTION_AUTH_OK
+ #CONNECTION_SETENV
+ #CONNECTION_SSL_STARTUP
+ #CONNECTION_NEEDED).
+
+    PGConnection class >> connectionStatus: aCode [
+ <category: 'constants'>
+ ^ConnectionStatus at: aCode + 1
+    ]
+
+    PGConnection class >> paramConnect: aParams user: aUserName password: aPassword [
+ "Normally you would use Connection>>connect:user:password: with a DSN
+ specifying the appropriate driver string.
+ Note that aUserName and aPassword may be nil; for Postgres, the username
+ defaults to the OS user if not supplied."
+
+ <category: 'instance creation'>
+ "Assemble a connection string in the right format"
+
+ | connStr connParams handle conn connOK |
+ connParams := OrderedCollection new.
+ aParams keysAndValuesDo: [:k :v | connParams add: k , '=' , v].
+ aUserName notNil ifTrue: [connParams add: 'user=' , aUserName].
+ aPassword notNil ifTrue: [connParams add: 'password=' , aPassword].
+ connStr := connParams fold: [ :a :b | a, ' ', b ].
+ handle := PQConnection connect: connStr.
+ connOK := self connectionStatus: handle status.
+ connOK == #CONNECTION_OK
+    ifFalse:
+ [handle finish.
+ self error: 'Connection failed (' , connOK , ')'].
+ ^(self new)
+    handle: handle;
+    yourself
+    ]
+
+    handle: aCObject [
+ <category: 'private'>
+ handle := aCObject.
+ self addToBeFinalized
+    ]
+
+    finalize [
+ <category: 'private'>
+ self close
+    ]
+
+    do: aSQLQuery [
+ <category: 'implementations'>
+ ^(PGResultSet new: (handle exec: aSQLQuery))
+    checkStatusForDo;
+    yourself
+    ]
+
+    prepare: aSQLQuery [
+ "FIXME"
+
+ <category: 'implementations'>
+ self notYetImplemented
+    ]
+
+    select: aSQLQuery [
+ <category: 'implementations'>
+ ^(PGResultSet new: (handle exec: aSQLQuery))
+    checkStatusForSelect;
+    yourself
+    ]
+
+    close [
+ <category: 'implementations'>
+ handle finish
+    ]
+
+    beginTransaction [
+ <category: 'implementations'>
+ ^self do: 'BEGIN'
+    ]
+
+    commitTransaction [
+ <category: 'implementations'>
+ ^self do: 'COMMIT'
+    ]
+
+    rollbackTransaction [
+ <category: 'implementations'>
+ ^self do: 'ROLLBACK'
+    ]
+
+    database [
+ <category: 'PG specific'>
+ ^handle database
+    ]
+
+]
+
+
+CObject subclass: PQConnection [
+    "Connections"
+    PQConnection class >> connect: aString [
+        <cCall: 'PQconnectdb' returning: #{PQConnection} args: #(#string)>
+    ]
+    status [
+        <cCall: 'PQstatus' returning: #int args: #(#self)>
+    ]
+
+    database [
+        <cCall: 'PQdb' returning: #string args: #(#self)>
+    ]
+
+    errorMessage [
+        <cCall: 'PQerrorMessage' returning: #string args: #(#self)>
+    ]
+
+    finish [
+        <cCall: 'PQfinish' returning: #void args: #(#self)>
+    ]
+
+    "Executing SQL"
+    exec: aSqlStatement [
+        <cCall: 'PQexec' returning: #{PQResultSet} args: #(#self #string)>
+    ]
+]
+
+
--- /dev/null
+++ mod/packages/dbd-postgresql/ResultSet.st
@@ -0,0 +1,318 @@
+"======================================================================
+|
+| Written by Mike Anderson [hidden email] 2006
+| Based on PostgreSQL interface by Thomas Braun [hidden email]
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+ResultSet subclass: PGResultSet [
+    | handle index rowCount columns columnsArray |
+    
+    <comment: nil>
+    <category: 'DBI-Drivers'>
+
+    PGResultSet class >> new: aCObject [
+ <category: 'private'>
+ ^(self basicNew)
+    handle: aCObject;
+    yourself
+    ]
+
+    ResultStatus := #(#PGRES_EMPTY_QUERY
+ #PGRES_COMMAND_OK
+ #PGRES_TUPLES_OK
+ #PGRES_COPY_OUT
+ #PGRES_COPY_IN
+ #PGRES_BAD_RESPONSE
+ #PGRES_NONFATAL_ERROR
+ #PGRES_FATAL_ERROR).
+
+    PGResultSet class >> resultStatus: aCode [
+ <category: 'constants'>
+ ^ResultStatus at: aCode + 1
+    ]
+
+    handle: aCObject [
+ <category: 'private'>
+ handle := aCObject.
+ index := 0.
+ rowCount := nil.
+ columns := nil.
+ self addToBeFinalized
+    ]
+
+    finalize [
+ <category: 'private'>
+ self primClear
+    ]
+
+    next [
+ <category: 'cursor access'>
+ | r |
+ self atEnd ifTrue: [self error: 'No more rows'].
+ "FIXME - This could be neater"
+ r := PGRow in: self at: index.
+ index := index + 1.
+ ^r
+    ]
+
+    atEnd [
+ <category: 'cursor access'>
+ ^index >= self rowCount
+    ]
+
+    checkStatusForDo [
+ <category: 'private'>
+ (#(#PGRES_COMMAND_OK #PGRES_TUPLES_OK #PGRES_EMPTY_QUERY)
+    includes: self resultStatus) ifFalse: [self error: self errorMessage]
+    ]
+
+    checkStatusForSelect [
+ <category: 'private'>
+ | stat |
+ stat := self resultStatus.
+ stat = #PGRES_TUPLES_OK
+    ifFalse:
+ [| msg |
+ stat = #PGRES_EMPTY_QUERY
+    ifTrue: [self error: 'Empty query - no result set'].
+ stat = #PGRES_COMMAND_OK
+    ifTrue: [self error: 'Not a SELECT - no result set'].
+ msg := self errorMessage.
+ msg isEmpty ifTrue: [self error: stat].
+ self error: msg]
+    ]
+
+    rawValueAtRow: aRowNum column: aColNum [
+ "Answer a given result value at row aRowNum and column aColNum.
+ Both values 0-based."
+
+ <category: 'private'>
+ | v |
+ v := handle
+    row: aRowNum
+    column: aColNum - 1.
+ (v isEmpty and:
+ [(handle
+    isNullRow: aRowNum
+    column: aColNum - 1) = 1])
+    ifTrue: [v := nil].
+ ^v
+    ]
+
+    valueAtRow: aRowNum column: aColNum [
+ <category: 'private'>
+ ^PGColumnInfo convert: (self rawValueAtRow: aRowNum column: aColNum)
+    type: (self columnsArray at: aColNum) type
+    ]
+
+    isSelect [
+ <category: 'accessing'>
+ ^self resultStatus = #PGRES_TUPLES_OK
+    ]
+
+    isDML [
+ <category: 'accessing'>
+ ^self resultStatus = #PGRES_COMMAND_OK
+    ]
+
+    position [
+        <category: 'cursor access'>
+        ^index
+    ]
+
+    position: anInteger [
+        <category: 'cursor access'>
+        (anInteger between: 0 and: self size)
+            ifTrue: [ index := anInteger ]
+            ifFalse: [ SystemExceptions.IndexOutOfRange signalOn: self withIndex: anInteger ]
+        ^index
+    ]
+
+    rowCount [
+ <category: 'accessing'>
+ self isSelect ifFalse: [super rowCount].
+ rowCount isNil ifTrue: [rowCount := handle numTuples].
+ ^rowCount
+    ]
+
+    rowsAffected [
+ <category: 'accessing'>
+ self isDML ifFalse: [super rowsAffected].
+ ^handle numTuples
+    ]
+
+    columnsArray [
+ <category: 'accessing'>
+ columnsArray isNil
+    ifTrue:
+ [| n |
+ n := handle numFields.
+ columnsArray := Array new: n.
+ 1 to: n do: [:i | columnsArray at: i put: (PGColumnInfo in: self at: i)]].
+ ^columnsArray
+    ]
+
+    columns [
+ <category: 'accessing'>
+ columns isNil
+    ifTrue:
+ [| n |
+ columns := LookupTable new: self columnsArray size.
+ columnsArray do: [:col | columns at: col name put: col]].
+ ^columns
+    ]
+
+    columnNames [
+ "Answer the names of the columns in this result set."
+
+ <category: 'accessing'>
+ ^self columnsArray collect: [:col | col name]
+    ]
+
+    columnAt: aIndex [
+ "Answer the name of a given column."
+
+ <category: 'accessing'>
+ ^handle fieldName: aIndex - 1
+    ]
+
+    columnCount [
+ "Answer the number of columns in the result set."
+
+ <category: 'accessing'>
+ ^handle numFields
+    ]
+
+    rows [
+ "This is slightly more efficient than the default method."
+
+ <category: 'accessing'>
+ | r n |
+ n := self rowCount.
+ r := WriteStream on: (Array new: n).
+ 0 to: n - 1 do: [:i | r nextPut: (PGRow in: self at: i)].
+ ^r contents
+    ]
+
+    resultStatus [
+ "Answer the symbolic execution status."
+
+ <category: 'PG specific'>
+ ^self class resultStatus: handle status
+    ]
+
+    errorMessage [
+ <category: 'PG specific'>
+ ^handle errorMessage
+    ]
+
+    primClear [
+ <category: 'PG specific'>
+ handle clear
+    ]
+
+    release [
+ "Clear the result set."
+
+ <category: 'result set'>
+ self removeToBeFinalized.
+ self primClear
+    ]
+
+    columnTypeAt: aIndex [
+ "Used by PGColumnInfo. Prefer (columns at: aName) type or (columnsArray at: aIndex) type"
+
+ <category: 'PG specific'>
+ ^PGColumnInfo
+    typeFromOid: (handle fieldType: aIndex - 1)
+    ]
+
+    columnSizeAt: aIndex [
+ "Used by PGColumnInfo. Prefer (columns at: aName) size or (columnsArray at: aIndex) size"
+
+ <category: 'PG specific'>
+ ^handle fieldSize: aIndex - 1
+    ]
+]
+
+
+CObject subclass: PQResultSet [
+    "Results"
+    status [
+        <cCall: 'PQresultStatus' returning: #int args: #( #self)>
+    ]
+
+    errorMessage [
+        <cCall: 'PQresultErrorMessage' returning: #string args: #( #self)>
+    ]
+
+    clear [
+        <cCall: 'PQclear' returning: #void args: #( #self)>
+    ]
+
+    "Result sets"
+    numTuples [
+        <cCall: 'PQntuples' returning: #int args: #( #self)>
+    ]
+
+    row: aRowNum column: aColNum [
+        <cCall: 'PQgetvalue' returning: #string args: #( #self #int #int)>
+    ]
+
+    isNullRow: aRowNum column: aColNum [
+        <cCall: 'PQgetisnull' returning: #int args: #( #self #int #int)>
+    ]
+
+    "DML results"
+    rowsAffected [
+        <cCall: 'PQcmdTuples' returning: #int args: #( #self)>
+    ]
+
+    lastOid [
+        <cCall: 'PQoidValue' returning: #uInt args: #( #self)>
+    ]
+
+    "Column info"
+    numFields [
+        <cCall: 'PQnfields' returning: #int args: #( #self)>
+    ]
+
+    fieldName: aColNum [
+        <cCall: 'PQfname' returning: #string args: #( #self #int)>
+    ]
+
+    fieldIsBinary: aColNum [
+        <cCall: 'PQfformat' returning: #int args: #( #self #int)>
+    ]
+    
+    fieldType: aColNum [
+        <cCall: 'PQftype' returning: #uInt "Oid" args: #( #self #int)>
+    ]
+
+    fieldMod: aColNum [
+        <cCall: 'PQfmod' returning: #int "eg. precision or size" args: #( #self #int)>
+    ]
+
+    fieldSize: aColNum [
+        <cCall: 'PQfsize' returning: #int args: #( #self #int)>
+    ]
+
+]
+
--- /dev/null
+++ mod/packages/dbd-postgresql/Row.st
@@ -0,0 +1,64 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Row subclass: PGRow [
+    | index |
+    
+    <comment: nil>
+    <category: 'DBI-Drivers'>
+
+    PGRow class >> in: aPGResultSet at: aIndex [
+ <category: 'instance creation'>
+ ^self new
+    resultSet: aPGResultSet;
+    index: aIndex
+    ]
+
+    index: aIndex [
+ <category: 'initialization'>
+ index := aIndex
+    ]
+
+    at: aColumnName [
+ <category: 'accessing'>
+ ^resultSet valueAtRow: index
+    column: (resultSet columns at: aColumnName) index
+    ]
+
+    atIndex: aColumnIndex [
+ <category: 'accessing'>
+ ^resultSet valueAtRow: index column: aColumnIndex
+    ]
+
+    raw: aColumnName [
+ <category: 'PG specific'>
+ ^resultSet rawValueAtRow: index
+    column: (resultSet columns at: aColumnName) index
+    ]
+
+    rawAtIndex: aColumnIndex [
+ <category: 'PG specific'>
+ ^resultSet rawValueAtRow: index column: aColumnIndex
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbd-postgresql/package.xml
@@ -0,0 +1,16 @@
+<package>
+  <name>DBD-PostgreSQL</name>
+  <prereq>DBI</prereq>
+  <namespace>DBI.PostgreSQL</namespace>
+  <library>libpq</library>
+
+  <filein>Connection.st</filein>
+  <filein>ResultSet.st</filein>
+  <filein>Row.st</filein>
+  <filein>ColumnInfo.st</filein>
+
+  <file>Connection.st</file>
+  <file>ResultSet.st</file>
+  <file>Row.st</file>
+  <file>ColumnInfo.st</file>
+</package>
--- /dev/null
+++ mod/packages/dbi/ColumnInfo.st
@@ -0,0 +1,63 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Object subclass: ColumnInfo [
+    
+    <category: 'DBI-Framework'>
+    <comment: nil>
+
+    name [
+ "Return the name of the column (abstract)."
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    index [
+ "Return the 1-based index of the column in the result set (abstract)."
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    type [
+ "Return a string containing the type of the column (abstract)."
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    size [
+ "Return the size of the column (abstract)."
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    printOn: aStream [
+ "Print a representation of the receiver on aStream."
+ <category: 'printing'>
+ aStream
+    nextPutAll: self name;
+    nextPut: $(;
+    nextPutAll: self type;
+    nextPut: $)
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbi/Connection.st
@@ -0,0 +1,119 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Object subclass: Connection [
+    
+    <category: 'DBI-Framework'>
+    <comment: 'I represent a connection to a database.'>
+
+    Drivers := LookupTable new.
+
+    Connection class >> updateDriverList [
+ "Private - Look for new subclasses of Connection."
+ <category: 'initialization'>
+ Drivers := LookupTable new.
+ Connection allSubclassesDo: [ :each |
+    each driverName isNil ifFalse: [
+ Drivers at: each driverName put: each ] ]
+    ]
+
+    Connection class >> driverName [
+ "Override this method, returning the name of the driver, in every
+ concrete subclass of Connection.  Abstract classes should return
+ nil instead."
+ ^nil
+    ]
+
+    Connection class >> paramConnect: params user: aUserName password: aPassword [
+ "Connect to the database server using the parameters in params (a
+ Dictionary) and the given username and password (abstract)."
+
+ <category: 'connecting'>
+ self subclassResponsibility
+    ]
+
+    Connection class >> connect: aDSN user: aUserName password: aPassword [
+ "Connect to the database server identified by aDSN using the given
+ username and password.  The DSN is in the format
+ dbi:DriverName:dbname=database_name;host=hostname;port=port
+ Where dbi is constant, DriverName is the name of the driver, and
+ everything else is parameters in the form name1=value1;name2=value2;...
+
+ Individual drivers may parse the parameters differently, though
+ the existing ones all support parameters dbname, host and port."
+
+ <category: 'connecting'>
+ | info driverClass driver |
+ info := ConnectionInfo fromDSN: aDSN.
+ info scheme asLowercase = 'dbi'
+    ifFalse: [self error: 'Connection string is not for DBI!'].
+ driver := info driver.
+ driverClass := Drivers at: driver
+    ifAbsent: [self updateDriverList.
+ Drivers at: driver
+    ifAbsent: [self error: 'Unknown driver: ' , driver]].
+ ^driverClass
+    paramConnect: info params
+    user: aUserName
+    password: aPassword
+    ]
+
+    do: aSQLQuery [
+ "Executes a SQL statement (usually one that doesn't return a result set).
+ Return value is a ResultSet, to which you can send #rowsAffected
+ (abstract)."
+
+ <category: 'querying'>
+ self subclassResponsibility
+    ]
+
+    prepare: aSQLQuery [
+ "Creates a statement object, that can be executed (with parameters, if
+ applicable) repeatedly (abstract)."
+
+ <category: 'querying'>
+ self subclassResponsibility
+    ]
+
+    select: aSQLQuery [
+ "Prepares and executes a SQL statement. Returns the result set or
+ throws an exception on failure (abstract)."
+
+ <category: 'querying'>
+ self subclassResponsibility
+    ]
+
+    close [
+ "Close the connection now; should happen on GC too (abstract)."
+
+ <category: 'connecting'>
+ self subclassResponsibility
+    ]
+]
+
+
+
+Eval [
+    Connection initialize
+]
+
--- /dev/null
+++ mod/packages/dbi/ConnectionInfo.st
@@ -0,0 +1,94 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Object subclass: ConnectionInfo [
+    | scheme driver paramString params |
+    
+    <category: 'DBI-Framework'>
+    <comment: 'A utility class to contain connection info.'>
+
+    ConnectionInfo class >> fromDSN: aDSN [
+ "Parse a DSN in the format
+         dbi:DriverName:dbname=database_name;host=hostname;port=port where
+         dbi is constant, DriverName is the name of the driver, and everything
+         else is parameters in the form name1=value1;name2=value2;..."
+
+ <category: 'instance creation'>
+ | sm n |
+ n := self new.
+ sm := ReadStream on: aDSN.
+ n scheme: (sm upTo: $:).
+ n driver: (sm upTo: $:).
+ n paramString: sm upToEnd.
+ ^n
+    ]
+
+    parseParams [
+ <category: 'private'>
+ params := LookupTable new.
+ (paramString subStrings: $;) do:
+ [:p |
+ | kv |
+ kv := p subStrings: $=.
+ params at: (kv at: 1) put: (kv size > 1 ifTrue: [kv at: 2] ifFalse: [nil])]
+    ]
+
+    scheme: aString [
+ "Set the scheme; the only supported one is 'dbi'."
+ <category: 'accessing'>
+ scheme := aString
+    ]
+
+    scheme [
+ "Answer the scheme; the only supported one is 'dbi'."
+ <category: 'accessing'>
+ ^scheme
+    ]
+
+    driver: aString [
+ "Set the driver; this is not the driver class."
+ <category: 'accessing'>
+ driver := aString
+    ]
+
+    driver [
+ "Answer the driver; this is not the driver class."
+ <category: 'accessing'>
+ ^driver
+    ]
+
+    paramString: aString [
+ "Set the parameter list."
+ <category: 'accessing'>
+ paramString := aString.
+ params := nil
+    ]
+
+    params [
+ "Return the parsed parameters in a Dictionary."
+ <category: 'accessing'>
+ params isNil ifTrue: [self parseParams].
+ ^params
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbi/ResultSet.st
@@ -0,0 +1,155 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Stream subclass: ResultSet [
+    | statement |
+    
+    <category: 'DBI-Framework'>
+    <comment: 'I represent a result set, ie. the set of rows returned from a SELECT statement.
+I may also be returned for DML statements (INSERT, UPDATE, DELETE), in which
+case I only hold the number of rows affected.'>
+
+    fetch [
+ "Return the next row, or nil if at the end of the result set."
+ <category: 'cursor access'>
+ self atEnd ifTrue: [ ^nil ].
+ ^self next
+    ]
+
+    next [
+ "Return the next row, or raise an error if at the end of the stream
+ (abstract)."
+ <category: 'cursor access'>
+ self subclassResponsibility
+    ]
+
+    atEnd [
+ "Return whether all the rows in the result set have been consumed.
+ (abstract)."
+ <category: 'cursor access'>
+ self subclassResponsibility
+    ]
+
+    rows [
+ "Answer the contents of the execution result as array of Rows."
+
+ <category: 'accessing'>
+ | pos |
+ pos := self position.
+ ^[ self position: 0. self contents ]
+    ensure: [ self position: pos ]
+    ]
+
+    columns [
+ "Answer a Dictionary of column -> index pairs (abstract)."
+
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    columnNames [
+ "Answer an array of column names in order (abstract)."
+
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    columnAt: aIndex [
+ "Answer the aIndex'th column name."
+
+ <category: 'accessing'>
+ ^self columnNames at: aIndex
+    ]
+
+    isSelect [
+ "Returns true if the statement was a SELECT or similar operation
+ (e.g. SHOW, DESCRIBE, EXPLAIN), false otherwise."
+
+ <category: 'accessing'>
+ ^false
+    ]
+
+    isDML [
+ "Returns true if the statement was not a SELECT or similar operation
+ (e.g. SHOW, DESCRIBE, EXPLAIN)."
+
+ <category: 'accessing'>
+ ^false
+    ]
+
+    position [
+ "Returns the current row index (0-based) in the result set (abstract)."
+ <category: 'stream protocol'>
+ self subclassResponsibility
+    ]
+
+    position: anInteger [
+ "Sets the current row index (0-based) in the result set (abstract)."
+ <category: 'stream protocol'>
+ self subclassResponsibility
+    ]
+
+    size [
+ "Returns the number of rows in the result set."
+ <category: 'stream protocol'>
+ ^self rowCount
+    ]
+
+    rowCount [
+ "Returns the number of rows in the result set;
+ error for DML statements."
+
+ <category: 'accessing'>
+ self error: 'Not a SELECT statement.'
+    ]
+
+    rowsAffected [
+ "For DML statments, returns the number of rows affected;
+ error for SELECT statements."
+
+ <category: 'accessing'>
+ self error: 'Not a DML statement.'
+    ]
+
+    printOn: aStream [
+ "Print a representation of the receiver on aStream."
+ <category: 'printing'>
+ self rows do:
+ [:row |
+ row printOn: aStream.
+ aStream nl]
+    ]
+
+    statement [
+ "Return the Statement, if any, that generated the result set."
+
+ <category: 'accessing'>
+ ^statement
+    ]
+
+    statement: aStatement [
+ <category: 'private'>
+ statement := aStatement
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbi/Row.st
@@ -0,0 +1,101 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Object subclass: Row [
+    | resultSet |
+    
+    <category: 'DBI-Framework'>
+    <comment: 'I represent a row in a result set.'>
+
+    resultSet [
+ "Return the result set that includes the receiver."
+
+ <category: 'accessing'>
+ ^resultSet
+    ]
+
+    resultSet: aResultSet [
+ <category: 'private'>
+ resultSet := aResultSet
+    ]
+
+    at: aColumnName [
+ "Return the value of the named column (abstract)."
+
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    atIndex: aColumnIndex [
+ "Return the value of the column at the given 1-based index (abstract)."
+
+ <category: 'accessing'>
+ self subclassResponsibility
+    ]
+
+    columnCount [
+ "Return the number of columns in the row."
+
+ <category: 'accessing'>
+ ^resultSet columnCount
+    ]
+
+    columns [
+ "Return a Dictionary of ColumnInfo objects for the columns in the row,
+ where the keys are the column names."
+
+ <category: 'accessing'>
+ ^resultSet columns
+    ]
+
+    columnNames [
+ "Return an array of column names for the columns in the row."
+
+ <category: 'accessing'>
+ ^resultSet columnNames
+    ]
+
+    columnAt: aIndex [
+ "Return a ColumnInfo object for the aIndex-th column in the row."
+
+ <category: 'accessing'>
+ ^resultSet columnAt: aIndex
+    ]
+
+    keysAndValuesDo: aBlock [
+ "Pass to aBlock each column name and the corresponding value."
+
+ <category: 'accessing'>
+ self columns keysAndValuesDo:
+    [:name :col | aBlock value: name value: (self atIndex: col index)]
+    ]
+
+    printOn: aStream [
+ "Print a representation of the receiver on aStream."
+
+ <category: 'printing'>
+ self keysAndValuesDo: [ :col :val |
+    aStream << col << ' -> ' << val printString << '   ' ]
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbi/Statement.st
@@ -0,0 +1,93 @@
+"======================================================================
+|
+| Copyright 2006 Mike Anderson
+| Written by Mike Anderson
+|
+| This 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 code 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
+| Mumble; see the file COPYING.  If not, write to the Free Software
+| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+|
+ ======================================================================
+"
+
+
+
+Object subclass: Statement [
+    | connection |
+    
+    <category: 'DBI-Framework'>
+    <comment: 'I represent a prepared statement.'>
+
+    Statement class >> on: aConnection [
+        "Return a new statement for this connection."
+
+        <category: 'instance creation'>
+        ^self new
+            connection: aConnection;
+            yourself
+    ]
+
+    connection [
+        "Return the connection for which the statement was prepared."
+
+        <category: 'private'>
+        ^connection
+    ]
+
+    connection: aConnection [
+        "Associate the statement to the given Connection."
+
+        <category: 'private'>
+        connection := aConnection
+    ]
+
+    execute [
+ "Execute with no parameters (abstract)."
+
+ <category: 'querying'>
+ self subclassResponsibility
+    ]
+
+    executeWith: aParameter [
+ "Execute with one parameters."
+
+ <category: 'querying'>
+ ^self executeWithAll: {aParameter}
+    ]
+
+    executeWith: aParam1 with: aParam2 [
+ "Execute with two parameters."
+
+ <category: 'querying'>
+ ^self executeWithAll:
+ {aParam1.
+ aParam2}
+    ]
+
+    executeWith: aParam1 with: aParam2 with: aParam3 [
+ "Execute with three parameters."
+
+ <category: 'querying'>
+ ^self executeWithAll:
+ {aParam1.
+ aParam2.
+ aParam3}
+    ]
+
+    executeWithAll: aParams [
+ "Execute taking parameters from the Collection aParams (abstract)."
+
+ <category: 'querying'>
+ self subclassResponsibility
+    ]
+]
+
--- /dev/null
+++ mod/packages/dbi/package.xml
@@ -0,0 +1,18 @@
+<package>
+  <name>DBI</name>
+  <namespace>DBI</namespace>
+
+  <filein>ConnectionInfo.st</filein>
+  <filein>Connection.st</filein>
+  <filein>Statement.st</filein>
+  <filein>ResultSet.st</filein>
+  <filein>Row.st</filein>
+  <filein>ColumnInfo.st</filein>
+
+  <file>ConnectionInfo.st</file>
+  <file>Connection.st</file>
+  <file>Statement.st</file>
+  <file>ResultSet.st</file>
+  <file>Row.st</file>
+  <file>ColumnInfo.st</file>
+</package>


_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk