[ENH] PostgreSQL Client for Squeak (Version 0.8.0)

Yanni Jew yanni at rogers.com
Thu Dec 12 07:38:03 UTC 2002


Here's the latest version.
--yanni
-------------- next part --------------
RELEASE NOTES:  "PostgreSQL Client for Squeak"

==========
Quick Start
==========

Read the comment in TestPGConnection, which tells you where to configure the database connection arguments. Run the #testConnection test, which does a connect and disconnect. If it passes, then try running the rest of the tests.

Look at the test code for ideas and examples.


==========
TODO
==========

-document the object model and PGConnection state machine
-the SUnit tests for function calls do not verify the return value
-need a test for binary row
-run the postgresql regression tests
-type converters (i.e. parse the result strings to create Integer, Date, etc. objects)
-connection pooling
-handle lost connection
-re-connect a lost connection
-throw timeout exception if response has taken too long
-performance tuning
-encrypted password authentication
-Kerberos V4/V5 authentication
-MD5 authentication
-SCM creditial authentication


==========
0.8.0 Release Notes
==========

Changes/Fixes:
-queries answer a PGResult instead of PGResultSet
-improved error handling/reporting
-merged PGConnection and PGActiveConnection into PGConnection
-greatly simplified the PGConnection state machine 
-COPY IN was sending a ',' instead of '.'
-one or two packets were not reading all their data off the socket
-default connection args can be coded for PGConnection
-removed the 500 millisecond delay on reading from socket

Added support for:
-multiple result sets (PGResult and PGResultSet)
-asynchronous notification response
-asynchronous cancel of request in progress

Already supported in release 0.7.0:
-unencrypted password authentication
-execute sql query; show result set
-function call
-copy in/out
-binary rows


==========
0.7.0 Release Notes
==========

1. PGConnection>>next contains a 500 ms delay. You may not need any delay at all depending on your system. I connect from WinNT 4.0 (SP5) to "Red Hat Linux release 6.2 (Zoot) Kernel 2.2.14-5.0 on a sparc". I did not need a delay when connecting from Linux (x86) to Linux (SPARC). No delay was needed for a local database, under Linux (x86).

2. Both PGConnection and PGActiveConnection can be instantiated. PGConnection>>preferredConnectionClass determines which is used. PGConnection currently has less functionality than PGActiveConnection. PGActiveConnection is driven by a state machine, and is based on Shlaer/Mellor OOA ideas.

3. You need to configure TestPGConnection>>defaultConnectionArgs with connection values that will work at your site. I have SUnitSQ2.7 (from SourceForge) installed, which is newer than the SUnit found in the Squeak 3.0 release. I've not run the tests with the older SUnit.

4. TestPGConnection has code to run the regression tests that come with postgresql-7.0.3, but the tests are not run automatically by SUnit. The regression tests need to be run in the given order, on a new database. I've only run the first set of tests. There will be differences with the expected output because the rows are not formatted in the same way.

5. There is a "TODO" list in the class comment of PGConnection.


==========
Acknowledgements
==========
1. The fix to remove the 500ms delay in PGConnection>>#next is due to Kamil Kukura.
2. The suggestion to add default connection args to PGConnection is due to Nevin Pratt.

==========
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.
-------------- next part --------------
The "PostgreSQL Client for Squeak software", hereinafter referred to as the "software", is released under "Squeak" license. The intention is that however you wanted to use Squeak itself, you can use the "software". No more, and no fewer, rights and obligations are granted here, than apply to the original Squeak. The software is provided "AS IS", so take note of the "Disclaimer of Warranty", "Limitation of Liability", and "Indemnification" clauses of the "Squeak Software License", since equivalent license terms apply to the "software".

The text of the "Squeak Software License" can be found at "http://www.squeak.org/license.html". 
-------------- next part --------------
'From Squeak3.4alpha of ''11 November 2002'' [latest update: #5125] on 12 December 2002 at 1:14:55 am'!
Object subclass: #PGActiveObject
	instanceVariableNames: 'trace state events '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGActiveObject commentStamp: 'yj 12/9/2002 15:49' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.

Instances of PGConnection implement a client interface to a PostgreSQL backend.
See the "Frontend/Backend Protocol" chapter in the "PostgreSQL Programmer's Guide" for more information.

===== No support for: =====
-encrypted password authentication
-Kerberos V4/V5 authentication
-MD5 authentication
-SCM credential authentication
!

PGActiveObject class
	instanceVariableNames: 'stateTransitionTable '!
PGActiveObject subclass: #PGConnection
	instanceVariableNames: 'socket readBuffer readIndex lastReadIndex writeBuffer processId secretKey sql functionCallOid functionCallArgs copyStream result connectionArgs notificationSubscribers '
	classVariableNames: 'DefaultConnectionArgs DefaultTraceLevel '
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGConnection commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

Object subclass: #PGConnectionArgs
	instanceVariableNames: 'hostname portno databaseName userName password extraArgs debugTty '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGConnectionArgs commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGActiveObject subclass: #PGNotificationSubscriber
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGNotificationSubscriber commentStamp: 'yj 12/11/2002 15:47' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

Object subclass: #PGPacket
	instanceVariableNames: ''
	classVariableNames: 'PacketClasses PacketTypes '
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGPacket commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGAbstractStringResponse
	instanceVariableNames: 'value '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGAbstractStringResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGAsciiRow
	instanceVariableNames: 'description nullFields data '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGAsciiRow commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGAuthentication
	instanceVariableNames: 'type salt '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGAuthentication commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGBackendKeyData
	instanceVariableNames: 'processId secretKey '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGBackendKeyData commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGAsciiRow subclass: #PGBinaryRow
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGBinaryRow commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGCancelRequest
	instanceVariableNames: 'processId secretKey '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGCancelRequest commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGColumnDescription
	instanceVariableNames: 'fieldName typeOid typeSize typeModifier '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGColumnDescription commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGAbstractStringResponse subclass: #PGCompletedResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGCompletedResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGCopyInResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGCopyInResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGCopyOutResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGCopyOutResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGAbstractStringResponse subclass: #PGCursorResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGCursorResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGAbstractStringResponse subclass: #PGEmptyQueryResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGEmptyQueryResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGAbstractStringResponse subclass: #PGErrorResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGErrorResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGFunctionCall
	instanceVariableNames: 'oid arguments '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGFunctionCall commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGFunctionResultResponse
	instanceVariableNames: 'result '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGFunctionResultResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGAbstractStringResponse subclass: #PGNoticeResponse
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGNoticeResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGNotificationResponse
	instanceVariableNames: 'processId conditionName '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGNotificationResponse commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGPasswordPacket
	instanceVariableNames: 'password '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGPasswordPacket commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGQuery
	instanceVariableNames: 'queryString '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGQuery commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGReadyForQuery
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGReadyForQuery commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

Object subclass: #PGResult
	instanceVariableNames: 'resultSets errorResponse functionResult '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGResult commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

Object subclass: #PGResultSet
	instanceVariableNames: 'completedResponse rowDescription rows '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGResultSet commentStamp: 'yj 12/9/2002 15:08' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGRowDescription
	instanceVariableNames: 'numberOfColumns columnDescriptions '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGRowDescription commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGStartupPacket
	instanceVariableNames: 'version databaseName userName extraArgs debugTty '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGStartupPacket commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

PGPacket subclass: #PGTerminate
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!PGTerminate commentStamp: '<historical>' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.!

TestCase subclass: #TestPGConnection
	instanceVariableNames: 'useConnectionDefaults notificationSubscriberCount '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PostgreSQL-Client'!

!TestPGConnection commentStamp: 'yj 12/11/2002 15:49' prior: 0!
Copyright (c) 2001, 2002 by Yanni Jew. All Rights Reserved.

Edit the method #newConnectionArgs to connect to your test database.
Run #testConnection. If that succeeds then try running the rest of the tests.
!


!PGActiveObject methodsFor: 'initialize/release' stamp: 'yj 12/4/2002 21:22'!
initialize

	state _ #Created.
	events _ OrderedCollection new.
	^self
! !

!PGActiveObject methodsFor: 'trace' stamp: 'yj 12/9/2002 14:12'!
log: where text: text

	self logInfo: where, ': ', text.
! !

!PGActiveObject methodsFor: 'trace' stamp: 'yj 12/9/2002 14:10'!
logIdString

	^ self class name, '(', self hash printString, ')'.
! !

!PGActiveObject methodsFor: 'trace' stamp: 'yj 12/9/2002 13:48'!
logInfo: text

	Transcript
		nextPut: $[;
		nextPutAll: self logIdString;
		nextPut: $];
		space;
		nextPutAll: text;
		cr;
		endEntry.
! !

!PGActiveObject methodsFor: 'trace' stamp: 'yj 4/21/2000 18:18'!
trace
	^trace! !

!PGActiveObject methodsFor: 'trace' stamp: 'yj 2/25/2000 12:54'!
trace: anInteger
	trace _ anInteger! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 3/5/2000 18:22'!
generateEvent: event to: receiver

	^self == receiver
		ifTrue: [self processEvent: event]
		ifFalse: [receiver queueEvent: event].
! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 12/9/2002 12:16'!
nextEvent

	^ #CantHappen
! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 12/11/2002 12:00'!
processEvent: event

	| nextState eventName eventNameString traceText |

	eventName _ event class == Symbol ifTrue: [event] ifFalse: [event eventName].
	nextState _ (self stateTransitionTable at: state)
		at: eventName
		ifAbsent: [ #CantHappen ].

	trace >= 8 ifTrue: [
		eventNameString _ event class == Symbol ifTrue: [event asString] ifFalse: [event eventName].
		traceText _ nextState = #EventIgnored
			ifTrue: [ state asString, ' IGNORE ', eventNameString ]
			ifFalse: [ state asString, '-->', nextState asString, ' on ', eventNameString ].
		self log: 'processEvent' text: traceText.
	].

	nextState = #EventIgnored
		ifFalse: [
			state _ nextState.
			self perform: ('st', state asString, ':') asSymbol with: event.
		].
! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 2/28/2000 20:10'!
queueEvent: event

	events addLast: event.
! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 12/9/2002 12:16'!
saProcessEventsUntil: newStates

	[
		[events size > 0] whileTrue: [
			self processEvent: events removeFirst.
		].
		(newStates includes: state) 
			ifFalse: [self generateEvent: self nextEvent to: self].
		(newStates includes: state) not
	] whileTrue.
! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 12/10/2002 19:53'!
stCantHappen: event
	"Handle a defective state machine."

	self error: self class name, ' has a defective state machine'.
! !

!PGActiveObject methodsFor: 'private-sa' stamp: 'yj 12/9/2002 12:07'!
stateTransitionTable

	^ self class stateTransitionTable
! !


!PGActiveObject class methodsFor: 'stt' stamp: 'yj 12/9/2002 12:06'!
buildStateTransitionTable

	^ Dictionary new
! !

!PGActiveObject class methodsFor: 'stt' stamp: 'yj 12/10/2002 13:07'!
resetStateTransitionTable

	stateTransitionTable _ nil
! !

!PGActiveObject class methodsFor: 'stt' stamp: 'yj 12/9/2002 12:06'!
stateTransitionTable

	stateTransitionTable == nil ifTrue: [stateTransitionTable _ self buildStateTransitionTable].
	^ stateTransitionTable
! !


!PGConnection methodsFor: 'accessing' stamp: 'yj 12/11/2002 12:17'!
addNotificationSubscriber: aNotificationSubscriber

	^ self notificationSubscribers add: aNotificationSubscriber
! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 4/21/2000 18:39'!
connectionArgs
	^connectionArgs! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:52'!
connectionArgs: aConnectionArgs
	connectionArgs _ aConnectionArgs! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 2/7/2001 12:24'!
copyStream
	^copyStream! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 2/7/2001 12:24'!
copyStream: aStream
	copyStream _ aStream! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 12/5/2002 22:13'!
isConnected
	^ socket notNil and: [ socket statusString = 'connected' ]! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 12/11/2002 12:17'!
notificationSubscribers

	notificationSubscribers isNil ifTrue: [ notificationSubscribers _ OrderedCollection new ].
	^ notificationSubscribers
! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 12/5/2002 15:31'!
result
	^result! !

!PGConnection methodsFor: 'accessing' stamp: 'yj 12/5/2002 15:31'!
result: aResult
	result _ aResult! !

!PGConnection methodsFor: 'api' stamp: 'yj 12/9/2002 18:25'!
cancelRequest
	"Issue a cancel request. Open a new connection to the server and send a CancelRequest message."

	self sendCancel.
! !

!PGConnection methodsFor: 'api' stamp: 'yj 12/9/2002 12:20'!
copy: copySql withStream: aStream

	"The syntax of a COPY command is:

	COPY [ BINARY ] table [ WITH OIDS ]
		FROM { 'filename' | stdin }
		[ [USING] DELIMITERS 'delimiter' ]
		[ WITH NULL AS 'null string' ]

	COPY [ BINARY ] table [ WITH OIDS ]
		TO { 'filename' | stdout }
		[ [USING] DELIMITERS 'delimiter' ]
		[ WITH NULL AS 'null string' ]

	The 'stdin' or 'stdout' option must be used, not the 'filename' option.
	'aStream' will supply the COPY...FROM input.
	'aStream' will received the COPY...TO output.
	"

	sql _ copySql.
	copyStream _ aStream.
	self queueEvent: #Query.
	self saProcessEventsUntil: #(ReadyForQuery ConnectionFailed).
	^ result
! !

!PGConnection methodsFor: 'api' stamp: 'yj 12/11/2002 17:26'!
execute: sqlString

	self isConnected ifFalse: [ self error: 'Connection not valid' ].

	sql _ sqlString.
	self queueEvent: #Query.
	self saProcessEventsUntil: #(ReadyForQuery ConnectionFailed).

	"There's an extra result set, so nuke it here."
	result resultSets size > 0
		ifTrue: [ result resultSets removeLast ].

	^ result
! !

!PGConnection methodsFor: 'api' stamp: 'yj 12/9/2002 12:20'!
functionCall: oid arguments: arguments

	functionCallOid _ oid.
	functionCallArgs _ arguments.
	self queueEvent: #FunctionCall.
	self saProcessEventsUntil: #(ReadyForQuery ConnectionFailed).
	^ result
! !

!PGConnection methodsFor: 'api' stamp: 'yj 12/11/2002 11:31'!
startup

	self connectionArgs isNil ifTrue: [
		self connectionArgs: self class defaultConnectionArgs.
	].
	self queueEvent: #Startup.
	self saProcessEventsUntil: #(ReadyForQuery ConnectionFailed TerminalError).
	^ result
! !

!PGConnection methodsFor: 'api' stamp: 'yj 12/5/2002 22:50'!
terminate

	self queueEvent: #Terminate.
	self saProcessEventsUntil: #(Terminated ConnectionFailed).
! !

!PGConnection methodsFor: 'initialize/release' stamp: 'yj 12/11/2002 11:32'!
initialize

	| readBufferSize |

	super initialize.

	trace _ self class defaultTraceLevel.
	readBufferSize _ 8096.
	readBuffer _ String new: readBufferSize.
	readIndex _ readBufferSize + 1.
	lastReadIndex _ readBufferSize.
	result _ PGResult new.
	"^ self"
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/10/2002 19:07'!
closeSocket

	self closeSocket: socket
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/9/2002 16:40'!
closeSocket: aSocket

	trace >= 2
		ifTrue: [ self log: 'closeSocket' text: 'hostname: ', connectionArgs hostname, ':', connectionArgs portno printString ].
	trace >= 2
		ifTrue: [ self log: 'closeSocket' text: 'socket: ', aSocket printString ].

	aSocket closeAndDestroy.

	trace >= 2
		ifTrue: [ self log: 'closeSocket' text: 'socket: ', aSocket printString ].
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/10/2002 20:23'!
copyInDataRows
	"copyStream is initially positioned at the start of a data rows stream.
	The contents are sent down the socket.

	In a stream of data rows, each row is terminatated by a Byte1('\n').
	A sequence of Byte1('\\'), Byte1('.'), Byte1('\n') is the last line.
	"

	trace >= 8
		ifTrue: [ self log: 'copyInDataRows' text: copyStream contents printString ].

	socket sendData: copyStream contents.
	"socket sendData: (String with: $\ with: $. with: Character lf)."
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 2/7/2001 19:06'!
copyOutDataRows

	| ch lf notDone pch ppch |
	lf _ Character lf.
	notDone _ true.
	pch _ $x.
	ch _ $x.
	[notDone] whileTrue: [
		ppch _ pch.
		pch _ ch.
		ch _ self next.
		copyStream nextPut: ch.
		((ch = lf and: [pch = $.]) and: [ppch = $\])
			ifTrue: [notDone _ false].
	].

! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/11/2002 19:47'!
next

	readIndex >= lastReadIndex ifTrue: [
		trace >= 10 ifTrue: [self log: 'next' text: '**** filling read buffer ****'].
		"(Delay forMilliseconds: 500) wait."
		(socket waitForDataUntil: Socket standardDeadline) ifFalse: [self error: 'timed out getting data'].
		[
			(lastReadIndex _ socket receiveDataInto: readBuffer) = 0 ifTrue: [
				trace >= 10 ifTrue: [self log: 'next' text: '**** zero length received from socket ****'].
				(Delay forMilliseconds: 100) wait.
			].
			lastReadIndex = 0
		] whileTrue.
		readIndex _ 0.
		trace >= 10 ifTrue: [self log: 'next' text: '**** read ', lastReadIndex printString, ' ****'].
	].
	readIndex _ readIndex + 1.
	trace >= 10
		ifTrue: [self log: 'next' text:
			'readIndex=', readIndex printString,
			',lastReadIndex=', lastReadIndex printString,
			',ch=', (readBuffer at: readIndex) printString].
	^ readBuffer at: readIndex.
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/11/2002 12:09'!
nextEvent

	| pkt noticeFlag |

	[
		pkt _ self receivePacket.
		(noticeFlag _ #(NoticeResponse NotificationResponse) includes: pkt eventName)
			ifTrue: [ self notifySubscribers: pkt ].
		noticeFlag.
	] whileTrue.
	^ pkt
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/11/2002 12:20'!
notifySubscribers: pkt

	notificationSubscribers isNil
		ifTrue: [ self logInfo: 'NOTIFICATION: ', pkt printString ]
		ifFalse: [ notificationSubscribers do: [:each | each receive: pkt from: self ]].
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/9/2002 16:27'!
openSocket

	| newSocket |

	trace >= 2
		ifTrue: [ self log: 'openSocket' text: 'hostname: ', connectionArgs hostname, ':', connectionArgs portno printString ].

	Socket initializeNetwork.
	newSocket _ Socket newTCP.
	newSocket
		connectTo: (NetNameResolver addressForName: connectionArgs hostname timeout: 15)
		port: connectionArgs portno.
	(newSocket waitForConnectionUntil: Socket standardDeadline)
		ifFalse: [ newSocket _ nil ].

	trace >= 2
		ifTrue: [ self log: 'openSocket' text: 'socket: ', newSocket printString ].

	^newSocket! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/10/2002 13:03'!
receivePacket

	| typeCode packet |

	typeCode _ self next.
	packet _ PGPacket newPacket: typeCode.

	packet == nil
		ifTrue: [packet _ #UnknownPacket]
		ifFalse: [packet receiveFrom: self ].

	trace >= 5
		ifTrue: [ self log: 'receivePacket' text: packet printString ].

	^ packet
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/5/2002 19:14'!
resetResult
	"Clear the result, a new query or function call will follow."

	result
		reset;
		addResultSet.
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/9/2002 18:30'!
sendCancel

	| cancelRequestSocket |

	trace >= 2
		ifTrue: [ self log: 'sendCancel' text: 'processId=', processId printString ].

	cancelRequestSocket _ self openSocket.
	self sendPacket: (PGCancelRequest processId: processId secretKey: secretKey) on: cancelRequestSocket.
	self closeSocket: cancelRequestSocket.
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/9/2002 16:24'!
sendPacket: aPacket on: aSocket

	| s |
	s _ WriteStream on: String new.
	aPacket writeOn: s.

	trace >= 5
		ifTrue: [
			self log: 'sendPacket' text: aPacket printString.
			trace >= 10 ifTrue: [self log: 'sendPacket' text: s contents printString].
		].

	aSocket sendData: s contents.
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/9/2002 16:23'!
sendStartup

	self sendPacket: (PGStartupPacket databaseName: connectionArgs databaseName userName: connectionArgs userName) on: socket.
! !

!PGConnection methodsFor: 'private-actions' stamp: 'yj 12/9/2002 16:23'!
sendTerminate

	self sendPacket: PGTerminate new on: socket.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 17:53'!
stAuthenticationOk: event

	"Do nothing"
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/10/2002 19:19'!
stCantHappen: event
	"Try to send the terminate packet, then close the socket"

	self isConnected ifTrue: [ self sendTerminate ].
	socket isNil ifFalse: [ self closeSocket ].
	super stCantHappen: event.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 21:56'!
stConnectionFailed: event

	"Do nothing"
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 19:22'!
stErrorResponse: event

	result errorResponse: event.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/9/2002 16:23'!
stFunctionCall: event

	self resetResult.
	self sendPacket: (PGFunctionCall oid: functionCallOid arguments: functionCallArgs) on: socket.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/4/2002 19:16'!
stGotBackendKeyData: backendKeyData
	"event is a BackendKeyData packet."

	processId _ backendKeyData processId.
	secretKey _ backendKeyData secretKey.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 18:19'!
stGotCompleted: event

	result completedResponse: event.

	"This causes an extra result set to be added.
	But a result set has to be available at this point,
	given the current state machine.
	"
	result addResultSet.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/4/2002 19:12'!
stGotCopyIn: event

	self copyInDataRows.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/4/2002 19:12'!
stGotCopyOut: event

	self copyOutDataRows.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/4/2002 19:19'!
stGotCursor: event

	"Do nothing"
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 15:30'!
stGotFunctionResult: event

	result functionResult: event.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 15:31'!
stGotRow: event

	result rows add: event.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/5/2002 15:31'!
stGotRowDescription: event

	result rowDescription: event.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/9/2002 16:24'!
stQuerying: event

	self resetResult.
	self sendPacket: (PGQuery sql: sql) on: socket.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/4/2002 20:37'!
stReadyForQuery: event

	"Do nothing"
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/9/2002 16:24'!
stSendingCleartextPassword: event

	self sendPacket: (PGPasswordPacket password: connectionArgs password) on: socket.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/9/2002 16:26'!
stStartup: event

	self resetResult.
	socket _ self openSocket.
	socket isNil
		ifTrue: [ self generateEvent: #ConnectionFailed to: self ]
		ifFalse: [ self sendStartup ].
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/9/2002 16:40'!
stTerminalError: event

	result errorResponse: event.
	self closeSocket: socket.
	socket _ nil.
! !

!PGConnection methodsFor: 'private-states' stamp: 'yj 12/9/2002 16:40'!
stTerminated: event

	self sendTerminate.
	self closeSocket: socket.
	socket _ nil.
! !


!PGConnection class methodsFor: 'initialization' stamp: 'yj 12/11/2002 11:30'!
buildDefaultConnectionArgs

	^ PGConnectionArgs
		hostname: '192.168.1.1'
		portno: 5432
		databaseName: 'mydatabase'
		userName: 'myuser'
		password: nil
! !

!PGConnection class methodsFor: 'initialization' stamp: 'yj 12/11/2002 12:01'!
buildStateTransitionTable
	"self resetStateTransitionTable"

	^#(
	(Created (
		(Startup Startup)))
	(Startup (
		(AuthenticationCleartextPassword SendingCleartextPassword)
		(AuthenticationOk AuthenticationOk)
		(ConnectionFailed ConnectionFailed)
		(Terminate Terminated)
		(ErrorResponse TerminalError)))
	(SendingCleartextPassword (
		(AuthenticationOk AuthenticationOk)
		(Terminate Terminated)
		(ErrorResponse TerminalError)))
	(AuthenticationOk (
		(BackendKeyData GotBackendKeyData)
		(Terminate Terminated)
		(ErrorResponse TerminalError)))
	(GotBackendKeyData (
		(ReadyForQuery ReadyForQuery)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(ReadyForQuery (
		(Query Querying)
		(FunctionCall FunctionCall)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(Querying (
		(CursorResponse GotCursor)
		(CopyOutResponse GotCopyOut)
		(CopyInResponse GotCopyIn)
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(FunctionCall (
		(FunctionResultResponse GotFunctionResult)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotCursor (
		(RowDescription GotRowDescription)
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotRowDescription (
		(AsciiRow GotRow)
		(BinaryRow GotRow)
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotRow (
		(AsciiRow GotRow)
		(BinaryRow GotRow)
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotCopyOut (
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotCopyIn (
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotFunctionResult (
		(ReadyForQuery ReadyForQuery)
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(GotCompleted (
		(ReadyForQuery ReadyForQuery)
		(CursorResponse GotCursor)
		(CompletedResponse GotCompleted)
		(Terminate Terminated)
		(ErrorResponse ErrorResponse)))
	(Terminated (
		(Startup Startup)))
	(ConnectionFailed (
		(Startup Startup)
		(Query EventIgnored)
		(FunctionCall EventIgnored)
		(Terminate EventIgnored)))
	(ErrorResponse (
		(Terminate Terminated)
		(ReadyForQuery ReadyForQuery)
		(CompletedResponse GotCompleted)))
	(TerminalError (
		))
	)
	inject: Dictionary new
	into: [:table :each |
		table
			at: (each at: 1)
			put: ((each at: 2)
					inject: Dictionary new
					into: [:stateTransitions :transition |
						stateTransitions at: (transition at: 1) put: (transition at: 2).
						stateTransitions]).
		table].
! !

!PGConnection class methodsFor: 'accessing' stamp: 'yj 12/11/2002 11:28'!
defaultConnectionArgs
	DefaultConnectionArgs isNil ifTrue: [DefaultConnectionArgs _ self buildDefaultConnectionArgs].
	^ DefaultConnectionArgs
! !

!PGConnection class methodsFor: 'accessing' stamp: 'yj 12/11/2002 11:33'!
defaultConnectionArgs: aConnectionArgs
	"self defaultConnectionArgs: nil"

	DefaultConnectionArgs _ aConnectionArgs
! !

!PGConnection class methodsFor: 'accessing' stamp: 'yj 12/4/2002 17:23'!
defaultTraceLevel
	DefaultTraceLevel isNil ifTrue: [DefaultTraceLevel _ 0].
	^DefaultTraceLevel! !

!PGConnection class methodsFor: 'accessing' stamp: 'yj 4/22/2000 00:30'!
defaultTraceLevel: anInteger
	"
	PGConnection defaultTraceLevel: 0.
	PGConnection defaultTraceLevel: 2.
	PGConnection defaultTraceLevel: 5.
	PGConnection defaultTraceLevel: 8.
	PGConnection defaultTraceLevel: 10.
	"

	DefaultTraceLevel _ anInteger! !

!PGConnection class methodsFor: 'instance creation' stamp: 'yj 2/24/2000 19:47'!
new

	^self basicNew initialize
! !


!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:33'!
databaseName
	^databaseName! !

!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:34'!
debugTty
	^debugTty! !

!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:34'!
extraArgs
	^extraArgs! !

!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:30'!
hostname
	^hostname! !

!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:33'!
password
	^password! !

!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:33'!
portno
	^portno! !

!PGConnectionArgs methodsFor: 'accessing' stamp: 'yj 2/24/2000 19:33'!
userName
	^userName! !

!PGConnectionArgs methodsFor: 'private-initialize' stamp: 'yj 2/24/2000 19:36'!
setHostname: host portno: port databaseName: database userName: user password: pwd extraArgs: extra debugTty: debug

	hostname _ host.
	portno _ port.
	databaseName _ database.
	userName _ user.
	password _ pwd.
	extraArgs _ extra.
	debugTty _ debug.
	^self! !


!PGConnectionArgs class methodsFor: 'instance creation' stamp: 'yj 2/24/2000 19:37'!
hostname: host portno: port databaseName: database userName: user password: pwd

	^self new setHostname: host portno: port databaseName: database userName: user password: pwd extraArgs: nil debugTty: nil
! !

!PGConnectionArgs class methodsFor: 'instance creation' stamp: 'yj 2/24/2000 19:35'!
hostname: host portno: port databaseName: database userName: user password: pwd extraArgs: extra debugTty: debug

	^self new setHostname: host portno: port databaseName: database userName: user password: pwd extraArgs: extra debugTty: debug
! !


!PGNotificationSubscriber methodsFor: 'api' stamp: 'yj 12/11/2002 12:23'!
receive: notice from: aConnection

	self logInfo: notice printString, ' received from ', aConnection logIdString.
! !


!PGPacket methodsFor: 'accessing' stamp: 'yj 3/5/2000 16:20'!
eventName
	^self subclassResponsibility! !

!PGPacket methodsFor: 'receiving' stamp: 'yj 2/25/2000 09:18'!
readBitmap: nbits from: connection

	| nbytes bitmap |

	nbytes _ (nbits + 7) // 8.
	bitmap _ ByteArray new: nbytes.
	1 to: nbytes do: [:i |
		bitmap at: i put: connection next asciiValue.
	].
	^bitmap
! !

!PGPacket methodsFor: 'receiving' stamp: 'yj 2/25/2000 10:26'!
readFieldFrom: connection

	| n tmp |

	n _ (self readInt32From: connection) - 4.
	tmp _ WriteStream on: String new.
	1 to: n do: [:i |
		tmp nextPut: connection next.
	].
	^tmp contents
! !

!PGPacket methodsFor: 'receiving' stamp: 'yj 2/24/2000 05:11'!
readInt16From: connection

	| value |

	value _ connection next asciiValue.
	value _ (value bitShift: 8) bitOr: connection next asciiValue.
	^value
! !

!PGPacket methodsFor: 'receiving' stamp: 'yj 2/24/2000 05:11'!
readInt32From: connection

	| value |

	value _ connection next asciiValue.
	value _ (value bitShift: 8) bitOr: connection next asciiValue.
	value _ (value bitShift: 8) bitOr: connection next asciiValue.
	value _ (value bitShift: 8) bitOr: connection next asciiValue.
	^value
! !

!PGPacket methodsFor: 'receiving' stamp: 'yj 2/24/2000 09:50'!
readStringFrom: connection

	| tmp ch |
	tmp _ WriteStream on: String new.
	[ (ch _ connection next) asciiValue ~= 0 ] whileTrue: [
		tmp nextPut: ch.
	].
	^tmp contents

! !

!PGPacket methodsFor: 'receiving' stamp: 'yj 2/24/2000 11:49'!
receiveFrom: connection

	"Read nothing, by default"
! !

!PGPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 05:46'!
writeByte: aCharacter on: aStream

	aStream
		nextPut: aCharacter;
		yourself.

! !

!PGPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 05:46'!
writeInt16: anInteger on: aStream

	aStream
		nextPut: (Character value: (anInteger digitAt: 2));
		nextPut: (Character value: (anInteger digitAt: 1));
		yourself.

! !

!PGPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 05:46'!
writeInt32: anInteger on: aStream

	aStream
		nextPut: (Character value: (anInteger digitAt: 4));
		nextPut: (Character value: (anInteger digitAt: 3));
		nextPut: (Character value: (anInteger digitAt: 2));
		nextPut: (Character value: (anInteger digitAt: 1));
		yourself.

! !

!PGPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 05:45'!
writeLimString: aString size: size on: aStream

	aString isNil ifTrue: [
		size timesRepeat: [ aStream nextPut: (Character value: 0) ].
		^aStream.
	].

	aString size < size
		ifTrue: [
			aStream nextPutAll: aString.
			(size - aString size max: 0) timesRepeat: [ aStream nextPut: (Character value: 0) ].
		]
		ifFalse: [
			aStream nextPutAll: (aString copyFrom: 1 to: size).
		].

	^aStream.
! !

!PGPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 05:45'!
writeOn: aStream

	self subclassResponsiblity
! !

!PGPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 05:45'!
writeString: aString on: aStream

	aStream
		nextPutAll: aString;
		nextPut: (Character value: 0);
		yourself.

! !

!PGPacket methodsFor: 'printing' stamp: 'yj 2/24/2000 11:52'!
printOn: aStream

	aStream nextPutAll: self class name.
! !


!PGAbstractStringResponse methodsFor: 'accessing' stamp: 'yj 4/22/2000 00:13'!
value
	^value! !

!PGAbstractStringResponse methodsFor: 'printing' stamp: 'yj 2/25/2000 16:30'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'value='; nextPutAll: value printString;
		nextPutAll: ')'
! !

!PGAbstractStringResponse methodsFor: 'receiving' stamp: 'yj 2/25/2000 16:30'!
receiveFrom: aStream

	value _ self readStringFrom: aStream.
! !


!PGAsciiRow methodsFor: 'accessing' stamp: 'yj 12/1/2000 14:05'!
data
	^ data! !

!PGAsciiRow methodsFor: 'accessing' stamp: 'yj 2/25/2000 10:06'!
description: aRowDescription
	description _ aRowDescription.
! !

!PGAsciiRow methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:33'!
eventName
	^#AsciiRow! !

!PGAsciiRow methodsFor: 'initialize' stamp: 'yj 2/25/2000 10:09'!
initialize

	data _ OrderedCollection new.
	^self! !

!PGAsciiRow methodsFor: 'printing' stamp: 'yj 3/9/2000 18:58'!
displayOn: aStream

	data withIndexDo: [:each :i |
		aStream nextPutAll: (each == nil ifTrue: ['0'] ifFalse: [each]).
		i < data size ifTrue: [aStream space].
	].
! !

!PGAsciiRow methodsFor: 'printing' stamp: 'yj 2/25/2000 11:24'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '('.
	data do: [:each | each printOn: aStream. aStream nextPut: $,].
	aStream nextPutAll: ')'.
! !

!PGAsciiRow methodsFor: 'receiving' stamp: 'yj 12/5/2002 15:32'!
receiveFrom: connection

	| ncol |

	description _ connection result rowDescription.
	ncol _ description numberOfColumns.
	nullFields _ self readBitmap: ncol from: connection.
	0 to: ncol - 1 do: [:i |
		((nullFields at: (i // 8) + 1) bitAnd: (2r10000000 bitShift: (i \\ 8) negated)) > 0
			ifTrue: [data add: (self readFieldFrom: connection)]
			ifFalse: [data add: nil].
	].
! !


!PGAuthentication methodsFor: 'accessing' stamp: 'yj 12/5/2002 18:03'!
eventName

	type > 6 ifTrue: [self error: 'Unknown authentication type'].

	^#(
		AuthenticationOk
		AuthenticationKerberosV4
		AuthenticationKerberosV5
		AuthenticationCleartextPassword
		AuthenticationCryptPassword
		AuthenticationMD5Password
		AuthenticationSCMCredential
	) at: (type + 1)
! !

!PGAuthentication methodsFor: 'accessing' stamp: 'yj 2/18/2000 19:12'!
salt
	^salt! !

!PGAuthentication methodsFor: 'accessing' stamp: 'yj 2/18/2000 19:12'!
salt: anInteger
	salt _ anInteger! !

!PGAuthentication methodsFor: 'accessing' stamp: 'yj 2/18/2000 20:28'!
type
	^type! !

!PGAuthentication methodsFor: 'accessing' stamp: 'yj 2/18/2000 20:28'!
type: anInteger
	type _ anInteger! !

!PGAuthentication methodsFor: 'printing' stamp: 'yj 2/24/2000 12:03'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'type='; nextPutAll: type printString;
		nextPutAll: ',salt='; nextPutAll: salt printString;
		nextPutAll: ')'
! !

!PGAuthentication methodsFor: 'receiving' stamp: 'yj 12/5/2002 17:49'!
receiveFrom: connection

	type _ self readInt32From: connection.
	type == 4 ifTrue: [ salt _ self readInt16From: connection ].
	type == 5 ifTrue: [ salt _ self readInt32From: connection ].
! !


!PGBackendKeyData methodsFor: 'accessing' stamp: 'yj 2/28/2000 21:05'!
eventName
	^#BackendKeyData! !

!PGBackendKeyData methodsFor: 'accessing' stamp: 'yj 2/18/2000 23:29'!
processId
	^processId! !

!PGBackendKeyData methodsFor: 'accessing' stamp: 'yj 2/18/2000 23:30'!
processId: anInteger
	processId _ anInteger! !

!PGBackendKeyData methodsFor: 'accessing' stamp: 'yj 2/18/2000 23:30'!
secretKey
	^secretKey! !

!PGBackendKeyData methodsFor: 'accessing' stamp: 'yj 2/18/2000 23:30'!
secretKey: anInteger
	secretKey _ anInteger! !

!PGBackendKeyData methodsFor: 'printing' stamp: 'yj 2/24/2000 12:02'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'processId='; nextPutAll: processId printString;
		nextPutAll: ',secretKey='; nextPutAll: secretKey printString;
		nextPutAll: ')'
! !

!PGBackendKeyData methodsFor: 'receiving' stamp: 'yj 2/24/2000 06:49'!
receiveFrom: aStream

	processId _ self readInt32From: aStream.
	secretKey _ self readInt32From: aStream.
! !


!PGBinaryRow methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:33'!
eventName
	^#BinaryRow! !


!PGCancelRequest methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:34'!
eventName
	^#CancelRequest! !

!PGCancelRequest methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:55'!
processId
	^processId! !

!PGCancelRequest methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:55'!
processId: anInteger
	processId _ anInteger! !

!PGCancelRequest methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:55'!
secretKey
	^secretKey! !

!PGCancelRequest methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:55'!
secretKey: anInteger
	secretKey _ anInteger! !

!PGCancelRequest methodsFor: 'sending' stamp: 'yj 12/9/2002 16:09'!
writeOn: aStream
	"Write a cancel request on the stream."

	"80877102 - The cancel request code.
	The value is chosen to contain 1234 in the most significant 16 bits,
	and 5678 in the least 16 significant bits. (To avoid confusion,
	this code must not be the same as any protocol version number.)
	"

	self writeInt32: 16 on: aStream.
	self writeInt32: 80877102 on: aStream. "major=1234, minor=5678"
	self writeInt32: self processId on: aStream.
	self writeInt32: self secretKey on: aStream.
! !


!PGColumnDescription methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:34'!
eventName
	^#ColumnDescription! !

!PGColumnDescription methodsFor: 'accessing' stamp: 'yj 12/1/2000 14:10'!
fieldName
	^ fieldName! !

!PGColumnDescription methodsFor: 'printing' stamp: 'yj 3/9/2000 18:44'!
displayOn: aStream

	aStream nextPutAll: fieldName.
! !

!PGColumnDescription methodsFor: 'printing' stamp: 'yj 2/25/2000 07:12'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'fieldName='; nextPutAll: fieldName printString;
		nextPutAll: ',typeOid='; nextPutAll: typeOid printString;
		nextPutAll: ',typeSize='; nextPutAll: typeSize printString;
		nextPutAll: ',typeModifier='; nextPutAll: typeModifier printString;
		nextPutAll: ')'
! !

!PGColumnDescription methodsFor: 'receiving' stamp: 'yj 2/25/2000 07:11'!
receiveFrom: connection

	fieldName _ self readStringFrom: connection.
	typeOid _ self readInt32From: connection.
	typeSize _ self readInt16From: connection.
	typeModifier _ self readInt32From: connection.
! !


!PGCompletedResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 16:19'!
eventName
	^#CompletedResponse! !

!PGCompletedResponse methodsFor: 'printing' stamp: 'yj 12/5/2002 17:31'!
displayOn: aStream

	aStream nextPutAll: value.
! !


!PGCopyInResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:34'!
eventName
	^#CopyInResponse! !


!PGCopyOutResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:35'!
eventName
	^#CopyOutResponse! !


!PGCursorResponse methodsFor: 'accessing' stamp: 'yj 2/28/2000 21:17'!
eventName
	^#CursorResponse! !


!PGEmptyQueryResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:35'!
eventName
	^#EmptyQueryResponse! !


!PGErrorResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:35'!
eventName
	^#ErrorResponse! !


!PGFunctionCall methodsFor: 'accessing' stamp: 'yj 2/8/2001 11:59'!
arguments
	^arguments! !

!PGFunctionCall methodsFor: 'accessing' stamp: 'yj 2/8/2001 11:59'!
arguments: value
	arguments _ value! !

!PGFunctionCall methodsFor: 'accessing' stamp: 'yj 2/8/2001 11:59'!
oid
	^oid! !

!PGFunctionCall methodsFor: 'accessing' stamp: 'yj 2/8/2001 11:59'!
oid: value
	oid _ value! !

!PGFunctionCall methodsFor: 'private-initialize' stamp: 'yj 2/8/2001 12:02'!
setOid: anInteger arguments: anArray

	oid _ anInteger.
	arguments _ anArray! !

!PGFunctionCall methodsFor: 'printing' stamp: 'yj 2/8/2001 14:06'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'oid='; nextPutAll: oid printString;
		nextPutAll: ',arguments='; nextPutAll: arguments printString;
		nextPutAll: ')'! !

!PGFunctionCall methodsFor: 'printing' stamp: 'yj 2/8/2001 18:50'!
writeOn: aStream

	self writeByte: $F on: aStream.
	self writeString: '' on: aStream.
	self writeInt32: self oid on: aStream.
	self writeInt32: self arguments size on: aStream.
	self arguments do: [:each |
		self writeInt32: each size on: aStream.
		"each printOn: aStream."
		1 to: each size do: [:b | aStream nextPut: (Character value: b)].
	].
! !


!PGFunctionResultResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:36'!
eventName
	^#FunctionResultResponse! !

!PGFunctionResultResponse methodsFor: 'printing' stamp: 'yj 2/8/2001 12:35'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'result='; nextPutAll: result printString;
		nextPutAll: ')'! !

!PGFunctionResultResponse methodsFor: 'receiving' stamp: 'yj 12/10/2002 13:28'!
receiveFrom: connection

	| emptyFlag resultSize |
	emptyFlag _ connection next asciiValue.
	emptyFlag == 71  "$G asciiValue == 71 indicates non-void response"
		ifTrue: [
			resultSize _ self readInt32From: connection.
			result _ ByteArray new: resultSize.
			1 to: resultSize do: [:i | result at: i put: connection next asciiValue].
			connection next. "toss the extra 0 byte"
	].
! !


!PGNoticeResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:36'!
eventName
	^#NoticeResponse! !


!PGNotificationResponse methodsFor: 'accessing' stamp: 'yj 12/9/2002 14:01'!
conditionName
	"Answer the value of conditionName"

	^ conditionName! !

!PGNotificationResponse methodsFor: 'accessing' stamp: 'yj 12/9/2002 14:01'!
conditionName: anObject
	"Set the value of conditionName"

	conditionName _ anObject! !

!PGNotificationResponse methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:36'!
eventName
	^#NotificationResponse! !

!PGNotificationResponse methodsFor: 'accessing' stamp: 'yj 12/9/2002 14:01'!
processId
	"Answer the value of processId"

	^ processId! !

!PGNotificationResponse methodsFor: 'accessing' stamp: 'yj 12/9/2002 14:01'!
processId: anObject
	"Set the value of processId"

	processId _ anObject! !

!PGNotificationResponse methodsFor: 'receiving' stamp: 'yj 12/9/2002 14:04'!
receiveFrom: connection

	processId _ self readInt32From: connection.
	conditionName _ self readStringFrom: connection.
! !


!PGPacket class methodsFor: 'initialize-release' stamp: 'yj 2/18/2000 23:49'!
initialize
	"PGPacket initialize"

	| types |

	PacketClasses _ OrderedCollection new.
	types _ ReadWriteStream on: String new.
	#(
		( $K 'PGBackendKeyData' )
		( $R 'PGAuthentication' )
		( $C 'PGCompletedResponse' )
		( $G 'PGCopyInResponse' )
		( $H 'PGCopyOutResponse' )
		( $P 'PGCursorResponse' )
		( $I 'PGEmptyQueryResponse' )
		( $E 'PGErrorResponse' )
		( $V 'PGFunctionResultResponse' )
		( $N 'PGNoticeResponse' )
		( $A 'PGNotificationResponse' )
		( $Z 'PGReadyForQuery' )
		( $T 'PGRowDescription' )
		( $D 'PGAsciiRow' )
		( $B 'PGBinaryRow' )
	) do: [:each |
		PacketClasses add: (Smalltalk classNamed: (each at: 2)).
		types nextPut: (each at: 1).
	].
	PacketTypes _ types contents.
! !

!PGPacket class methodsFor: 'factory' stamp: 'yj 2/18/2000 19:58'!
newPacket: typeCode

	| index |

	index _ PacketTypes indexOf: typeCode.
	^index > 0
		ifTrue: [ (PacketClasses at: index) new ]
		ifFalse: [ nil ]

! !


!PGAsciiRow class methodsFor: 'instance creation' stamp: 'yj 2/25/2000 08:41'!
description: aRowDescription

	^self new
		description: aRowDescription;
		yourself.
! !

!PGAsciiRow class methodsFor: 'instance creation' stamp: 'yj 2/25/2000 08:33'!
new

	^self basicNew initialize.
! !


!PGCancelRequest class methodsFor: 'instance creation' stamp: 'yj 12/9/2002 16:10'!
processId: pid secretKey: secretKey

	^self new
		processId: pid;
		secretKey: secretKey;
		yourself.
! !


!PGFunctionCall class methodsFor: 'instance creation' stamp: 'yj 12/11/2002 17:55'!
oid: anInteger arguments: aCollection
	"Return a new instance of the receiver.

	'anInteger' specifies the object ID of the function to call. The object ID is a site specific PostgreSQL value.
	'aCollection' contains the arguments of the function call. It should contain String values, which may have non-printable characters (i.e. values 0..255).
	"

	^ self new setOid: anInteger arguments: aCollection
! !


!PGPasswordPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:47'!
password
	^password! !

!PGPasswordPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:47'!
password: aString
	password _ aString! !

!PGPasswordPacket methodsFor: 'sending' stamp: 'yj 4/22/2000 22:49'!
writeOn: aStream

	"Add 5 for the 32bit size header, and add 1 for the '\0' after the string"

	self writeInt32: self password size + 5 on: aStream.
	self writeString: self password on: aStream.
! !

!PGPasswordPacket methodsFor: 'printing' stamp: 'yj 4/22/2000 22:28'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'password='; nextPutAll: password printString;
		nextPutAll: ')'! !


!PGPasswordPacket class methodsFor: 'instance creation' stamp: 'yj 4/22/2000 22:06'!
password: aString

	^self new
		password: aString;
		yourself.
! !


!PGQuery methodsFor: 'accessing' stamp: 'yj 2/28/2000 21:17'!
eventName
	^#Query! !

!PGQuery methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:39'!
queryString
	^queryString! !

!PGQuery methodsFor: 'accessing' stamp: 'yj 2/18/2000 17:39'!
queryString: aString
	queryString _ aString! !

!PGQuery methodsFor: 'printing' stamp: 'yj 2/24/2000 11:54'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'queryString='; nextPutAll: queryString printString;
		nextPutAll: ')'! !

!PGQuery methodsFor: 'sending' stamp: 'yj 2/18/2000 17:38'!
writeOn: aStream

	self writeByte: $Q on: aStream.
	self writeString: self queryString on: aStream.
! !


!PGQuery class methodsFor: 'instance creation' stamp: 'yj 2/24/2000 08:52'!
sql: aString

	^self new
		queryString: aString;
		yourself.
! !


!PGReadyForQuery methodsFor: 'accessing' stamp: 'yj 2/28/2000 21:06'!
eventName
	^#ReadyForQuery! !


!PGResult methodsFor: 'initialize' stamp: 'yj 12/11/2002 17:27'!
initialize

	resultSets _ OrderedCollection new.
! !

!PGResult methodsFor: 'initialize' stamp: 'yj 12/11/2002 17:27'!
reset
	"Clear the previous results in preparation to hold new query results."

	"There's an opportunity to tweak the code here for performance.
	If the result sets are cleared each time, then there's a lot of
	re-allocation. But, if the old results are just cleared, an earlier
	large result set may cause a large collection to remain in memory.
	Maybe it's just better to let GC handle it.
	"

	self errorResponse: nil.
	self functionResult: nil.
	self resultSets reset.
! !

!PGResult methodsFor: 'accessing' stamp: 'yj 12/11/2002 17:25'!
errorResponse
	^ errorResponse! !

!PGResult methodsFor: 'accessing' stamp: 'yj 2/6/2001 10:57'!
errorResponse: value
	errorResponse _ value! !

!PGResult methodsFor: 'accessing' stamp: 'yj 12/11/2002 17:25'!
functionResult
	^ functionResult! !

!PGResult methodsFor: 'accessing' stamp: 'yj 2/8/2001 19:17'!
functionResult: value
	functionResult _ value! !

!PGResult methodsFor: 'accessing' stamp: 'yj 12/11/2002 17:26'!
resultSets
	^ resultSets! !

!PGResult methodsFor: 'accessing' stamp: 'yj 12/11/2002 17:26'!
resultSets: value
	resultSets _ value! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:28'!
addResultSet

	resultSets add: PGResultSet new.
! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:29'!
completedResponse

	^ self lastResultSet completedResponse! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:29'!
completedResponse: value

	self lastResultSet completedResponse: value! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:28'!
lastResultSet

	^ resultSets last! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:29'!
rowDescription

	^ self lastResultSet rowDescription! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:29'!
rowDescription: value

	self lastResultSet rowDescription: value! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:29'!
rows

	^ self lastResultSet rows! !

!PGResult methodsFor: 'accessing-convenience' stamp: 'yj 12/11/2002 17:29'!
rows: value

	self lastResultSet rows: value! !

!PGResult methodsFor: 'printing' stamp: 'yj 12/11/2002 18:46'!
displayResultOn: aStream

	errorResponse isNil ifFalse: [
		aStream nextPutAll: errorResponse value.
		aStream cr].

	resultSets do: [:each | each displayResultSetOn: aStream].
! !


!PGResult class methodsFor: 'instance creation' stamp: 'yj 2/6/2001 11:07'!
new
	^self basicNew initialize! !


!PGResultSet methodsFor: 'initialize' stamp: 'yj 12/4/2002 21:49'!
initialize

	rows _ OrderedCollection new.! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/5/2002 17:21'!
completedResponse
	"Answer the value of completedResponse"

	^ completedResponse! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/5/2002 17:21'!
completedResponse: anObject
	"Set the value of completedResponse"

	completedResponse _ anObject! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/4/2002 21:50'!
rowDescription
	"Answer the value of rowDescription"

	^ rowDescription! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/4/2002 21:50'!
rowDescription: anObject
	"Set the value of rowDescription"

	rowDescription _ anObject! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/4/2002 21:50'!
rows
	"Answer the value of rows"

	^ rows! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/4/2002 21:50'!
rows: anObject
	"Set the value of rows"

	rows _ anObject! !

!PGResultSet methodsFor: 'accessing' stamp: 'yj 12/4/2002 21:58'!
valueAt: fieldName

	| i |
	i _ rowDescription columnDescriptions findFirst: [:each | each fieldName = fieldName].
	i = 0 ifTrue: [^ nil].
	rows == nil ifTrue: [^ nil].
	^ (rows at: 1) data at: i! !

!PGResultSet methodsFor: 'printing' stamp: 'yj 12/11/2002 18:44'!
displayResultSetOn: aStream

	completedResponse isNil ifFalse: [
		completedResponse displayOn: aStream.
		aStream cr.
	].
	rowDescription isNil ifFalse: [
		self displayRowDescriptionOn: aStream.
		aStream cr; nextPutAll: '----------'; cr.
		self displayRowsOn: aStream.
		aStream nextPut: $(.
		rows size printOn: aStream.
		aStream nextPutAll: ' row'.
		rows size > 1 ifTrue: [aStream nextPut: $s].
		aStream nextPut: $); cr; cr.
	].
! !

!PGResultSet methodsFor: 'printing' stamp: 'yj 12/4/2002 21:56'!
displayRowDescriptionOn: aStream.

	rowDescription displayOn: aStream.
! !

!PGResultSet methodsFor: 'printing' stamp: 'yj 12/4/2002 21:56'!
displayRowsOn: aStream

	rows do: [:each | each displayOn: aStream. aStream cr.].
! !


!PGResultSet class methodsFor: 'instance creation' stamp: 'yj 12/5/2002 00:06'!
new
	^self basicNew initialize! !


!PGRowDescription methodsFor: 'accessing' stamp: 'yj 12/1/2000 14:08'!
columnDescriptions
	^ columnDescriptions! !

!PGRowDescription methodsFor: 'accessing' stamp: 'yj 3/5/2000 20:33'!
eventName
	^#RowDescription! !

!PGRowDescription methodsFor: 'accessing' stamp: 'yj 2/25/2000 08:50'!
numberOfColumns
	^numberOfColumns! !

!PGRowDescription methodsFor: 'initialize' stamp: 'yj 2/25/2000 08:49'!
initialize

	numberOfColumns _ 0.
	columnDescriptions _ OrderedCollection new.
! !

!PGRowDescription methodsFor: 'printing' stamp: 'yj 3/9/2000 18:43'!
displayOn: aStream

	columnDescriptions withIndexDo: [:each :i |
		each displayOn: aStream.
		i < columnDescriptions size ifTrue: [aStream space].
	].
! !

!PGRowDescription methodsFor: 'printing' stamp: 'yj 2/25/2000 07:16'!
printOn: aStream

	super printOn: aStream.
	aStream nextPutAll: '('; cr.
	columnDescriptions do: [:each | each printOn: aStream. aStream cr].
	aStream nextPutAll: ')'.
! !

!PGRowDescription methodsFor: 'receiving' stamp: 'yj 2/25/2000 10:15'!
receiveFrom: connection

	numberOfColumns _ self readInt16From: connection.
	1 to: numberOfColumns do: [:i |
		columnDescriptions add: (PGColumnDescription new receiveFrom: connection; yourself).
	].
! !


!PGRowDescription class methodsFor: 'instance creation' stamp: 'yj 2/25/2000 07:08'!
new

	^self basicNew initialize.
! !


!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:57'!
byteCount
	^296
! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:54'!
databaseName
	^databaseName
! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:56'!
databaseName: aString
	databaseName _ aString
! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:55'!
debugTty
	^debugTty! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:56'!
debugTty: aString
	debugTty _ aString! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:54'!
extraArgs
	^extraArgs! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:56'!
extraArgs: aString
	extraArgs _ aString! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:54'!
userName
	^userName! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:57'!
userName: aString
	userName _ aString! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:57'!
version
	^version
! !

!PGStartupPacket methodsFor: 'accessing' stamp: 'yj 2/18/2000 16:58'!
version: anInteger
	version _ anInteger
! !

!PGStartupPacket methodsFor: 'private-initialize' stamp: 'yj 2/20/2000 15:00'!
setDatabaseName: database userName: user

	^self
		version: (2 bitShift: 16); "major=2 minor=0"
		databaseName: database;
		userName: user;
		yourself! !

!PGStartupPacket methodsFor: 'printing' stamp: 'yj 2/24/2000 11:57'!
printOn: aStream

	super printOn: aStream.
	aStream
		nextPutAll: '(';
		nextPutAll: 'databaseName='; nextPutAll: databaseName printString;
		nextPutAll: ',userName='; nextPutAll: userName printString;
		nextPutAll: ',extraArgs='; nextPutAll: extraArgs printString;
		nextPutAll: ',debugTty='; nextPutAll: debugTty printString;
		nextPutAll: ',version='; nextPutAll: version printString;
		nextPutAll: ')'
! !

!PGStartupPacket methodsFor: 'sending' stamp: 'yj 2/24/2000 08:38'!
writeOn: aStream

	self writeInt32: self byteCount on: aStream.
	self writeInt32: self version on: aStream.
	self writeLimString: self databaseName size: 64 on: aStream.
	self writeLimString: self userName size: 32 on: aStream.
	self writeLimString: self extraArgs size: 64 on: aStream.
	self writeLimString: nil size: 64 on: aStream. "unused"
	self writeLimString: self debugTty size: 64 on: aStream.
! !


!PGStartupPacket class methodsFor: 'instance creation' stamp: 'yj 2/24/2000 08:55'!
databaseName: database userName: user

	^self new
		setDatabaseName: database userName: user;
		yourself! !


!PGTerminate methodsFor: 'sending' stamp: 'yj 2/18/2000 17:34'!
writeOn: aStream

	self writeByte: $X on: aStream.
! !


!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 18:17'!
createTestTable

	self executeAll: #(
			'CREATE TABLE products (
				product_no integer,
				name text,
				price numeric
			)'
		).
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 18:17'!
dropTestTable

	self executeAll: #(
			'DROP TABLE products'
		).
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 19:10'!
makeCopyInOutEos
	"Answer the COPY IN/OUT end of stream code."

	^ String with: $\ with: $.with: Character lf
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 13:40'!
makeCopyInOutLine: aCollection

	| ws |
	ws := WriteStream on: (String new: 512).
	aCollection withIndexDo: [:each :i |
		ws nextPutAll: each.
		i < aCollection size ifTrue: [ws tab]
	].
	ws nextPut: Character lf.
	^ ws contents.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 17:13'!
oidAbs
	"oid 1395 is abs(float8)"
	^ 1395
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 17:13'!
oidSqrt
	"oid 1344 is sqrt(float8)"
	^ 1344
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 17:10'!
oidTimenow

	^ 250
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/12/2002 01:08'!
testCancelRequest
	"Test: CancelRequest.

	Set the debug level of the postmaster daemon to 1 or greater.
	Capture the postmaster output in a log file.
	Examine the log file for a cancel request with a matching process id.

	Example, an init.d script containing:
		su -l postgres -s /bin/sh -c ""/usr/bin/pg_ctl  -D $PGDATA -p /usr/bin/postmaster -o '-i -d 1' start  > /var/log/postgresql/log 2>&1"" < /dev/null
	yields a line in the log:
		/usr/bin/postmaster: processCancelRequest: sending SIGINT to process 13142
	"

	| conn |

	conn _ self newConnection.
	conn startup.
	conn cancelRequest.
	conn terminate.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 15:43'!
testConnection
	"Test: connect and disconnect, without any queries."

	self executeAll: #().
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 21:13'!
testCopyIn1

	| ws conn result |
	ws _ WriteStream on: String new.
	ws nextPutAll: self makeCopyInOutEos.

	self dropTestTable.
	self createTestTable.

	conn _ self newConnection.
	conn startup.
	conn copy: 'copy products from stdin' withStream: ws.
	result _ conn execute: 'select * from products'.
	conn terminate.

	self assert: result rows size = 0.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 20:54'!
testCopyIn2

	| ws result conn |

	self dropTestTable.
	self createTestTable.

	ws _ WriteStream on: String new.
	ws nextPutAll: (self makeCopyInOutLine: (Array with: '77' with: 'abcde' with: '123.456')).
	ws nextPutAll: self makeCopyInOutEos.

	conn _ self newConnection.
	conn startup.
	conn copy: 'copy products from stdin' withStream: ws.
	result _ conn execute: 'select * from products'.
	conn terminate.
	self assert: result rows size = 1.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 18:28'!
testCopyOut1

	| ws |
	self dropTestTable.
	self createTestTable.
	ws _ WriteStream on: (String new: 512).
	self copy: 'copy products to stdout' withStream: ws.
	"Transcript show: ws contents printString; cr."
	self assert: ws contents = (String with: $\ with: $. with: Character lf).
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/12/2002 01:07'!
testCopyOut2

	| ws rs |

	ws _ WriteStream on: String new.
	ws nextPutAll: (self makeCopyInOutLine: (Array with: '77' with: 'abcde' with: '123.456000')).
	ws nextPutAll: self makeCopyInOutEos.

	self dropTestTable.
	self createTestTable.
	self executeAll: #('insert into products values(77,''abcde'',123.456)').

	rs _ WriteStream on: (String new: 512).
	self copy: 'copy products to stdout' withStream: rs.

	self assert: rs contents = ws contents.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/12/2002 01:04'!
testCopyOut3

	| ws rs |

	ws _ WriteStream on: String new.
	ws nextPutAll: (self makeCopyInOutLine: (Array with: '77' with: 'abcde' with: '123.456000')).
	ws nextPutAll: (self makeCopyInOutLine: (Array with: '88' with: 'vwxyz' with: '999.999000')).
	ws nextPutAll: self makeCopyInOutEos.

	self dropTestTable.
	self createTestTable.
	self executeAll: #('insert into products values(77,''abcde'',123.456)').
	self executeAll: #('insert into products values(88,''vwxyz'',999.999)').

	rs _ WriteStream on: (String new: 512).
	self copy: 'copy products to stdout' withStream: rs.

	self assert: rs contents = ws contents.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 2/8/2001 21:20'!
testExecute1

	self executeAll: #(
			'select timenow()'
			'select abs(-1)'
		).
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/10/2002 22:14'!
testExecute2

	self executeAll: #(
			'select timenow(); select abs(-1)'
		).
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/5/2002 22:52'!
testExecuteUsingConnectionDefaults

	useConnectionDefaults _ true.
	self executeAll: #(
			'select timenow()'
			'select abs(-1)'
		).
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 17:10'!
testFunctionCall
	"Test: make several function calls before terminating."

	| conn result arg |
	arg _ self asFloat8Arg: 1.0 bigEndian: false.
	conn _ self newConnection.
	conn startup.
	result _ conn functionCall: self oidTimenow arguments: OrderedCollection new.
	result _ conn functionCall: self oidAbs arguments: (OrderedCollection with: arg).
	result _ conn functionCall: self oidSqrt arguments: (OrderedCollection with: arg).
	conn terminate.
	^ result
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 15:52'!
testFunctionCall1

	| result |
	result _ self functionCall: self oidTimenow arguments: OrderedCollection new.
	self assert: result functionResult notNil.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 15:54'!
testFunctionCall2

	| arg result |
	arg _ self asFloat8Arg: 1.0 bigEndian: false.
	result _  self functionCall: self oidAbs arguments: (OrderedCollection with: arg).
	self assert: result functionResult notNil.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 15:55'!
testFunctionCall3

	| arg result |
	arg _ self asFloat8Arg: 1.0 bigEndian: false.
	result _ self functionCall: self oidSqrt arguments: (OrderedCollection with: arg).
	self assert: result functionResult notNil.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 17:35'!
testNotify1

	notificationSubscriberCount _ 1.

	[
		self executeAll: #(
			'notify pgtest' 'notify pgtest' 'notify pgtest' 'notify pgtest' 'notify pgtest'
			'notify pgtest' 'notify pgtest' 'notify pgtest' 'notify pgtest' 'notify pgtest'
		) withDelayForMilliseconds: 1000
	] fork.

	self executeAll: #(
		'listen pgtest'
		'select timenow()'
		'select timenow()'
	) withDelayForMilliseconds: 5000
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 13:49'!
testNotify2
	"Test: a NoticeResponse will be sent because there is an extra field on the input line."

	| ws conn |

	notificationSubscriberCount _ 2.

	self dropTestTable.
	self createTestTable.

	ws _ WriteStream on: String new.
	ws nextPutAll: (self makeCopyInOutLine: (Array with: '77' with: 'abcde' with: '123.456' with: '999.999')).
	ws nextPutAll: self makeCopyInOutEos.

	conn _ self newConnection.
	conn startup.
	conn copy: 'copy products from stdin' withStream: ws.
	conn terminate.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 17:44'!
testResultSet1

	| conn result |

	self dropTestTable.
	self createTestTable.

	conn _ self newConnection.
	conn startup.
	result _ conn execute: 'insert into products values(77,''abcde'',123.456)'.
	result _ conn execute: 'select * from products'.
	conn terminate.

	self assert: result rows size = 1.
! !

!TestPGConnection methodsFor: 'tests' stamp: 'yj 12/11/2002 17:49'!
testResultSet2

	| conn result rs1 rs2 |

	self dropTestTable.
	self createTestTable.

	conn _ self newConnection.
	conn startup.
	result _ conn execute: 'insert into products values(49,''abcde'',123.456)'.
	result _ conn execute: 'insert into products values(50,''abcde'',123.456)'.
	result _ conn execute: 'insert into products values(51,''abcde'',123.456)'.
	result _ conn execute: 'insert into products values(52,''abcde'',123.456)'.
	result _ conn execute: 'select * from products; select * from products where product_no > 50'.
	conn terminate.

	rs1 _ result resultSets at: 1.
	self assert: rs1 rows size = 4.

	rs2 _ result resultSets at: 2.
	self assert: rs2 rows size = 2.
! !

!TestPGConnection methodsFor: 'postgres test suite' stamp: 'yj 12/11/2002 18:46'!
regress: testName

	| inStream conn outStream line pos result sql |

	Transcript show: testName, '--starting test'; cr.
	conn _ self newConnection.
	conn startup.

	inStream _ FileStream readOnlyFileNamed: 'u:\lib\pgsql\test\regress\sql\', testName, '.sql'.
	outStream _ FileStream newFileNamed: testName, '.out'.
	sql _ ''.
	[inStream atEnd] whileFalse: [
		line _ inStream upTo: Character lf.
		(line beginsWith: '--')
			ifTrue: [outStream nextPutAll: line; cr].
		(line size > 0 and: [(line beginsWith: '--') not]) ifTrue: [
			pos _ line findString: '\g'. "\g is psql execute command"
			pos > 0 ifTrue: [line _ line copyFrom: 1 to: pos - 1].
			sql _ sql, line, String cr.
			(line endsWith: ';') ifTrue: [
				result _ conn execute: sql.
				Transcript show: sql; endEntry.
				outStream nextPutAll: sql.
				result displayResultOn: outStream.
				sql _ ''.
			].
		].
	].
	inStream close.
	outStream close.

	conn terminate.
	Transcript show: testName, '--test completed'; cr.
! !

!TestPGConnection methodsFor: 'postgres test suite' stamp: 'yj 2/8/2001 21:18'!
regressionTestNames

	^#(
		#('boolean' 'char' 'name' 'varchar' 'text' 'int2' 'int4' 'int8' 'oid' 'float4' 'float8' 'numeric')
		'strings'
		'numerology'
		#('point' 'lseg' 'box' 'path' 'polygon' 'circle' 'interval' 'timestamp' 'reltime' 'tinterval' 'inet' 'comments' 'oidjoins' 'type_sanity' 'opr_sanity')
		'abstime'
		'geometry'
		'horology'
		'create_function_1'
		'create_type'
		'create_table'
		'create_function_2'
		'copy'
		#('constraints' 'triggers' 'create_misc' 'create_aggregate' 'create_operator' 'create_index')
		'create_view'
		'sanity_check'
		'errors'
		'select'
		#('select_info' 'select_distinct' 'select_distinct_on' 'select_implicit' 'select_having' 'subselect' 'union' 'case' 'join' 'aggregates' 'transactions' 'random' 'portals' 'arrays' 'btree_index' 'hash_index')
		'misc'
		#('select_views' 'alter_table' 'portals_p2' 'rules' 'foreign_key')
		#('limit' 'plpgsql' 'temp')
	)! !

!TestPGConnection methodsFor: 'postgres test suite' stamp: 'yj 2/8/2001 22:06'!
runRegressionTests
	"TestPGConnection new runRegressionTests"

	self regress: 'drop'.
	(self regressionTestNames at: 1) do: [:each | self regress: each].
	"self regressionTestNames do: [:test |
		test isString
			ifTrue: [self regress: test]
			ifFalse: [test do: [:each | self regress: each]]
	]."
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/10/2002 16:48'!
asFloat8Arg: aFloat bigEndian: bigEndian
	"Convert aFloat to a ByteArray for use as a function call argument."

	| word1 word2 arg tmp |

	"The placement of the bits appears to be machine dependent.
	Beware, if the database and client have different endianess.
	Linux on SPARC is big-endian.
	WinNT4.0 on Intel is little-endian."

	word1 _ aFloat basicAt: 1.
	word2 _ aFloat basicAt: 2.
	bigEndian ifTrue: [
			tmp _ word1.
			word1 _ word2.
			word2 _ tmp.
		].
	arg _ ByteArray new: 8.
	arg unsignedLongAt: 1 put: word1 bigEndian: bigEndian.
	arg unsignedLongAt: 5 put: word2 bigEndian: bigEndian.
	^ arg
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/5/2002 20:40'!
copy: sql withStream: aStream

	| conn |
	conn _ self newConnection.
	conn startup.
	conn copy: sql withStream: aStream.
	conn terminate.! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/11/2002 18:45'!
execute: sql on: conn

	| result resultStream |

	resultStream _ ReadWriteStream on: String new.
	result _ conn execute: sql.
	result displayResultOn: resultStream.
	^ resultStream contents.
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/9/2002 13:33'!
executeAll: queries

	self executeAll: queries withDelayForMilliseconds: nil! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/11/2002 18:45'!
executeAll: queries withDelayForMilliseconds: millisecondDelay

	| conn result |

	conn _ self newConnection.
	conn startup.
	queries do: [:each |
		Transcript nextPutAll: 'QUERY: '; nextPutAll: each; cr; endEntry.
		result _ conn execute: each.
		result displayResultOn: Transcript.
		Transcript endEntry.
		millisecondDelay isNil ifFalse: [
			Transcript nextPutAll: 'Delaying for ', millisecondDelay printString, ' ms...'; cr.
			(Delay forMilliseconds: millisecondDelay) wait.
			Transcript endEntry.
		].
	].
	conn terminate.! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/10/2002 12:48'!
functionCall: oid arguments: arguments

	| conn result |
	conn _ self newConnection.
	conn startup.
	result _ conn functionCall: oid arguments: arguments.
	conn terminate.
	^ result
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/11/2002 13:48'!
newConnection

	| conn |

	conn _ PGConnection new.
	(useConnectionDefaults isNil or: [useConnectionDefaults not])
		ifTrue: [ conn connectionArgs: self newConnectionArgs ].
	(notificationSubscriberCount notNil and: [notificationSubscriberCount > 0 ])
		ifTrue: [
			1 to: notificationSubscriberCount do: [:i |
				conn addNotificationSubscriber: PGNotificationSubscriber new]
		].
	^ conn
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/11/2002 11:39'!
newConnectionArgs
	"Answer a new instance of connection args for a database that can be used to run the test suite."

	^ PGConnectionArgs
		hostname: '192.168.2.6'
		portno: 5432
		databaseName: 'panda'
		userName: 'yanni'
		password: nil
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/11/2002 11:41'!
setUp

	PGConnection defaultConnectionArgs: self newConnectionArgs.
! !

!TestPGConnection methodsFor: 'private' stamp: 'yj 12/11/2002 11:41'!
tearDown

	PGConnection defaultConnectionArgs: nil.
! !

TestPGConnection removeSelector: #makeCopyInOutTestData!
TestPGConnection removeSelector: #testExecuteNone!

!PGStartupPacket reorganize!
('accessing' byteCount databaseName databaseName: debugTty debugTty: extraArgs extraArgs: userName userName: version version:)
('private-initialize' setDatabaseName:userName:)
('printing' printOn:)
('sending' writeOn:)
!


!PGRowDescription reorganize!
('accessing' columnDescriptions eventName numberOfColumns)
('initialize' initialize)
('printing' displayOn: printOn:)
('receiving' receiveFrom:)
!

PGResultSet removeSelector: #displayOn:!
PGResultSet removeSelector: #displayResultOn:!
PGResult removeSelector: #displayResultSetOn:!
PGResult removeSelector: #lastResult!
PGResult removeSelector: #results!
PGResult removeSelector: #results:!

!PGResult reorganize!
('initialize' initialize reset)
('accessing' errorResponse errorResponse: functionResult functionResult: resultSets resultSets:)
('accessing-convenience' addResultSet completedResponse completedResponse: lastResultSet rowDescription rowDescription: rows rows:)
('printing' displayResultOn:)
!


!PGReadyForQuery reorganize!
('accessing' eventName)
!


!PGAsciiRow class reorganize!
('instance creation' description: new)
!

PGPacket initialize!

!PGNotificationResponse reorganize!
('accessing' conditionName conditionName: eventName processId processId:)
('receiving' receiveFrom:)
!


!PGNoticeResponse reorganize!
('accessing' eventName)
!


!PGFunctionResultResponse reorganize!
('accessing' eventName)
('printing' printOn:)
('receiving' receiveFrom:)
!


!PGFunctionCall reorganize!
('accessing' arguments arguments: oid oid:)
('private-initialize' setOid:arguments:)
('printing' printOn: writeOn:)
!


!PGErrorResponse reorganize!
('accessing' eventName)
!


!PGEmptyQueryResponse reorganize!
('accessing' eventName)
!


!PGCursorResponse reorganize!
('accessing' eventName)
!


!PGCopyOutResponse reorganize!
('accessing' eventName)
!


!PGCopyInResponse reorganize!
('accessing' eventName)
!


!PGCompletedResponse reorganize!
('accessing' eventName)
('printing' displayOn:)
!


!PGColumnDescription reorganize!
('accessing' eventName fieldName)
('printing' displayOn: printOn:)
('receiving' receiveFrom:)
!


!PGBinaryRow reorganize!
('accessing' eventName)
!


!PGAsciiRow reorganize!
('accessing' data description: eventName)
('initialize' initialize)
('printing' displayOn: printOn:)
('receiving' receiveFrom:)
!

PGPacket removeSelector: #test1!

!PGPacket reorganize!
('accessing' eventName)
('receiving' readBitmap:from: readFieldFrom: readInt16From: readInt32From: readStringFrom: receiveFrom:)
('sending' writeByte:on: writeInt16:on: writeInt32:on: writeLimString:size:on: writeOn: writeString:on:)
('printing' printOn:)
!


!PGNotificationSubscriber reorganize!
('api' receive:from:)
!


!PGConnectionArgs reorganize!
('accessing' databaseName debugTty extraArgs hostname password portno userName)
('private-initialize' setHostname:portno:databaseName:userName:password:extraArgs:debugTty:)
!


!PGConnection class reorganize!
('initialization' buildDefaultConnectionArgs buildStateTransitionTable)
('accessing' defaultConnectionArgs defaultConnectionArgs: defaultTraceLevel defaultTraceLevel:)
('instance creation' new)
!



More information about the Squeak-dev mailing list