From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 1:13:03 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>DB2SQLAssist</name> <environment>Store</environment> <super>Store.SQLAssist</super> <private>false</private> none <imports></imports> <category>Store-DB2</category> <attributes> <package>StoreForDB2</package> </attributes> </class> <comment> Store.DB2SQLAssist
Sql generator for DB2/UDB 7.1
</comment> <class> <name>DB2SQLAssist72</name> <environment>Store</environment> <super>Store.DB2SQLAssist</super> <private>false</private> none <imports></imports> <category>Store-DB2</category> <attributes> <package>StoreForDB2</package> </attributes> </class> <comment> Store.DB2SQLAssist72
Sql generator for DB2/UDB 7.2
</comment> <class> <name>DB2Broker</name> <environment>Store</environment> <super>Store.SQLBroker</super> <private>false</private> none <imports></imports> <category>Store-DB2</category> <attributes> <package>StoreForDB2</package> </attributes> </class> <comment> Store.DB2Broker
Interface to DB2/UDB database. Class Variables: Signals <ExceptionSet of signals> DB2 signals.
</comment> <class> <name>DB2Broker72</name> <environment>Store</environment> <super>Store.DB2Broker</super> <private>false</private> none <imports></imports> <category>Store-DB2</category> <attributes> <package>StoreForDB2</package> </attributes> </class> <comment> Store.DB2Broker72
Interface to DB2/UDB 7.2 database. Class Variables: Signals <ExceptionSet of signals> DB2 signals.
</comment> <class> <name>DB2Connection72</name> <environment>Smalltalk</environment> <super>Database.DB2Connection</super> <private>false</private> none <imports></imports> <category>Store-DB2</category> <attributes> <package>StoreForDB2</package> </attributes> </class> <name>MaxLongBytes</name> <environment>Store.DB2Broker</environment> <private>false</private> <constant>false</constant> <category>properties</category> <initializer>3990</initializer> <attributes> <package>StoreForDB2</package> </attributes> <name>Signals</name> <environment>Store.DB2Broker</environment> <private>false</private> <constant>false</constant> <category>signals</category> <attributes> <package>StoreForDB2</package> </attributes> <name>UseTableSpaceSpecification</name> <environment>Store.DB2Broker</environment> <private>false</private> <constant>false</constant> <category>properties</category> <initializer>false</initializer> <attributes> <package>StoreForDB2</package> </attributes> <name>IdentityOption</name> <environment>Store.DB2Broker</environment> <private>false</private> <constant>false</constant> <category>properties</category> <attributes> <package>StoreForDB2</package> </attributes> <methods> Store.DB2SQLAssist <category>special</category>
recordsWithSourcesIn: aPrimaryKey butNotIn: bPrimaryKey "copied from ViewRecord>>recordsWithSourcesIn: butNotIn: " | table2 | self selectAll; where; column: #packageRef equalTo: aPrimaryKey printString; and; column: #primaryKey; in; beginClause; addString: ( tableClass subCollectionClass newSQL alias: 'T1'; select: ( Array with: tableClass childReference ); leftJoin: (table2 := tableClass subCollectionClass newSQL alias: 'T2'); column: tableClass childReference equalTo: (table2 joinedColumn: tableClass childReference); and; addString: (table2 joinedColumn: #packageRef); equal; addString: (bPrimaryKey printString); where; column: #packageRef equalTo: aPrimaryKey printString; and; addString: (table2 joinedColumn: tableClass childReference); isNull) endClause; yourself. ^ sqlStream contents
</methods> <methods> Store.DB2SQLAssist <category>private</category>
removePrimaryKeyColumn: anArray " In DB2 v7 #PrimaryKey column is identity type. It will be inserted automaticaly" ^ anArray select: [ :col | (col equivalentTo: 'primarykey' ignoreCase: true) not ]
removePrimaryKeyValue: anArray " In DB2 v7 #PrimaryKey column is identity type. It will be inserted automaticaly" ^ anArray select: [ :col | (col equivalentTo: ':primarykey' ignoreCase: true) not ]
valuesFor: aValuesString sqlStream nextPutAll: ' VALUES ( ', aValuesString, ' )'. ^sqlStream contents
</methods> <methods> Store.DB2SQLAssist72 <category>private</category>
removePrimaryKeyColumn: anArray " In DB2 v7 #PrimaryKey column is identity type. It will be inserted automaticaly" ^ anArray
removePrimaryKeyValue: anArray " In DB2 v7 #PrimaryKey column is identity type. It will be inserted automaticaly" ^ anArray
</methods> <methods> Store.DB2Broker class <category>create objects</category>
addIdentityFor: aColumn " For #PrimaryKey columns we add identity property. Identity columns are commonly used in conjunction with PRIMARY KEY constraints to serve as the unique row identifier for the table. " ^ (aColumn equivalentTo: 'primarykey' ignoreCase: true) ifTrue: [' GENERATED ', IdentityOption key, ' AS IDENTITY (START WITH ', IdentityOption value printString,' )'] ifFalse: [ String new]
addPrimaryKey: aKeyString onTable: aTableName "Add primary key constraint on table" self performCreate: [ self processSQL: 'ALTER TABLE ', aTableName, ' ADD CONSTRAINT PK PRIMARY KEY (' , aKeyString, ')'] for: aTableName
createDatabaseSequence: aClass " Do nothing "
createDatabaseTable: aClass "Create a new table." | aKeyCollection aStream pkStream columnsString | aKeyCollection := OrderedCollection new. aStream := (String new: 100) writeStream. aStream nextPutAll: (self createDatabaseTableColumnsFor: aClass keyNames: aKeyCollection). "aStream nextPutAll: (self createTablePrimaryKeySectionFor: aClass keys: aKeyCollection)." aStream skip: -2. columnsString := ' ( ' , aStream contents , ' ) '. UseTableSpaceSpecification ifTrue: [columnsString := columnsString , ' in ' , aClass db2TableSpaceName , ' index in ' , aClass db2TableSpaceName]. self createTable: (self fullTableName: aClass) columns: columnsString. pkStream := (String new: 100) writeStream. aKeyCollection do: [:each | pkStream nextPutAll: each , ', ']. pkStream skip: -2. self createUniqueIndex: (self tableName: aClass) , '_PK' onTable: (self tableNameWithPrefix: aClass) columns: pkStream contents. self addPrimaryKey: pkStream contents onTable: (self tableNameWithPrefix: aClass)
createDatabaseTableColumnsFor: aClass keyNames: aKeyCollection "Creates column list for a new table." | fdTypes stringMap aStream aType str | stringMap := self typeToStringMap. fdTypes := aClass fieldTypes. aStream := (String new: 100) writeStream. aStream cr. aClass columnNames do: [:each | aType := fdTypes at: each ifAbsent: [#String]. (self isPrimaryKeyType: aType) ifTrue: [aKeyCollection addLast: each]. aStream nextPutAll: ' ', each , ' ' , (stringMap at: aType). aStream nextPutAll: ( self addIdentityFor: each). aStream nextPutAll: ', '; cr]. "currently, we are add primary key later" "aKeyCollection isEmpty ifTrue: [aStream skip: -2. aStream nextPut: $ .]." aStream skip: -2. aStream nextPut: $ . str := aStream contents. aClass name = #FileRecord ifTrue: [str := str copyReplaceAll: '3990' with: '3000']. ^ str.
createIndex: indName onTable: aTable columns: aNameCollection "Length of indexname in DB2 limited 18 chars. Don't best, but it work" | aStream | aStream := (String new: 100) writeStream. aStream nextPutAll: 'CREATE INDEX ' , (self db2IndexName: indName), ' ON ' , aTable, ' ( '. aNameCollection do: [ :each | aStream nextPutAll: each, ', ' ]. aStream skip: -2. aStream nextPutAll: ' )'. self performCreate: [ self processSQL: aStream contents. ] for: (aTable, ' ', indName)
createPhysicalSpaces ^self installPhysicalSpaces
createSourcesViewForClass: aClass self createView: (self tableNameWithPrefix: aClass) selectStatement: (self createViewSelectWithSourcesSQLForClass: aClass). self grantForClass: aClass permissions: #('SELECT') toUsers: #('PUBLIC').
createUniqueIndex: indName onTable: aTable columns: aString | aStream | aStream:=(String new: 100) writeStream. aStream nextPutAll: 'CREATE UNIQUE INDEX ' , (self db2IndexName: indName), ' ON ' , aTable, ' ( ', aString, ')' . self == DB2Broker ifTrue: [aStream nextPutAll: ' ALLOW REVERSE SCANS ' ]. "best access plan for 'select max(primaryKey)' expression" self performCreate: [ self processSQL: aStream contents] for: (aTable, ' ', indName)
createViewForClass: aClass self createView: ( self tableNameWithPrefix: aClass) selectStatement: (self createViewSelectSQLForClass: aClass).
installPhysicalSpaces ^true
</methods> <methods> Store.DB2Broker class <category>error handling</category>
alreadyExistErrors ^ Array with: self objectAlreadyExistisErrorNumber with: self indexAlreadyInTableErrorNumber with: self primaryKeyAlreadyInTableErrorNumber
brokerSignals ^Signals isNil ifTrue: [ Signals := self signalCollection] ifFalse: [ Signals ]
doesNotExistErrors ^ Array with: self objectAlreadyGoneErrorNumber
indexAlreadyInTableErrorNumber ^605
objectAlreadyExistisErrorNumber ^ -601
objectAlreadyGoneErrorNumber ^-204
primaryKeyAlreadyInTableErrorNumber ^-624
signalCollection ^ ( ExceptionSet new: 4) add: self connectionClass unableToExecuteSQLSignal; add: self connectionClass connectionNotOpenSignal; add: self connectionClass externalDatabaseInformationSignal; add: self connectionClass unableToPrepareSignal; yourself
</methods> <methods> Store.DB2Broker class <category>connection class</category>
connectionClass ^DB2Connection
</methods> <methods> Store.DB2Broker class <category>version</category>
copyright ^'The "Store for DB2/UDB" allow use StORE with DB2/UDB for code storage. Copyright (C) 2000-2003 Anthony Boris (avb@cssc.tat.ru) '
softwareVersion ^'Store for DB2/UDB version 7.2 (DB2/UDB Connect edition)'
</methods> <methods> Store.DB2Broker class <category>accessing</category>
databaseName ^'DB2/UDB'
fullTableName: aClass ^self tableNameWithPrefix: aClass
getBlobData: aData ^aData
indexNameFor: aClass ^(self tableNameWithPrefix: aClass), aClass indexName.
maxLongBytes ^MaxLongBytes
maxLongBytes: aNumber "Set max size of 'Blob' fields: for example - 3990 for 4K pages; 8000 for 8K pages; 16000 for 16K pages; 32000 for 32K pages" MaxLongBytes := aNumber
maxSqlString "Answer the maximum length of a sql string" ^32000
needsSequenceFor: aClass "false for v7 " ^false
sequenceGeneratorSession: session forClass: aClass ^self safelyExecuteBlock: [ session isNil ifTrue: [ | newSession | newSession := self getNewSession. newSession bindOutput: nil; bindInput: nil; prepare: ( self nextIDQuery: aClass ); blockFactor: 1. newSession ] ifFalse: [ session ] ]
</methods> <methods> Store.DB2Broker class <category>private</category>
db2IndexName: aName "length of index name limited 18 chars " ^self tablePrefix, '.', (aName copyFrom: 1 to: (18 min: aName size))
initialize "self initialize" super initialize. self dontUseTableSpaceSpecification. IdentityOption := 'ALWAYS' -> 1 "option->start value"
runStatsFor: aClass DB2Manager new runStats: (self fullTableName: aClass) statsOption: #SQL_STATS_ALL shared: true indexes: nil
typeToStringMap ^( Dictionary new) at: #String put: 'varchar (255) '; at: #PrimaryKey put: 'int not null'; at: #PrimaryKeyInteger put: 'int not null'; at: #PrimaryKeyString put: 'varchar (255) not null'; at: #PrimaryKeyShortString put: 'varchar (50) not null'; at: #PrimaryKeyChar put: 'char(1) not null'; at: #Text put: 'long varchar '; at: #Long put: 'int '; at: #BinData put: ('varchar(<1p>) for bit data ' expandMacrosWith: self maxLongBytes); at: #Integer put: 'int '; at: #Char put: 'char(1)'; at: #String32 put: 'varchar (32)' ; yourself.
</methods> <methods> Store.DB2Broker class <category>private-accessing</category>
dismissSession: aSession ^ aSession dismiss
</methods> <methods> Store.DB2Broker class <category>services</category>
dontUseTableSpaceSpecification UseTableSpaceSpecification := false.
extendTablespaces "grow tablespace container size" "self extendTablespaces" DbRegistry reconnect: true. [ Transcript show: 'Grow tablespace conatiner size ' ; cr. self processSQL: 'ALTER TABLESPACE NEWBERN1 EXTEND (ALL 20 M )'. self processSQL: 'ALTER TABLESPACE NEWBERN2 EXTEND (ALL 20 M )'. ] on: Error do: [ :exp | Transcript show: exp description. ^true]. ^true.
updateStatistics "self updateStatistics" DbRegistry reconnect: true. Transcript show: 'Collect statistics...'; cr. DbRegistry connection begin. Package dbTables do: [:aClass | Transcript show: 'RUNSTATS ON ' , aClass name; cr. self runStatsFor: aClass]. DbRegistry connection commit. Transcript show: 'Done !'; cr.
useTableSpaceSpecification UseTableSpaceSpecification := true.
</methods> <methods> Store.DB2Broker class <category>drop objects</category>
dropDatabase: dbName (Dialog confirm: 'Drop tablespace ', dbName, '?') ifFalse: [^true]. Transcript show: 'Dropping tablespace ' , dbName; cr. [ self processSQL: ('DROP TABLESPACE ' , dbName) asString. Transcript show: 'Tablespace dropped'; cr. ] on: Error do: [ :exception | | err | (( err := exception parameter first ) notNil and: [ err dbmsErrorCode == self objectAlreadyGoneErrorNumber]) ifTrue: [ Dialog warn: (self messageFor: exception). exception return]. "pass ? " Dialog warn: (self messageFor: exception). ]
dropDatabaseFor: aClass "need more work - when used existing tablespaces named distinct from NEWBERN1/2 this don't work" self dropDatabase: aClass databaseName.
dropIndexForClass: aClass self dropIndexForClass: aClass index: aClass indexName.
dropIndexForClass: aClass index: aName self performDrop: [self processSQL: 'DROP INDEX ' , (self db2IndexName: aName)] for: (aClass name, aName)
dropPrimaryKeyOnTable: aTableName "Drop primary key constraint on table" self performCreate: [ self processSQL: 'ALTER TABLE ', aTableName, ' DROP PRIMARY KEY '] for: aTableName
dropSequenceForClass: aClass
dropTableForClass: aClass self dropTable: (self tableNameWithPrefix: aClass)
dropUser: aName "Not yet supported " self halt:'Not yet supported ' .
dropViewForClass: aClass self dropView: ( self tableNameWithPrefix: aClass).
</methods> <methods> Store.DB2Broker class <category>performance tuning</category>
dropIndex: anIndex onTable: aTableName "Removes an index from a database." self process: ('DROP INDEX ' , aTableName, '.', anIndex) asString.
</methods> <methods> Store.DB2Broker class <category>sql processing</category>
getAnswerFromSession: getSessionBlock bindInput: bindInputBlock ^self safelyExecuteBlock: [ | session ans res | session := getSessionBlock value. bindInputBlock value: session. ans := session execute; answer. ans == #noAnswerStream ifFalse: [ res := ans upToEnd ]. DbRegistry printDebug: 'Output'; printDebug: res. ^ res. ]
process: sqlString bindInput: inputObj bindOutput: outputObj usingSession: session | res ans | "Return the result not the answer stream." self isConnectionAlive ifFalse: [self currentlyNotConnectedSignal raise]. session bindInput: inputObj. session bindOutput: outputObj. session prepare: sqlString. ans := session execute; answer. ans == #noAnswerStream ifFalse: [res := ans upToEnd]. DbRegistry printDebug: 'Output'; printDebug: res. ^ res
safelyExecuteBlock: aBlock "Catch errors that arise" (DbRegistry connectionOrNil == nil or: [DbRegistry isOnline not]) ifTrue: [^self currentlyNotConnectedSignal raiseSignal]. ^ [[Cursor database showWhile: [aBlock value]] on: self brokerSignals do: [:exception | DbRegistry debug ifTrue: [self halt]. Transcript show: (self messageFor: exception). DbRegistry goOffLine. (Dialog confirm: 'Currently disconnected. Do you want to reconnect?') ifTrue: [DbRegistry reconnect ifTrue: [exception retry]]. self currentlyNotConnectedSignal raiseSignal]] on: UnhandledException do: [:ex | self processPublishException: ex note: ''. self currentlyNotConnectedSignal raiseSignal. ^nil]
</methods> <methods> Store.DB2Broker class <category>grant statements</category>
grant: aPermissionList on: aTableName columnList: aColumnList to: aUserNameList "Assigns permissions to users. DB2 does not currently support granting 'SELECT' permissions to individual columns, so the GRANT applies to all columns in aTableName." | aStream | aStream := (String new: 100) writeStream. aStream nextPutAll: 'GRANT '. aPermissionList do: [:each | aStream nextPutAll: each , ', ']. aStream skip: -2. aStream nextPutAll: ' ON ' , aTableName. aStream nextPutAll: ' TO '. aUserNameList do: [:each | aStream nextPutAll: each , ', ']. aStream skip: -2. self processGrantStatement: aStream contents "aStream := (String new: 100) writeStream. aStream nextPutAll: 'GRANT ' . aPermissionList do: [ :each | aStream nextPutAll: (each, ', ')]. aStream skip: -2. aStream nextPutAll: (' ON ' , aTableName, ' ( ' ). aColumnList do: [ :each | aStream nextPutAll: (each, ', ')]. aStream skip: -2. aStream nextPutAll: ( ' ) ', ' TO '). aUserNameList do: [ :each | aStream nextPutAll: (each, ', ')]. aStream skip: -2. "
grantForClass: aClass permissions: aPermissionList columns: aList toUsers: aUserNameList self grant:aPermissionList on: (self tableNameWithPrefix: aClass) columnList: aList to: aUserNameList
grantForSeqClass: aClass permissions: aPermissionList toUsers: aUserNameList "Don't need for v7" ^true "super grantForSeqClass: aClass permissions: aPermissionList toUsers: aUserNameList"
processGrantStatement: aString "need more work" [ self processSQL: aString ] on: Error do: [ :exception | "(exception parameter first dbmsErrorCode == self userAlreadyExistsInDBErrorNumber) ifTrue: [ Transcript show: exception parameter first dbmsErrorString; cr. exception return ]" false ifFalse: [ Dialog warn: (self messageFor: exception). DbRegistry goOffLine. exception pass ] ]
</methods> <methods> Store.DB2Broker class <category>queries</category>
newSQLFor: aClass ^ self sqlAssistClass newSQLFor: aClass table: (self tableNameWithPrefix: aClass)
nextIDQuery: aClass ^(self newSQLFor: aClass) selectMax: #(#primaryKey)
sqlAssistClass ^DB2SQLAssist
</methods> <methods> Store.DB2Broker72 class <category>create objects</category>
addIdentityFor: aColumn " For #PrimaryKey columns we add identity property. Identity columns are commonly used in conjunction with PRIMARY KEY constraints to serve as the unique row identifier for the table. " ^String new
createDatabaseSequence: aClass self performCreate: [self processSQL: 'CREATE SEQUENCE ' , (self sequenceNameWithPrefix: aClass)] for: aClass name
</methods> <methods> Store.DB2Broker72 class <category>connection class</category>
connectionClass ^DB2Connection72
</methods> <methods> Store.DB2Broker72 class <category>accessing</category>
databaseName ^'DB2/UDB 7.2 or high'
needsSequenceFor: aClass ^aClass needsSequence
permissionsForSequence "Answer an array of permissions to grant to sequence tables." ^#( 'USAGE' ).
</methods> <methods> Store.DB2Broker72 class <category>drop objects</category>
dropSequenceForClass: aClass Transcript show: 'Dropping sequence for ' , aClass name; cr. self performDrop: [self processSQL: 'DROP SEQUENCE ' , (self sequenceNameWithPrefix: aClass), ' RESTRICT'] for: aClass name
</methods> <methods> Store.DB2Broker72 class <category>grant statements</category>
grantForSeqClass: aClass permissions: aPermissionList toUsers: aUserNameList "Copied from SQLBroker" self grant: aPermissionList on: (' SEQUENCE ', (self sequenceNameWithPrefix: aClass)) to: aUserNameList.
</methods> <methods> Store.DB2Broker72 class <category>queries</category>
nextIDQuery: aClass ^ self sqlAssistClass new newSQLStream; valuesFor: ( 'NEXTVAL FOR ', (self sequenceNameWithPrefix: aClass ))
sqlAssistClass ^DB2SQLAssist72
</methods> <methods> DB2Connection72 class <category>class initialization</category>
initialize "DB2Connection72 initialize" super initialize.
</methods> <methods> DB2Connection72 class <category>accessing</category>
kind "Answer a symbol representing the type of DMBS the receiver provides services for." ^#'DB2/UDB 7.2 Store '
storeBroker "Answer a broker class for Store" ^Store.DB2Broker72
</methods> <methods> Store.DBObject class <category>installation</category>
db2TableSpaceName "Answer a name of a tablespace the table should live in. If the default tablespace is acceptable answer nil." ^'NEWBERN2'
</methods> <methods> Store.Blob class <category>installation</category>
db2TableSpaceName "Answer a name of a tablespace the table should live in. If the default tablespace is acceptable answer nil." ^'NEWBERN1'
</methods> <initialize> Store.DB2Broker </initialize> <initialize> DB2Connection72 </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>DB2Connection</name> <environment>Database</environment> <super>Database.ExternalDatabaseConnection</super> <private>false</private> none hdbcHolder supportedFunctions generalInformationCache blobHstmt apiXif apiXifMap <imports></imports> <category>Database-DB2</category> <attributes> <package>DB2EXDI</package> </attributes> </class> <class> <name>SQLAssist</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none tableName tableClass sqlStream alias <imports></imports> <category>Store-DB-Broker</category> <attributes> <package>Store-DB-Broker</package> </attributes> </class> <class> <name>SQLBroker</name> <environment>Store</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Store-DB-Broker</category> <attributes> <package>Store-DB-Broker</package> </attributes> </class>