SystemOrganization addCategory: #'SeasideData-Decorations'! SystemOrganization addCategory: #'SeasideData-Support'! SystemOrganization addCategory: #'SeasideData-Widgets'! WAComponent subclass: #ALWDBSettingsEditor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SeasideData-Widgets'! !ALWDBSettingsEditor class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:37'! canBeRoot ^ true! ! !ALWDBSettingsEditor methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 13:10'! renderContentOn: html html form with: [ html label: 'Database: '. html textInput on: #dbName of: ALDBSettings. html break. html label: 'Host: '. html textInput on: #dbHost of: ALDBSettings. html break. html label: 'Port: '. html textInput on: #dbPort of: ALDBSettings. html break. html label: 'User: '. html textInput on: #dbUser of: ALDBSettings. html break. html label: 'Password: '. html passwordInput on: #dbPassword of: ALDBSettings. html break. html label: 'DB System: '. html select list: #(#postgreSQL #mySQL); labels: [:listItem | listItem asString asCapitalizedPhrase ]; on: #dbSystem of: ALDBSettings. html break. html submitButton value: 'Save Settings']! ! !ALWDBSettingsEditor methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:40'! rendererClass ^ WARenderCanvas ! ! WASession subclass: #SDSession instanceVariableNames: 'connection loggedUser loggedUserPassword users' classVariableNames: 'DbPort DbHost' poolDictionaries: '' category: 'SeasideData-Widgets'! SDSession subclass: #SDGoodsSession instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SeasideData-Widgets'! !SDGoodsSession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:04'! dbPort ^ DbPort ifNil: [DbPort _ 6100]! ! !SDGoodsSession methodsFor: 'data connection' stamp: 'rbb 3/25/2005 12:54'! connection ^ connection ifNil: [connection := KKDatabase onHost: (self class dbHost) port: (self class dbPort)].! ! !SDGoodsSession methodsFor: 'initializing' stamp: 'rbb 3/25/2005 13:02'! initialize " Here we check our Database and make sure it is what we expect" (self connection root isNil) ifTrue: [self connection root: Dictionary new. self connection commit. self connection root at: 'Users' put: OrderedCollection new. self connection commit. self createAdminUser]! ! !SDGoodsSession methodsFor: 'accessing' stamp: 'rbb 5/23/2005 15:00'! users ^ (self connection root at: 'Users' ifAbsentPut: [OrderedCollection new])! ! !SDGoodsSession methodsFor: 'data connection' stamp: 'rbb 3/25/2005 13:14'! withEscapeContinuation: aBlock ^ (self connection) commitWithRetry: [super withEscapeContinuation: aBlock] ! ! SDSession subclass: #SDROESession instanceVariableNames: '' classVariableNames: 'DbName ConnectionArgs DbUser DbPass' poolDictionaries: '' category: 'SeasideData-Widgets'! !SDROESession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:11'! dbName ^ DbName! ! !SDROESession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:11'! dbName: aString DbName _ aString! ! !SDROESession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:11'! dbPass ^ DbPass! ! !SDROESession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:11'! dbPass: aString DbPass _ aString! ! !SDROESession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:10'! dbUser ^ DbUser! ! !SDROESession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:10'! dbUser: aUser DbUser _ aUser! ! !SDROESession class methodsFor: 'settings' stamp: 'gwm 8/3/2007 10:28'! resetDatabaseConnection ConnectionArgs := nil! ! !SDROESession class methodsFor: 'sql templates' stamp: 'rbb 4/28/2005 15:18'! usersTemplateSql ^ ' CREATE SEQUENCE users_tpid_seq INCREMENT 1 MINVALUE 1 MAXVALUE 9223372036854775807 START 1 CACHE 1; create table users ( user_id integer NOT NULL DEFAULT nextval(''"users_tpid_seq"''::text), lname varchar, fname varchar, uuid varchar unique, email varchar unique, CONSTRAINT users_pkey PRIMARY KEY (client_id) )'! ! !SDROESession methodsFor: 'initializing' stamp: 'rbb 10/21/2006 19:51'! checkDb | result sql | self defaultConnectionArgs. sql := 'SELECT * FROM pg_tables WHERE tableowner = ''', self class dbUser, ''' and tablename = ''', self userTableName, ''''. Transcript cr; show: sql. result := self connection execute: sql. result rows isEmpty ifTrue: [self initDatabase ]! ! !SDROESession methodsFor: 'accessing' stamp: 'rbb 4/28/2005 14:49'! connection ^ connection ifNil: [connection _ PGConnection new connectionArgs: self defaultConnectionArgs; startup; yourself]! ! !SDROESession methodsFor: 'initializing' stamp: 'rbb 12/23/2005 15:28'! defaultConnectionArgs ^ConnectionArgs ifNil: [ConnectionArgs _ PGConnectionArgs hostname: (self class dbHost) portno: (self class dbPort) databaseName: (self class dbName) userName: (self class dbUser) password: (self class dbPass)]! ! !SDROESession methodsFor: 'initializing' stamp: 'rbb 9/21/2006 14:20'! initDatabase self connection execute: self class userTemplateSql. ! ! !SDROESession methodsFor: 'initializing' stamp: 'rbb 12/23/2005 15:45'! initialize self checkDb. "create the ROE relations" users _ RAPostgresRelation name: (self userTableName) connection: self connection. ! ! !SDROESession methodsFor: 'accessing' stamp: 'rbb 4/28/2005 15:06'! userTableName ^ 'users'! ! !SDROESession methodsFor: 'accessing' stamp: 'rbb 4/28/2005 14:49'! users ^ caregivers! ! !SDSession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:02'! dbHost ^ DbHost ifNil: [DbHost := 'localhost'] ! ! !SDSession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:02'! dbHost: aHost DbHost _ aHost! ! !SDSession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:02'! dbPort ^ DbPort! ! !SDSession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:01'! dbPort: aNumber DbPort := aNumber ! ! !SDSession class methodsFor: 'settings' stamp: 'rbb 4/28/2005 15:01'! userClass self subclassResponsibility ! ! !SDSession methodsFor: 'data connection' stamp: 'rbb 4/28/2005 14:56'! connection self subclassResponsibility ! ! !SDSession methodsFor: 'initializing' stamp: 'rbb 4/28/2005 14:58'! createAdminUser self users add: (self class userClass new login: 'admin'; firstName: 'System'; lastName: 'Admin'; password: 'wikiadmin'; yourself) ! ! !SDSession methodsFor: 'initializing' stamp: 'rbb 4/28/2005 14:59'! initialize self createAdminUser ! ! !SDSession methodsFor: 'accessing' stamp: 'rbb 4/28/2005 14:54'! loggedUser ^ loggedUser! ! !SDSession methodsFor: 'accessing' stamp: 'rbb 4/28/2005 14:54'! loggedUser: anObject loggedUser _ anObject! ! !SDSession methodsFor: 'accessing' stamp: 'gm 11/12/2007 10:34'! loggedUserPassword ^ loggedUserPassword! ! !SDSession methodsFor: 'accessing' stamp: 'gm 11/12/2007 10:34'! loggedUserPassword: anObject loggedUserPassword := anObject! ! !SDSession methodsFor: 'cleanup' stamp: 'rbb 4/28/2005 14:54'! unregistered connection _ nil. self loggedUser: nil. ! ! !SDSession methodsFor: 'accessing' stamp: 'rbb 5/23/2005 15:03'! userForLogin: aLoginString ^ self users detect: [:ea | ea login = aLoginString] ifNone: [^ nil] ! ! !SDSession methodsFor: 'accessing' stamp: 'rbb 4/28/2005 14:57'! users ^ users ifNil: [users _ OrderedCollection new]! ! WATask subclass: #SDEnsureUserTask instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SeasideData-Widgets'! !SDEnsureUserTask methodsFor: 'as yet unclassified' stamp: 'rbb 10/21/2006 20:34'! go "Use this task to present components showing the username and password, (or other connection info - from the PGConnection (need to pass that in), Keep looping until the connection is valid - meaning the database is created and the owner is created and owns the database. Change the name to SDEnsureConnectionTask"! ! WADecoration subclass: #EnsureDatabase instanceVariableNames: 'schema' classVariableNames: '' poolDictionaries: '' category: 'SeasideData-Decorations'! !EnsureDatabase commentStamp: '' prior: 0! This class decorates a WAComponent that needs access to a SQL database - currently this uses only postgres. When this decoration is initialized, it is given a DBSchema object that will do that actual checking and create the tables if necessary. This allows different components in a Seaside app to create the databases they need on a lazy basis. The decoration asks the schema object to check and see if the database properly exists.! !EnsureDatabase class methodsFor: 'as yet unclassified' stamp: 'rbb 1/15/2006 00:04'! schema: aSchema ^ (self new) schema: aSchema! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 10/21/2006 20:10'! checkConnection "See if the connection works - both the login and the database should exist" (self connection isConnected) ifFalse: [ Transcript cr; show: 'Not Connected'. ((self connection result errorResponse value findString: 'FATAL: role') > 0) ifTrue: ["The user doesn't exist" Transcript cr; show: 'Bad User'. ^ 'Bad User']]. ! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 10/21/2006 20:11'! connection ^ self schema connection! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 1/14/2006 23:50'! createDatabase self schema createDatabase! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 10:48'! renderContentOn: html "self verifyConnectionOn: html." (self verifyDatabase) ifTrue: [self renderOwnerOn: html] ifFalse: [self createDatabase]! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 1/14/2006 15:54'! schema ^ schema! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 1/14/2006 15:54'! schema: aDBSchema schema _ aDBSchema! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 10/21/2006 20:27'! verifyConnectionOn: html "See if the connection works - both the login and the database should exist" (self connection isConnected) ifFalse: [ Transcript cr; show: 'Not Connected'. ((self connection result errorResponse value findString: 'FATAL: role') > 0) ifTrue: ["The user doesn't exist" self call: SDEnsureUserTask new]]. ! ! !EnsureDatabase methodsFor: 'as yet unclassified' stamp: 'rbb 1/14/2006 16:00'! verifyDatabase ^ self schema verifyDatabase! ! WASystemConfiguration subclass: #SDConfiguration instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'SeasideData-Support'! !SDConfiguration methodsFor: 'as yet unclassified' stamp: 'rbb 10/24/2006 10:20'! attributes ^ Array with: (WAStringAttribute key: #dbHost group: #database) with: (WAStringAttribute key: #dbUser group: #database) with: (WAPasswordAttribute key: #dbPassword group: #database) with: (WAStringAttribute key: #dbName group: #database) with: (WANumberAttribute key: #dbPort group: #database)! ! !SDConfiguration methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 20:33'! dbHost ^ 'localhost'! ! !SDConfiguration methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 20:34'! dbName ^ 'template1'! ! !SDConfiguration methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 20:34'! dbPassword ^ nil! ! !SDConfiguration methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 20:34'! dbPort ^ 5432! ! !SDConfiguration methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 20:33'! dbUser ^ 'postgres'! ! Object subclass: #ALDBSettings instanceVariableNames: '' classVariableNames: 'DbSystem DbHost DbName DbPort DbUser DbPassword' poolDictionaries: '' category: 'SeasideData-Support'! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:26'! dbHost ^ DbHost ifNil: [^ self defaultHost]! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:26'! dbHost: aHost DbHost := aHost! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 13:16'! dbName ^ DbName ifNil: [^ self defaultName]! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 13:17'! dbName: aName DbName := aName! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:25'! dbPassword ^ DbPassword! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:25'! dbPassword: aPassword DbPassword := aPassword! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:22'! dbPort ^ DbPort ifNil: [^ self defaultPort]! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:21'! dbPort: aPort DbPort := aPort! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:46'! dbSystem ^ DbSystem ifNil: [^ self defaultSystem]! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:45'! dbSystem: aDbSystem DbSystem := aDbSystem! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:25'! dbUser ^ DbUser ifNil: [^ self defaultUser]! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:26'! dbUser: aUser DbUser := aUser! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:27'! defaultHost ^ 'localhost'! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 13:18'! defaultName ^ 'aims'! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:24'! defaultPort (self dbSystem = #postgreSQL) ifTrue: [^5432]. (self dbSystem = #mySQL) ifTrue: [^ 3306]. ^ 1000! ! !ALDBSettings class methodsFor: 'as yet unclassified' stamp: 'jon made a few screens pretty 8/28/2007 12:46'! defaultSystem ^ #postgreSQL! ! !ALDBSettings class methodsFor: 'accessing' stamp: 'jon made a few screens pretty 8/28/2007 12:42'! defaultUser (self dbSystem = #postgreSQL) ifTrue: [^ 'postgres']. (self dbSystem = #mySQL) ifTrue: [^ 'root']. ^ 'admin'! ! Object subclass: #DBSchema instanceVariableNames: 'connection verified logging connArgs dbName dbPassword dbUser owner' classVariableNames: '' poolDictionaries: '' category: 'SeasideData-Support'! !DBSchema commentStamp: 'rbb 1/15/2006 00:48' prior: 0! This class should be subclassed and used to provide Schemas for various components This class contains various sql code in strings and the means to get to a database server to verify that the tables it needs are there, or create them if they don't exist. any method prefaced with 'sql', for example: sqlTemplateExpenses, will be assumed to contain one or more SQL commands and the method should return a string of valid SQL that can be executed on the PostgreSQL connection. In the normal case, the EnsureDatabase decoration would be added to a component, and initialized using it's class side convenience method, schema:. The schema class instance sent as the argument would have it's overridden connectionArgs and dbUser methods. Any tables to be verified would be returned as a Collection from the tables method. By default, tables returns an empty collection and so always verifies. Any tables, indexes, sequences, stored procedures, triggers, etc, to be created for this schema would have at least one method beginning with 'sql', as explained above. It's probably a good idea to have a single sql* method for each table, rather than have multiple table creations in in one method, but that is up to the user of these classes.! !DBSchema class methodsFor: 'as yet unclassified' stamp: 'rbb 10/23/2006 20:43'! owner: object ^(self new) owner: object! ! !DBSchema methodsFor: 'database' stamp: 'rbb 10/21/2006 20:01'! checkTables | sql result | self tables do: [:table | sql := String streamContents: [:stream | stream nextPutAll: 'SELECT * FROM pg_tables WHERE tableowner = '''; nextPutAll: self dbUser; nextPutAll: ''' and tablename = '''; nextPutAll: table; nextPutAll: '''']. result := self connection execute: sql. (result rows isEmpty) ifTrue: [self log: 'Table not found: ', table.^ false]]. ^ true. ! ! !DBSchema methodsFor: 'database' stamp: 'rbb 10/21/2006 20:01'! checkViews | sql result | self views do: [:view | sql := String streamContents: [:stream | stream nextPutAll: 'SELECT * FROM pg_views WHERE viewowner = '''; nextPutAll: self dbUser; nextPutAll: ''' and viewname = '''; nextPutAll: view; nextPutAll: '''']. result := self connection execute: sql. (result rows isEmpty) ifTrue: [self log: 'View not found: ', view. ^ false]]. ^ true.! ! !DBSchema methodsFor: 'database' stamp: 'rbb 1/15/2006 00:56'! connection ^ connection ifNil: [self log: 'Creating new PGConnection'. connection _ PGConnection new connectionArgs: self connectionArgs; startup; yourself]! ! !DBSchema methodsFor: 'database' stamp: 'rbb 10/23/2006 20:45'! connectionArgs ^ connArgs ifNil: [ connArgs := PGConnectionArgs hostname: self dbHost portno: self dbPort databaseName: self dbName userName: self dbUser password: self dbPassword]! ! !DBSchema methodsFor: 'database' stamp: 'rbb 10/21/2006 19:35'! createDatabase "Drops and creates new tables based on the SQL methods in my instance" self log: 'Creating Database using: ', self class name. self class methodDict keysAndValuesDo: [:key :val | (key asString beginsWith: 'sql') ifTrue: [ self log: 'Executing method ', key. self connection execute: (self perform: key)]]. self class methodDict keysAndValuesDo: [:key :val | (key asString beginsWith: 'view') ifTrue: [ self log: 'Executing method ', key. self connection execute: (self perform: key)]]! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:46'! dbHost ^ self owner session application preferenceAt: #dbHost! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:47'! dbName ^ self owner session application preferenceAt: #dbName! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:47'! dbPassword ^ self owner session application preferenceAt: #dbPassword! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:47'! dbPort ^ self owner session application preferenceAt: #dbPort! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:47'! dbUser ^ self owner session application preferenceAt: #dbUser! ! !DBSchema methodsFor: 'debugging' stamp: 'rbb 1/15/2006 00:40'! log: aString (self logging) ifTrue: [Transcript cr; show: aString] ! ! !DBSchema methodsFor: 'debugging' stamp: 'rbb 1/15/2006 00:54'! logging ^ logging ifNil: [^ true]! ! !DBSchema methodsFor: 'debugging' stamp: 'rbb 1/15/2006 00:41'! logging: aBoolean logging _ aBoolean! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:44'! owner ^ owner! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/23/2006 20:43'! owner: object owner _ object! ! !DBSchema methodsFor: 'sql' stamp: 'rbb 1/14/2006 16:13'! sqlSample ^ 'SELECT * FROM pg_tables WHERE tableowner = ''postgres'' and tablename = ''kennels'''.! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 10/21/2006 19:12'! superUser self subclassResponsibility ! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 1/15/2006 00:52'! tables ^ #()! ! !DBSchema methodsFor: 'database' stamp: 'rbb 1/15/2006 00:35'! verified " This is used to cache the verification results for a session" ^ verified ifNil: [^ false]! ! !DBSchema methodsFor: 'database' stamp: 'rbb 1/15/2006 00:57'! verified: aBoolean " This is used to cache the verification results for a session" verified _ aBoolean. aBoolean ifTrue: [connection _ nil]! ! !DBSchema methodsFor: 'database' stamp: 'rbb 10/21/2006 20:11'! verifyDatabase "Returns true or false depending on whether the required tables there" | | (self verified) ifTrue: [^ true]. self log: 'Verifying Database using: ', self class name. self checkTables ifFalse: [^ false]. self checkViews ifFalse: [^ false]. self verified: true. ^ true! ! !DBSchema methodsFor: 'sql' stamp: 'rbb 9/21/2006 16:29'! viewSample ^ 'SELECT * FROM pg_views WHERE viewowner = ''postgres'' and viewname = ''schemata'''.! ! !DBSchema methodsFor: 'accessing' stamp: 'rbb 9/21/2006 16:28'! views ^ #()! !